zOs/war/rexo080
}¢--- A540769.WK.REXX.O08(AA) cre=2008-04-03 mod=2008-09-16-10.43.16 F540769 ---
say 'hallo'
parse arg args
say 'args' args
address isredit 'macro (args)'
say 'isredit rc' rc 'macro(args)' args
}¢--- A540769.WK.REXX.O08(ADRISP) cre=2006-05-10 mod=2008-09-15-09.16.38 F540769 ---
/* 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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 *************************************************/
}¢--- A540769.WK.REXX.O08(ADRSQL) cre=2006-05-10 mod=2008-02-21-18.44.04 F540769 ---
/* copy adrSql begin *************************************************/
old - do not use anymore ???wk
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then do
return 0
end
else if rc < 0 then do
if ggRet == '*' then nop
else if wordPos(sqlCode, ggRet) > 0 then nop
else
call err "sql rc" rc sqlmsg() ggNo
end
else if sqlWarn.0 ^== ' ' then do
say 'warning' sqlMsg() ggNo
end
return sqlCode
endSubroutine adrSql
adrSqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call adrSql "connect" ggSys, ggRetCon ,1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
parse arg ggRet
call adrSql "disconnect ", ggRet, 1
return
endProcedure adrSqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggW = ''
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggw = ggw ggx'='sqlWarn.ggx
end
ggXX = pos(':', ggSqlStmt)
ggVV = ''
if ggXX > 0 then do
ggVV = word(substr(ggSqlStmt, ggXX + 1), 1)
ggXX = verify(ggVV, ' ,:+-*/&%?|', 'm')
if ggXX > 0 then
ggVV = left(ggVV, ggXX-1)
ggVV = 'with' ggVV '=' value(ggVV)
end
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x)) ,
'stmt = ' ggSqlStmt ggVV
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/* copy adrSql end *************************************************/
}¢--- A540769.WK.REXX.O08(ADRTSO) cre=2007-10-19 mod=2008-09-15-09.12.05 F540769 ---
/* 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 expose m.
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 expose m.
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
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 expose m.
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 by 1
alRc = adrTso(c rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for' c rest
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
endProcedure tsoAlloc
dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
bl = 32760
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
recfm='f b'
bl = bl - (bl // rl)
end
else do
if rl = '' then
rl = bl-4
recfm = substr(atts, 2, 1) 'B'
end
end
if pos('(', dsn) > 0 then
po = 'dsntype(library) dsorg(po)'
else
po = ''
dsn = dsnSetMbr(dsn)
if forCsm == 1 then
return "dataset('"dsn"')" po,
"recfm("space(recfm, 0)") lrecl("rl") blkSize("bl")" ,
"mgmtclas(s005y000) space(10, 1000) cylinder"
else
return "dsn('"dsn"')" po,
"recfm("recfm") lrecl("rl") block("bl")" ,
"mgmtclas(s005y000) 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
copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
call readDDBegin word(frDD, 1)
call writeDDBegin word(toDD, 1)
cnt = 0
do while readDD(word(frDD, 1), r.)
call writeDD word(toDD, 1), r.
cnt = cnt + r.0
end
call readDDEnd word(frDD, 1)
call writeDDEnd word(toDD, 1)
interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
if ggSay == 1 | m.debug == 1 then
say cnt 'records copied from' frSpec 'to' to toSpec
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
}¢--- A540769.WK.REXX.O08(ALIB) cre=2007-12-24 mod=2008-05-20-18.00.09 F540769 ---
/* rexx **************************************************************
aLib: activate and deactivate tso and ispf libraries.
synopsis: alib ¢-OPTIONS!... ¢DSN!... ...
Options designating the Libaries to activate/deactivate
opt LLQ def Library
-e EXEC TSO EXEC Library: altlib application(exec)
-r REXX TSO EXEC Library: altlib application(exec)
-f LOAD TSO TSOLIB (warning: must be pushed on tso stack
and will only be processed when rexx finishes)
-p PANELS ISPPLIB: ispf panels
-m MSGS ISPMLIB: ispf messages
-t TABLES ISPTLIB: ispf tables input
-u TABLES ISPTABL: ispf tables update
-s SKELS ISPSLIB: ispf skeletons
-l LOAD ISPLLIB: ispf load
other standalone options:
-a activate (default)
-d deactivate
-? or ? for this help
options taking values:
-q<llqs> LowLevelQualifiers, with <llqs> one of the following
* the default LLQ from above (default)
empty no llq
list a comma separated list of llqs
-c<application> if nonEmpty dsn is interpreted
as a ChangeMan PackageNumber of this application
otherwise as a (tso) datasetName (the default)
***********************************************************************/
defLib = wk
self = defLib'.REXX(ALIB)'
info = ' PPLIBPANELS MMLIBMSGS TTLIBTABLES UTABLTABLES SSLIBSKELS' ,
' LLLIBLOAD ETSOAEXEC RTSOAREXX FTSOLLOAD'
do ix=1 to words(info)
op = left(word(info, ix), 1)
libs.op = ''
end
libs = 'R'
newLibs = ''
fun = 'activate'
llq = '*'
cMan = ''
parse arg mainArgs
call errReset 'hi'
if mainArgs = '' then
call adrEdit 'macro (mainArgs)', '*'
say self 'start args' mainArgs
mainArgs = translate(mainArgs)
dsnCnt = 0
do wx=1 by 1
w = word(mainArgs, wx)
if w = '' then do
if dsnCnt = 0 then
w = defLib
else
leave
end
if pos('?', w) > 0 then do
return help()
return
end
else if left(w,1) = '-' then do /* options */
if w = '-' then do
fun = 'deactivate'
iterate
end
do cx=2 to length(w) /* each option */
ch = substr(w, cx, 1)
if ch = '?' then
call help
else if ch = 'A' then
fun = 'activate'
else if ch = 'D' then
fun = 'deactivate'
else if ch = 'C' then do
cMan = substr(w, cx+1)
leave
end
else if ch = 'Q' then do
llq = translate(substr(w, cx+1), ' ', ',')
leave
end
else if pos(' ' || ch, info) > 0 then
newLibs = newLibs || ch
else
call errHelp 'bad option' ch 'in' w
end /* do each option character */
end
else do /* operands */
dsnCnt = dsnCnt + 1
if newLibs <> '' then do
libs = newLibs
newLibs = ''
end
if cMan = '' then
pref = dsn2jcl(w, 1)
else
pref = "CMN.DIV.P0."cMan".#"right(w, 6, '0')
do cx = 1 to length(libs) /* each lib */
op = substr(libs, cx, 1)
if llq = '' then
libs.op = libs.op "'"pref"'"
else if llq = '*' then do
ii = word(substr(info, pos(' '||op, info)), 1)
libs.op = libs.op "'"pref'.'substr(ii, 6)"'"
end
else do
do lx=1 to words(llq)
lw = word(llq, lx)
libs.op = libs.op "'"pref '.'lw"'"
end
end
end /* do each lib */
end
end /* do each word */
nok = ''
do ix=1 to words(info)
ii = word(info, ix)
op = left(ii, 1)
if libs.op = '' then
iterate
/* say fun op ii libs.op */
if substr(ii, 2, 4) = 'TSOA' then do
c = 'altlib' fun 'application(exec)'
if fun = 'activate' then
c = c "dataset("libs.op") UNCOND"
call adrTso c
end
else if substr(ii, 2, 4) = 'TSOL' then do
c = 'tsolib' fun
if fun = 'activate' then
c = c "dataset("libs.op") UNCOND"
push c
end
else do
c = 'libdef ISP'substr(ii, 2, 4)
if fun = 'activate' then
c = c "dataset id("strip(libs.op)") UNCOND"
if 0 <> adrIsp(c, '*') then
nok = nok op'='substr(ii, 2, 4)'='rc
end
say /* fun op */ 'rc' rc c
end
if nok <> '' then
say 'alib' fun 'errors for' nok
exit
/* 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(s005y000) 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(ALOC) cre=2007-06-14 mod=2007-12-24-15.57.53 F540769 ---
/* rexx ****************************************************************
get einfacher mit wsh |
call lmd A540769.wk $¨ $@for d $£ left($d, 45) sysDsn("'"$d"'")
***********************************************************************/
parse arg list
do wx=1 to words(list)
w = word(list, wx)
say w
call lmdBegin aa, w
do while lmdNext(aa, bb.)
do b=1 to bb.0
say bb.b sysDsn("'"bb.b"'")
end
end
call lmdEnd aa
end
exit
err:
call errA arg(1), 1
endSubroutine err
/* 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 -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
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 = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', ds) > 0) then
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, ggStem, ggOpt
drop err handler opt
if ggOpt == '' & symbol('m.err.handler') == 'VAR' then
interpret m.err.handler
say 'fatal error:' ggTxt
if ggOpt == '' | ggOpt == '*' then
ggOpt = translate(value('m.err.opt'), 'ht', 'HT')
if ggStem ^== '' then do
do ggXX=1 to m.ggStem.0
say ' ' m.ggStem.ggXX
end
if ggXX > 3 then
say 'fatal error in' ggS3':' ggTxt
end
parse source . . ggS3 . /* current rexx */
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
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, st, op
say 'fatal error:' msg
call help
call err msg, st, 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(ARGS) cre=2008-04-17 mod=2008-05-08-13.20.11 F540769 ---
/* rexx */
parse arg a
say 'args' arg()
do y=1 to arg()
say 'arg('y')' arg(y)
end
if a = '-' then do
x = args('eins', 'zwei', 'drei')
say length(x) left(x, 60)
end
/* return left('abcde ', 100000, '*') */
exit
}¢--- A540769.WK.REXX.O08(BEST1TOP) cre=2008-02-26 mod=2008-02-26-16.27.38 F540769 ---
PROC 0 TEST
/*******************************************************************/
/* CLIST : BEST1TOT (TEST) BEST1TOP (PRODUKTION) */
/* FUNCTION : BEST/1-DATENBANKSYSTEM */
/* AUTHOR : G.CABERNARD,27514,OTH1 */
/* CREATED : 01.02.94 */
/* LAST MOD. : 08.03.96 NAK UND SMS */
/* LAST MOD. : 14.08.96 VON TUNING AUF SYSTEM */
/* LAST MOD. : 05.08.03 KTPS1/GC SAS V6->V8 UND LPARMIPS ADDIERT */
/*-----------------------------------------------------------------*/
/* PANELS : NONE */
/* MESSAGES : NONE */
/* SKELETONS : NONE */
/* PROGRAMS : TS9001 */
/* CLISTS : SAS6 */
/*******************************************************************/
IF &TEST = TEST THEN +
CONTROL MAIN ASIS NOFLUSH NOPROMPT MSG LIST CONLIST SYMLIST
ELSE +
CONTROL MAIN ASIS NOFLUSH NOPROMPT NOMSG NOLIST NOCONLIST NOSYMLIST
/* GRAFIK-BIBLIOTHEN ALLOZIEREN ***********************************/
/*ALLOC DD(ADMPC) DSN('GDDM.DIV.P0.ADMPCF') SHR */
/*ALLOC DD(ADMSYMBL) DSN('GDDM.DIV.P0.ADMSYM') SHR */
/*ALLOC DD(SKACFORM) DSN('GDDM.DIV.P0.ADMCFRM') SHR */
/*ALLOC DD(ADMCDATA) DSN('ES.DIV.P0.ADMCDATA') SHR */
/*ALLOC DD(ADMCFORM) DSN('ES.DIV.P0.ADMCFORM') SHR */
/*ALLOC DD(ADMCDEF) DSN('ES.DIV.P0.ADMCDEF') SHR */
/*ALLOC DD(ADMGDF) DSN('ES.DIV.P0.ADMGDF') SHR */
ALLOC DD(VIOWRK) -
SPACE(50 10) CYLINDERS NEW UNIT(VIO) -
BLKSIZE(8704) LRECL(8704) RECFM(F S) REUSE DELETE
/* SETZEN BEZUGS- UND DATEINAMEN ***********************************/
SET TOOL1DDW=TOOL1DDW /* SCL BEZUGSNAME *SAS*/
SET TOOL1DSW=ES.DIV.P0.TOOL.SASV8.APPL /* SCL PROGRAMME 050803 *SAS*/
SET TOOL1DDP=TOOL1DDP /* PROFILE BEZUGSNAME*SAS*/
SET TOOL1DSP=ES.DIV.P0.TOOL.SASV8.PROF /* PROFILE DATEI 050803 *SAS*/
SET TOOL1DDS=TOOL1DDS /* JCL BEZUGSNAME *PDS*/
SET TOOL1DSS=ES.DIV.P0.TOOL.PARM /* PDS WORK-DS *PDS*/
/* SETZEN BEZUGS- UND DATEINAMEN FÜR DATEN *************************/
SET BST00DDD=BST00DDD /* JCL BEZUGSNAME DATEN ALL*SAS*/
SET BST00DSD=ES.DIV.P0.AKT.SASFRMT /* JCL DATEI DATEN*SAS*/
SET BST01DDD=BST01DDD /* JCL BEZUGSNAME DATEN RZ1*SAS*/
SET BST01DSD=ES.DIV.P0.RZ1.SYSTEM.SASDB /* JCL DATEI DATEN *SAS*/
SET BST02DDD=BST02DDD /* JCL BEZUGSNAME DATEN RZ2*SAS*/
SET BST02DSD=ES.DIV.P0.RZ2.SYSTEM.SASDB /* JCL DATEI DATEN *SAS*/
SET BST03DDD=BST03DDD /* JCL BEZUGSNAME DATEN RZ3*SAS*/
SET BST03DSD=ES.DIV.P0.RZ3.SYSTEM.SASDB /* JCL DATEI DATEN *SAS*/
SET BST04DDD=BST04DDD /* JCL BEZUGSNAME DATEN RZ4*SAS*/
SET BST04DSD=ES.DIV.P0.RZ4.SYSTEM.SASDB /* JCL DATEI DATEN *SAS*/
SET BST05DDD=BST05DDD /* JCL BEZUGSNAME DATEN RRZ*SAS*/
SET BST05DSD=ES.DIV.P0.RRZ.SYSTEM.SASDB /* JCL DATEI DATEN *SAS*/
SET BST0LDDD=BST0LDDD /* JCL BEZUGSNAME DATEN RRZ*SAS*/
SET BST0LDSD=ES.DIV.P0.RZLEU.SYSTEM.SASDB /* JCL DATEI DATEN *SAS*/
SET HRWRFIL =BEST.DIV.P0.BGS.HRWRFIL /* HARDWARE-FILE GRATNER *OSF*/
/* SETZEN USER-PROFILE MACRO VARIABLEN *****************************/
ISPEXEC SELECT PGM(TS9001)
ISPEXEC VGET (ZUSER) SHARED
ISPEXEC VGET (UIDSTR)
SET PID = &ZUSER
IF &ZUSER = F333481 THEN DO
SET USERNAM = &SUBSTR(25:32,&UIDSTR)
SET INSTR = &SUBSTR(5:9,&UIDSTR)
SET NAMTELE = &SUBSTR(15:24,&UIDSTR)
SET FACH = &SUBSTR(01:04,&UIDSTR)
SET ACCT = 9999
END
ELSE DO
SET USERNAM = &SUBSTR(25:44,&UIDSTR)
SET INSTR = &SUBSTR(5:9,&UIDSTR)
SET NAMTELE = &SUBSTR(45:52,&UIDSTR)
SET FACH = &SUBSTR(54:57,&UIDSTR)
SET ACCT = &SUBSTR(60:63,&UIDSTR)
END
SET PRINTER = OSE1P
SET PROFILE=&SYSUID
/* VORBEREITEN DER AUTOEXEC-DATEI SAS ******************************/
EDIT '&SYSUID..BEST1TOP.CMD' NEW DATA EMODE NONUM ASIS
INSERT OPTIONS NOERRORABEND NOSOURCE NOSOURCE2 NONOTES;
INSERT OPTIONS COMPRESS=YES USER=VIOWRK BUFNO=50;
INSERT %LIBNAME(&TOOL1DDW,&TOOL1DSW,SERVER=BEST1); /* SAS/SCL-SRC*/
INSERT %LIBNAME(&TOOL1DDP,&TOOL1DSP,SERVER=BEST1); /* PROFILE */
INSERT %LET TOOL1DDW=&TOOL1DDW;
INSERT %LET TOOL1DSW=&TOOL1DSW; /* SCL PROGRAMME */
INSERT %LET TOOL1DDP=&TOOL1DDP;
INSERT %LET TOOL1DSP=&TOOL1DSP; /* PROFILE */
INSERT %LET TOOL1DDS=&TOOL1DDS;
INSERT %LET TOOL1DSS=&TOOL1DSS; /* JCL */
INSERT %LET BST00DDD=&BST00DDD;
INSERT %LET BST00DSD=&BST00DSD; /* DATEN */
INSERT %LET BST01DDD=&BST01DDD;
INSERT %LET BST01DSD=&BST01DSD; /* DATEN */
INSERT %LET BST02DDD=&BST02DDD;
INSERT %LET BST02DSD=&BST02DSD; /* DATEN */
INSERT %LET BST03DDD=&BST03DDD;
INSERT %LET BST03DSD=&BST03DSD; /* DATEN */
INSERT %LET BST04DDD=&BST04DDD;
INSERT %LET BST04DSD=&BST04DSD; /* DATEN */
INSERT %LET BST05DDD=&BST05DDD;
INSERT %LET BST05DSD=&BST05DSD; /* DATEN */
INSERT %LET BST0LDDD=&BST0LDDD;
INSERT %LET BST0LDSD=&BST0LDSD; /* DATEN */
INSERT %LET HRWRFIL =&HRWRFIL; /* DATEN */
INSERT %LET PROFILE=&PROFILE;
INSERT %LET PID =&PID;
INSERT %LET AUFRUF=&SYSDATE;
INSERT %LET UMZEIT=&SYSTIME;
INSERT %LET USERNAM=&USERNAM;
INSERT %LET INSTR =&INSTR;
INSERT %LET NAMTELE=&NAMTELE;
INSERT %LET FACH =&FACH;
INSERT %LET ACCT =&ACCT;
INSERT %LET PRINTER=&PRINTER;
INSERT DATA &PID;
INSERT TOOL1DDW='&TOOL1DDW';
INSERT TOOL1DSW='&TOOL1DSW'; /* SCL PROGRAMME */
INSERT TOOL1DDP='&TOOL1DDP';
INSERT TOOL1DSP='&TOOL1DSP'; /* PROFILE */
INSERT TOOL1DDS='&TOOL1DDS';
INSERT TOOL1DSS='&TOOL1DSS'; /* JCL */
INSERT BST00DDD='&BST00DDD';
INSERT BST00DSD='&BST00DSD'; /* DATEN */
INSERT BST01DDD='&BST01DDD';
INSERT BST01DSD='&BST01DSD'; /* DATEN */
INSERT BST02DDD='&BST02DDD';
INSERT BST02DSD='&BST02DSD'; /* DATEN */
INSERT BST03DDD='&BST03DDD';
INSERT BST03DSD='&BST03DSD'; /* DATEN */
INSERT BST04DDD='&BST04DDD';
INSERT BST04DSD='&BST04DSD'; /* DATEN */
INSERT BST05DDD='&BST05DDD';
INSERT BST05DSD='&BST05DSD'; /* DATEN */
INSERT BST0LDDD='&BST0LDDD';
INSERT BST0LDSD='&BST0LDSD'; /* DATEN */
INSERT HRWRFIL ='&HRWRFIL'; /* DATEN */
INSERT PID='&PID';
INSERT PROFILE='&PROFILE';
INSERT AUFRUF=PUT(DATE(),DATE7.);
INSERT UMZEIT=PUT(TIME(),TIME8.);
INSERT USERNAM='&USERNAM';
INSERT INSTR ='&INSTR';
INSERT NAMTELE='&NAMTELE';
INSERT FACH ='&FACH';
INSERT ACCT ='&ACCT';
INSERT PRINTER='&PRINTER';
INSERT DATA &TOOL1DDP..&PROFILE;
INSERT LENGTH ANZAHL 8.;
INSERT LENGTH JC1 JC2 $58. DATEI $44. MEM MEMI $8.;
INSERT SET &TOOL1DDP..&PROFILE (OBS=1);
INSERT PID='&PID';
INSERT IF ANZAHL<1 THEN ANZAHL=1;
INSERT ANZAHL+1;
INSERT DATA &TOOL1DDP..&PROFILE;
INSERT UPDATE &TOOL1DDP..&PROFILE &PID;
INSERT BY PID;
INSERT RUN;
INSERT GOPTIONS SWAP;
INSERT DM 'AF CAT=&TOOL1DDW..BEST1V00.BSTA000M.PROGRAM' AF;
INSERT *PROC BUILD CAT=&TOOL1DDW..BEST1V00;
INSERT LIBNAME &TOOL1DDP; /* PROFILE DATEI */
INSERT LIBNAME &TOOL1DDW; /* SCL PROGRAMME */
INSERT ENDSAS;
INSERT RUN;QUIT;
SAVE * REUSE
END
ALLOC F(BEST1TOP) DA('&SYSUID..BEST1TOP.CMD') OLD REUSE DELETE
/* AUFRUFEN APPLIKATION ********************************************/
%SAS8 AUTOEXEC('''&SYSUID..BEST1TOP.CMD''')
FREE F(VIOWRK,BEST1TOP)
/* GRAFIK-BIBLIOTHEN FREE ***********************************/
FREE DD(ADMPC,ADMSYMBL,ADMCDATA,ADMCFORM,SKACFORM,ADMGDF,ADMCDEF)
ISPEXEC CONTROL DISPLAY REFRESH
EXIT CODE(0)
}¢--- A540769.WK.REXX.O08(CAT) cre=2007-04-26 mod=2008-06-16-16.53.20 F540769 ---
/* copy cat begin ****************************************************
***********************************************************************/
catOpt: procedure
parse arg opt, keep
if abbrev(opt, '<') then
o = 'r'substr(opt, 2)
else if abbrev(opt, '>>') then
o = 'a'substr(opt, 3)
else if abbrev(opt, '>') then
o = 'w'substr(opt, 2)
else if pos(left(opt, 1), 'rwa') > 0 then
o = opt
else
o = '?'opt
if keep ^== 1 then
o = translate(o, ' ', '£#')
return space(o, 0)
endProcedure catOpt
/*--- create and possibly open a reader or writer --------------------*/
catMake: procedure expose m.
parse arg opt, spec
o = catOpt(opt, 1)
if pos('£', o) > 0 then
return spec
else if pos('#', o) > 0 then do
if envhasKey(spec) then
return catMake(translate(opt, '£', '#'), envGet(spec))
else
return envPut(spec, jBuf())
end
else if pos('&', o) > 0 then
return catDsn('&'spec)
else
return catDsn(spec)
call err 'catMake implement' opt
if defDsn == '' then do
o = left(o, length(o)-1)
end
else if defDsn == '' then do
rw = catDsn(spec)
end
else do
rw = jReset(defDsn, spec)
end
if pos('-', o) < 1 then
call jOpen rw, o
return rw
endProcedure catMake
/*--- create a new cat -----------------------------------------------*/
cat: procedure expose m.
m = oNew('Cat')
m.m.catIx = -9
call catReset m
do ax=1 by 2 to arg()
call catWriteAll m, arg(ax), arg(ax+1)
end
return m
endProcedure cat
catReset: procedure expose m.
parse arg m
m.m.RWs.0 = 0
m.m.catWr = ''
m.m.catRd = ''
m.m.catToClose = ''
m.m.catIx = -9
call oSetTypePara m
do ax=2 by 2 to arg()
call catWriteAll m, arg(ax), arg(ax+1)
end
return m
endProcedure catReset
catClose: procedure expose m.
parse arg m
if m.m.catIx == -9 then
return
if m.m.catWr ^== '' then do
call jClose m.m.catWr
bx = mInc(m'.RWS.0')
m.m.opts.bx = ""
m.m.RWs.bx = m.m.catWr
m.m.catWr = ''
end
if m.m.catIx >= 0 then do
if m.m.catRd ^== '' then do
ix = m.m.catIx
if pos('-', m.m.opts.ix) < 1 then
call jClose m.m.catRd
m.m.catRd = ''
end
do wx = 1 to words(m.m.catToClose)
cl = word(m.m.catToClose, wx)
if cl ^== m then
call jClose cl
end
m.m.catToClose = ''
end
m.m.catIx = -9
return m
endProcedure catClose
catOpen: procedure expose m.
parse arg m, oo
call jClose m
if oo = 'r' then do
m.m.catIx = 0
m.m.catRd = catNextRdr(m)
m.m.jReading = 1
end
else if oo == 'w' | oo == 'a' then do
if oo == 'w' then
m.m.RWs.0 = 0
m.m.catIx = -7
m.m.jWriting = 1
end
else do
call err 'catOpen('m',' oo') bad opt'
end
return m
endProcedure catOpen
/*--- return and open next reader ------------------------------------*/
catNextRdr: procedure expose m.
parse arg m
cx = m.m.catIx
if cx > 0 & cx <= m.m.RWs.0 & pos('-', m.m.opts.cx) < 1 then
call jClose m.m.catRd
cx = cx + 1
m.m.catIx = cx
if cx > m.m.RWs.0 then
return ''
oo = overlay('r', m.m.opts.cx)
if pos('-', oo) < 1 then
call jOpen m.m.RWs.cx, oo
return m.m.RWs.cx
endProcedure catNextRdr
catRead: procedure expose m.
parse arg m, var
do while m.m.catRd ^== ''
if jRead(m.m.catRd, var) then
return 1
m.m.catRd = catNextRdr(m)
end
return 0
endProcedure catRead
catWrite: procedure expose m.
parse arg m, line
if m.m.catWr == '' then do
m.m.catWr = jOpen(jBuf(), 'w')
call oSetTypePara m.m.catWr, oGetTypePara(m)
end
call jWrite m.m.catWr, line
return
endProcedure catWrite
/*--- write contents of a reader to cat
or keep it for later reading -------------------------------*/
catWriteAll: procedure expose m.
parse arg m
if m.m.catIx >= 0 then
call err 'catWriteAll('m',' arg(2)',' arg(3)') but opened,',
'catIx='m.m.catIx
bx = m.m.RWs.0
if m.m.catWr ^== '' then do
call jClose m.m.catWr
bx=bx+1
m.m.opts.bx = ""
m.m.RWs.bx = m.m.catWr
m.m.catWr = ''
end
do ax=2 by 2 to arg()
bx=bx+1
m.m.opts.bx = catOpt(arg(ax))
m.m.RWs.bx = catMake(arg(ax), arg(ax+1))
call oSetTypePara m, oGetTypePara(m.m.RWs.bx)
end
m.m.RWs.0 = bx
return
endProcedure catWriteAll
/*--- store the list toClose to close them when closing cat ----------*/
catLazyClose: procedure expose m.
parse arg m, toClose
if m.m.catIx <> -7 then
call err 'catLazyClose with catIx' m.m.catIx
if m.m.RWs.0 = 0 then
return 0
if m.m.catToClose ^== '' then
call err 'catLazyClose with catToClose' m.m.catToClose
if m.m.catIx <> -7 | m.m.catToClose ^== '' then
m.m.catToClose = toClose
return 1
endProcedure catLazyClose
catSetTypePara: procedure expose m.
parse arg m, type
do ix=1 to m.m.RWs.0
call oSetTypePara m.m.RWs.ix, type
end
return
endProcedure catSetTypePara
/*--- create a reader/writer for a dsn -------------------------------*/
catDsn: procedure expose m.
parse arg spec
m = oNew('CatDsn')
m.m.readIx = 'c'
ix = mInc('CAT.BUF')
m.m.defDD = 'CAT'ix
m.m.buf = 'CAT.BUF'ix
call catDsnReset m, spec
return m
endProcedure catDsn
catDsnReset: procedure expose m.
parse arg m, sp
if symbol('m.m.defDD') ^== 'VAR' then
m.m.defDD = 'CDD' mInc('CAT.DEFDD')
m.m.spec = sp
return m
endProcedure catDsnReset
catDsnOpen: procedure expose m.
parse arg m, opt
call jClose m
buf = m.m.buf
if opt == 'r' then do
aa = dsnAlloc(m.m.spec, 'SHR', m.m.defDD)
if m.dsnAlloc.dsn <> '' then
if sysDsn("'"m.dsnAlloc.dsn"'") <> 'OK' then
call err 'cannot read' m.dsnAlloc.dsn':',
sysDsn("'"m.dsnAlloc.dsn"'")
call readDDBegin word(aa, 1)
m.m.jReading = 1
m.buf.0 = -1
m.m.readIx = 0
end
else do
if opt == 'w' then
aa = dsnAlloc(m.m.spec, 'OLD', m.m.defDD)
else if opt == 'a' then
aa = dsnAlloc(m.m.spec, 'MOD', m.m.defDD)
else
call err 'catDsnOpen('m',' opt') with bad opt'
call writeDDbegin word(aa, 1)
m.m.jWriting = 1
m.buf.0 = 0
m.m.readIx = 'w'
end
m.m.dd = word(aa, 1)
m.m.free = subword(aa, 2)
return m
endProcedure catDsnOpen
catDsnClose:
parse arg m
buf = m.m.buf
if m.m.readIx ^== 'c' then do
if m.m.readIx == 'w' then do
if m.buf.0 > 0 then
call writeDD m.m.dd, 'M.'BUF'.'
call writeDDend m.m.dd
end
else do
call readDDend m.m.dd
end
interpret m.m.free
end
m.buf.0 = 'closed'
m.m.readIx = 'c'
m.m.free = ''
m.m.dd = ''
return m
endProcedure catDsnClose
catDsnRead: procedure expose m.
parse arg m, var
ix = m.m.readIx + 1
buf = m.m.buf
if ix > m.buf.0 then do
res = readDD(m.m.dd, 'M.'buf'.')
if ^ res then
return 0
ix = 1
end
m.m.readIx = ix
m.var = m.buf.ix
return 1
endProcedure catDsnRead
catDsnWrite: procedure expose m.
parse arg m, var
buf = m.m.buf
ix = m.buf.0 + 1
m.buf.0 = ix
m.buf.ix = var
if ix > 99 then do
call writeDD m.m.dd, 'M.'buf'.'
m.buf.0 = 0
end
return
endProcedure catDsnWrite
catIni: procedure expose m.
if m.cat.ini == 1 then
return
m.cat.ini = 1
m.cat.buf = 0
call jIni
call oDecMethods oNewClass("Cat", "JRW"),
, "jOpen return catOpen(m, arg)",
, "jReset return catReset(m, '', arg)",
, "jClose call catClose m",
, "jWriteAll call err 'jWriteAll not opened w",
, "oSetTypePara call catSetTypePara m, type",
, "jRead return catRead(m, var)",
, "jWrite call catWrite m, line; return",
, "jWriteAll call catWriteAll m, opt, rdr; return"
call oDecMethods oNewClass("CatDsn", "JRW"),
, "jOpen return catDsnOpen(m, arg)",
, "jReset return catDsnReset(m, arg)",
, "jClose call catDsnClose m",
, "jRead return catDsnRead(m, var)",
, "jWrite call catDsnWrite m, line"
return
endProcedure catIni
/* copy cat end ****************************************************/
}¢--- A540769.WK.REXX.O08(CATCOPFG) cre=2008-03-13 mod=2008-03-14-14.08.07 F540769 ---
/* rexx */
call errReset 'h'
call mIni
say timing() 'begin'
ddal = dsnAlloc('~wk.texv(syscopy)')
dd = word(ddAl, 1)
call readDDBegin dd
outAl = dsnAlloc('~catCopy.out2 ::F')
out = word(outAl, 1)
call writeDDBegin out
call mCut o, 0
x = 0
z = 0
cDb = 0
cTs = 0
cPa = 0
old = ''
curr = '2008-03-13-11.11'
last = '2008-03-12-11.11'
mgmtClas = 'A000Yneu'
keys = 'B N F C L O TOT'
do kx=1 to words(keys)
ky = word(keys, kx)
c.ky.f.By = 0
c.ky.f.cn = 0
c.ky.i.By = 0
c.ky.i.cn = 0
end
do while readDD(dd, i., 1000)
x = x + i.0
do y=1 to i.0
z = z + 1
if z // 10000 = 0 then
say 'en' x 'z' z 'db' cDb 'ts' cTs 'pa' cPa ,
db'.'ts'.'pa'|'
if old ^== left(i.y, 20) then do
if sta ^== 'O' then
say 'sta' sta 'after' db ts pa
if left(old, 8) ^== left(i.y, 8) then do
cDb = cDb+1
db = strip(left(i.y, 8))
end
if left(old, 16) ^== left(i.y, 16) then do
cTs = cTs+1
ts = strip(substr(i.y, 9, 8))
end
cPa = cPa + 1
pa = c2d(substr(i.y, 17, 4))
old = left(i.y, 20)
sta = 'B'
end
parse var i.y 21 tst 47 tp 48 dsn . 92 bytes .
if sta == 'O' | sta == 'L' then do
if tst >= last then
call err 'bad seq at sta' sta 'tst>=last' db ts pa tst
sta = 'O'
end
else if sta == 'C' | sta == 'F' then do
if tst <= last then do
if tp = 'F' then
sta = 'L'
end
else if tst >= curr then
call err 'bad seq at sta' sta 'tst>=curr' db ts pa tst
if sta == 'F' then
sta = 'C'
end
else if sta = 'N' | sta = 'B' then do
if tst <= last then
sta = 'O'
else if tst <= curr then do
if tp = 'F' then
sta = 'F'
else
sta = 'N'
end
else if sta == 'N' then
call err 'bad seq at sta' sta 'tst>curr' db ts pa tst
end
else do
call err 'bad sta' sta
end
if sta == 'C' | sta == 'L' then
call mAdd o, 'ALTER' dsn 'MGMTCLAS('mgmtClas')'
/* say sta tp tst dsn
*/ c.sta.tp.cn = c.sta.tp.cn + 1
c.sta.tp.by = c.sta.tp.by + bytes
if sta == 'N' then
if tp = 'F' then
sta = 'C'
if sta == 'L' then
sta = 'O'
end
if m.o.0 > 1000 then do
call writeDD out, 'M.O.'
call mCut o, 0
end
end
say 'en' x 'z' z 'db' cDb 'ts' cTs 'pa' cPa ,
db'.'ts'.'pa'|'
call sf 'nach ' curr, b
call sf 'neu' , n
call sf 'erster' , f
call sf 'archivieren' , c
call sf 'letzte Arch. vor' last, l
call sf 'alt' , o
call sf 'total' , tot
if m.o.0 > 00 then
call writeDD out, 'M.O.'
call writeDDend out
interpret subWord(outAl, 2)
call readDDEnd dd
interpret subWord(ddAl, 2)
say timing() 'en' x 'z' z 'db' cDb 'ts' cTs 'pa' cPa
exit
sf:
parse arg tit, ky
if c.title ^== 1 then do
say left('', 40) left('full.copies', 9+1+8, '.') ,
left('incremental.copies', 9+1+8, '.')
say left('', 40) right('Anzahl', 9) right('Bytes', 8) ,
right('Anzahl', 9) right('Bytes', 8)
c.title = 1
end
say left(tit, 40) right(c.ky.f.cn, 9) format(c.ky.f.by, 1, 2, 2, 0),
right(c.ky.i.cn, 9) format(c.ky.i.by, 1, 2, 2, 0)
if ky <> 'TOT' then do
c.tot.f.cn = c.tot.f.cn + c.ky.f.cn
c.tot.f.by = c.tot.f.by + c.ky.f.by
c.tot.i.cn = c.tot.i.cn + c.ky.i.cn
c.tot.i.by = c.tot.i.by + c.ky.i.by
end
return
/* copy sql begin ***************************************************
sql interface
sqlIni --> nur sql ohne o und j Anbindung
sqlOini --> sql mit o und j Anbindung
***********************************************************************/
sqlIni: procedure expose m.
if m.sql.ini == 1 then
return
m.sql.ini = 1
call mIni
m.sql.null = '---'
return
endProcedure sqlIni
sql2St: procedure expose m.
parse arg st, src, ty, fmt
cx = 49
call sql2Cursor cx, src, ty, fmt
call sqlOpen cx
do ix=1 by 1 while sqlFetch(cx, st'.'ix)
end
m.st.0 = ix-1
call sqlClose cx
return ix-1
endProcedure sql2St
sqlPrepare: procedure expose m.
parse arg cx, src, desc
call sqlExec 'prepare s'cx 'from :src'
if desc == 1 | (desc == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
sqlExecute: procedure expose m.
parse arg cx
do ix=1 to arg()-1
val = arg(ix+1)
if val ^== m.sql.null then do
m.sql.cx.i.ix.sqlInd = 0
m.sql.cx.i.ix.sqlData = val
end
else do
m.sql.cx.i.ix.sqlInd = -1
end
end
if ^ m.noInsert then /* ??? wk test */
call sqlExec 'execute s'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure
sqlExeImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure exeImm
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
call sqlExec 'prepare s'cx 'into :M.SQL.'cx'.D from :src'
call sqlExec 'declare c'cx 'cursor for s'cx
if ty == '*' | ty = '' then do
flds = 'SQL.'cx'.FLD'
ff = ''
do ix=1 to m.sql.cx.d.sqlD
f1 = word(m.sql.cx.d.ix.sqlName, 1)
if f1 == '' then
f1 = 'COL'ix
ff = ff f1
end
ty = oFldOnly(ff, 'e')
end
call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
flds = oFlds(ty)
m.Sql.cx.FMT.0 = 0
m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
ff = m.Sql.cx.FMT
call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
return
endProcedure sql2Cursor
sqlType: procedure expose m.
parse arg cx
return oGetTypePara('SQL.TY.'cx)
sqlOpen: procedure expose m.
parse arg cx
return sqlExec('open c'cx)
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
sqlFetchInto:
parse arg ggCx, ggVars
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
sqlFetch: procedure expose m.
parse arg cx, dst
if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
return 0
if dst == '' then
return 1
fi = oFlds(sqlType(cx))
fo = m.sql.cx.fmt
do ix=1 to m.sql.cx.d.SQLD
f = m.fi.ix
if m.sql.cx.d.ix.sqlInd = 0 then
m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
else
m.dst.f = fmtS(m.sql.null, m.fo.ix)
end
return 1
endProcedure sqlFetch
sqlFetchLn: procedure expose m.
parse arg cx, var
st = 'SQL.'cx'.FET'
if ^ sqlFetch(cx, st) then
return 0
m.var = oFldCat(sqlType(cx), st)
return 1
endProcedure sqlFetchLn
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
if abbrev(sp, '=') then
return substr(sp, 2)
if sp = '' then
sp = '*st'
m.ff.0 = m.sql.cx.d.sqlD
m.ff.flds = oFlds(sqlType(cx))
if abbrev(sp, '*') then do
do ix=1 to m.ff.0
m.ff.ix = substr(sp, 2)
end
return ff
end
if abbrev(fmts, '=') then
m.Sql.cx.FMT = substr(fmts, 2)
defs = 'ir7 fr9 sl12 Tl26' sp
do wx = 1 to words(defs)
parse value word(defs, wx) with ty 2 fo
select
when ty = 'd' then t.384 = fo
when ty = 'f' then t.480 = fo'/f'
when ty = 'i' then t.496 = fo'/i'
when ty = 'n' then t.484 = fo'/n'
when ty = 's' then t.448 = fo
when ty = 't' then t.388 = fo
when ty = 'T' then t.392 = fo
otherwise call err 'bad type' ty 'for format' fo
end
end
if symbol('t.496') == 'VAR' then
t.500 = t.496
if symbol('t.448') == 'VAR' then do
t.452 = t.448
t.456 = t.448
t.464 = t.448
end
do wx = 1 to m.ff.0
ty = m.sql.cx.d.wx.sqlType
le = m.sql.cx.d.wx.sqlLen
withNulls = ty // 2
ty = ty - withNulls
if symbol('t.ty') <> 'VAR' then
call err 'sqlType' ty 'not supported'
parse var t.ty fo 2 fl '/' op
if op = 'i' then
if le = 2 then le = 6
else le = 12
else if op <> '' then
call err 'length for sqlType' ty 'op' op 'not implemented'
if fl = '=' then
fl = le
else if abbrev(fl, '<') then
fl = min(le, substr(fl, 2))
m.ff.wx = fo || fl
end
return ff
endProcedure sqlGenFmt
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
sqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call sqlExec "connect" ggSys, ggRetCon ,1
return
endProcedure sqlConnect
sqlDisconnect: procedure
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggRes = 'sqlCode' sqlCodeText(sqlCode, sqlErrMc),
'\nstate' sqlState 'warn'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
ggRes = ggRes'\nstmt = ' ggSqlStmt
ggPref = '\nwith\n '
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
sqlCodeText: procedure expose m.
parse arg co, mc
expEq = 0
if symbol('m.sql.code.0') <> 'VAR' then do
dsn = "'A540769.wk.texv(sql)'"
dsn = "'ORG.U0009.B0106.KIUT23.TEXV(SQLCODES)'"
m.sql.code.0 = 0
if sysDsn(dsn) <> 'OK' then
say 'sqlCode dsn' dsn':' sysDsn(dsn)
else
call readDsn dsn, 'M.SQL.CODE.'
end
co = co + 0
if length(co) < 3 then
co = left(co, 3, 0)
if co > 0 then
co = '+'co
co = co' '
do cx=1 to m.sql.code.0 until abbrev(m.sql.code.cx, co)
end
if cx > m.sql.code.0 then
li = "<<text for sqlCode" co "not found>>"
else
li = m.sql.code.cx
cx = 1
px = 1
res = ''
do forever
nx = pos('${', li, cx)
if nx < 1 then
leave
ex = pos('}', li, nx)
if ex < cx then
call err 'closing } missing in' li
res = res || substr(li, cx, nx - cx)
if expEq then
res = res || '<<' || substr(li, nx+2, ex-nx-2) || ' = '
cx = ex+1
if px > length(mc) then do
res = res || '<<missing>>'
end
else do
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res || substr(mc, px, qx-px)
if expEq then
res = res'>>'
px = qx + 1
end
end
res = res || substr(li, cx)
do while px <= length(mc)
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res '<<extraMsgArg =' substr(mc, px, qx-px)'>>'
px = qx + 1
end
return res
endProcedure sqlCodeText
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure sqlDsn
/*--- sql o interface ------------------------------------------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
if ty = '' then
ty = '*'
if src == '' then
src = envCatStr(' ', 'sb')
call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
call oMutate 'SQL.TY.'cx, 'SqlType'
return 'SQL.TY.'cx
endProcedure sql2obj
sql: procedure expose m.
parse arg cx, src, ty, fo
call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
return
endProcedure sql
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
if fo = '' then
fo = '~'
squash = abbrev(fo, '~')
if ^ abbrev(fo, '=') then
fo = left(fo, squash) 'sl=' substr(fo, squash+1)
t = sql2Obj(cx, src, ty, fo)
if squash then do
call fmtFldSquashRw t, 'opCl'
return
end
m = 'SQL.LN.'cx
call oMutate m, 'SqlLn'
call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
call jWriteAll m.j.jOut, "r£", m
return
endProcedure sqlLn
sqlOini: procedure expose m.
if m.sqlO.ini == 1 then
return
m.sqlO.ini = 1
call sqlIni
call envIni
call oDecMethods oNewClass("SqlType"),
, "jOpen call sqlOpen substr(m, 8)",
, "jClose call sqlClose substr(m, 8)",
, "jRead return sqlFetch(substr(m, 8), var)"
call oDecMethods oNewClass("SqlLn", "SqlType"),
, "jRead return sqlFetchLn(substr(m, 8), var)"
return
endProcedure sqlOini
/* copy sql 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 -------------------------------------------*/
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 do
nn = m.adrTso
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 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 m begin ********************************************************
stem handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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
debug: procedure expose m.
parse arg msg
if m.debug == 1 then
say 'debug' msg
return
endProcedure debug
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:
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CATCOPSQ) cre=2008-03-14 mod=2008-03-14-14.08.20 F540769 ---
/* rexx */
parse arg fun
say timing() fun 'begin'
call errReset 'h'
call mIni
call oFldIni
call sqlIni
call sqlConnect DBOF
call sql2Cursor 1, 'SELECT C.DBNAME, C.TSNAME, C.DSNUM, C.TIMESTAMP,' ,
'C.ICTYPE, C.DSNAME,' ,
'CHAR(C.COPYPAGESF * 1024 * S.PGSIZE) COPIED' ,
'FROM SYSIBM.SYSCOPY C, SYSIBM.SYSTABLESPACE S' ,
"WHERE C.ICTYPE IN ('F', 'I')" ,
'AND S.DBNAME = C.DBNAME' ,
'AND S.NAME = C.TSNAME' ,
/* "and c.dbName = 'DA540769'" ,
*/ 'ORDER BY 1, 2, 3, 4 DESC' ,
'WITH UR'
call sqlOpen 1
say timing() 'opened' fun
x = 0
if fun = 'type' then do
do while sqlFetch(1, a)
x = x + 1
if x // 10000 = 1 then
say timing() x fun m.a.dbName m.a.tsName m.a.dsNum
end
say timing() x fun m.a.dbName m.a.tsName m.a.dsNum
end
else if fun = 'vars' then do
do while sqlExec('fetch c1 into :vd,:vTs,:vNu,:vTi,:vTy,:vDs,:vCo' ,
,0 100) <> 100
x = x + 1
if x // 10000 = 1 then
say timing() x fun vd vTs vNu
end
say timing() x fun vd vTs vNu
end
else if fun = 'varsOP' then do
st = 'execSql fetch c1 into :vd,:vTs,:vNu,:vTi,:vTy,:vDs,:vCo'
do forever
address dsnRexx st
if rc <> 0 then do
if sqlCode = 100 then
leave
ggSqlStmt = st
call err sqlmsg()
end
x = x + 1
if x // 10000 = 1 then
say timing() x fun vd vTs vNu
end
say timing() x fun vd vTs vNu
end
else if fun = 'feDesc' then do
do while sqlExec('fetch c1 into descriptor :m.sql.1.d',
,0 100) <> 100
x = x + 1
if x // 10000 = 1 then
say timing() x fun,
m.sql.1.d.1.sqlData m.sql.1.d.2.sqlData m.sql.1.d.3.sqlData
end
say timing() x fun,
m.sql.1.d.1.sqlData m.sql.1.d.2.sqlData m.sql.1.d.3.sqlData
end
else if fun = 'for' then do
do while sqlExec('fetch c1 for 10 rows' ,
'into :vd,:vTs,:vNu,:vTi,:vTy,:vDs,:vCo' ,
,0 100) <> 100
x = x + 1
if x // 10000 = 1 then
say timing() x fun,
m.sql.1.d.1.sqlData m.sql.1.d.2.sqlData m.sql.1.d.3.sqlData
end
say timing() x fun,
m.sql.1.d.1.sqlData m.sql.1.d.2.sqlData m.sql.1.d.3.sqlData
end
else
call err 'bad fun' fun
call sqlClose 1
call sqlDisconnect
say timing() fun 'disconnected'
exit
ddal = dsnAlloc('~wk.texv(syscopy)')
dd = word(ddAl, 1)
call readDDBegin dd
x = 0
z = 0
cDb = 0
cTs = 0
cPa = 0
old = ''
curr = '2008-03-13-11.11'
last = '2008-03-12-11.11'
keys = 'B N C L O TOT'
do kx=1 to words(keys)
ky = word(keys, kx)
c.ky.f.By = 0
c.ky.f.cn = 0
c.ky.i.By = 0
c.ky.i.cn = 0
end
do while readDD(dd, i., 1000)
x = x + i.0
do y=1 to i.0
z = z + 1
if z // 10000 = 0 then
say 'en' x 'z' z 'db' cDb 'ts' cTs 'pa' cPa ,
db'.'ts'.'pa'|'
if old ^== left(i.y, 20) then do
if sta == 'C' then
say 'still changing' db ts pa
if left(old, 8) ^== left(i.y, 8) then do
cDb = cDb+1
db = strip(left(i.y, 8))
end
if left(old, 16) ^== left(i.y, 16) then do
cTs = cTs+1
ts = strip(substr(i.y, 9, 8))
end
cPa = cPa + 1
pa = c2d(substr(i.y, 17, 4))
old = left(i.y, 20)
sta = 'B'
end
parse var i.y 21 tst 47 tp 48 dsn . 92 bytes .
if sta == 'B' then
if tst <<= curr then
sta = 'N'
if sta == 'C' then do
/* say 'changing' dsn
*/ end
if tp = 'F' then do
if tst << last then
if sta == 'C' then
sta = 'L'
else
sta = 'O'
end
/* say sta tp dsn
*/ c.sta.tp.cn = c.sta.tp.cn + 1
c.sta.tp.by = c.sta.tp.by + bytes
if sta == 'N' then
if tp = 'F' then
sta = 'C'
if sta == 'L' then
sta = 'O'
end
call sf 'nach ' curr, b
call sf 'neu' , n
call sf 'archivieren' , c
call sf 'letzte Arch. vor' last, l
call sf 'alt' , o
call sf 'total' , tot
end
call readDDEnd dd
interpret subWord(ddAl, 2)
say timing() 'en' x 'z' z 'db' cDb 'ts' cTs 'pa' cPa
exit
sf:
parse arg tit, ky
if c.title ^== 1 then do
say left('', 40) left('full.copies', 9+1+8, '.') ,
left('incremental.copies', 9+1+8, '.')
say left('', 40) right('Anzahl', 9) right('Bytes', 8) ,
right('Anzahl', 9) right('Bytes', 8)
c.title = 1
end
say left(tit, 40) right(c.ky.f.cn, 9) format(c.ky.f.by, 1, 2, 2, 0),
right(c.ky.i.cn, 9) format(c.ky.i.by, 1, 2, 2, 0)
if ky <> 'TOT' then do
c.tot.f.cn = c.tot.f.cn + c.ky.f.cn
c.tot.f.by = c.tot.f.by + c.ky.f.by
c.tot.i.cn = c.tot.i.cn + c.ky.i.cn
c.tot.i.by = c.tot.i.by + c.ky.i.by
end
return
/* copy sql begin ***************************************************
sql interface
sqlIni --> nur sql ohne o und j Anbindung
sqlOini --> sql mit o und j Anbindung
***********************************************************************/
sqlIni: procedure expose m.
if m.sql.ini == 1 then
return
m.sql.ini = 1
call mIni
m.sql.null = '---'
return
endProcedure sqlIni
sql2St: procedure expose m.
parse arg st, src, ty, fmt
cx = 49
call sql2Cursor cx, src, ty, fmt
call sqlOpen cx
do ix=1 by 1 while sqlFetch(cx, st'.'ix)
end
m.st.0 = ix-1
call sqlClose cx
return ix-1
endProcedure sql2St
sqlPrepare: procedure expose m.
parse arg cx, src, desc
call sqlExec 'prepare s'cx 'from :src'
if desc == 1 | (desc == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
sqlExecute: procedure expose m.
parse arg cx
do ix=1 to arg()-1
val = arg(ix+1)
if val ^== m.sql.null then do
m.sql.cx.i.ix.sqlInd = 0
m.sql.cx.i.ix.sqlData = val
end
else do
m.sql.cx.i.ix.sqlInd = -1
end
end
if ^ m.noInsert then /* ??? wk test */
call sqlExec 'execute s'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure
sqlExeImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure exeImm
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
call sqlExec 'prepare s'cx 'into :M.SQL.'cx'.D from :src'
call sqlExec 'declare c'cx 'cursor for s'cx
if ty == '*' | ty = '' then do
flds = 'SQL.'cx'.FLD'
ff = ''
do ix=1 to m.sql.cx.d.sqlD
f1 = word(m.sql.cx.d.ix.sqlName, 1)
if f1 == '' then
f1 = 'COL'ix
ff = ff f1
end
ty = oFldOnly(ff, 'e')
end
call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
flds = oFlds(ty)
m.Sql.cx.FMT.0 = 0
m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
ff = m.Sql.cx.FMT
call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
return
endProcedure sql2Cursor
sqlType: procedure expose m.
parse arg cx
return oGetTypePara('SQL.TY.'cx)
sqlOpen: procedure expose m.
parse arg cx
return sqlExec('open c'cx)
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
sqlFetchInto:
parse arg ggCx, ggVars
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
sqlFetch: procedure expose m.
parse arg cx, dst
if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
return 0
if dst == '' then
return 1
fi = oFlds(sqlType(cx))
fo = m.sql.cx.fmt
do ix=1 to m.sql.cx.d.SQLD
f = m.fi.ix
if m.sql.cx.d.ix.sqlInd = 0 then
m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
else
m.dst.f = fmtS(m.sql.null, m.fo.ix)
end
return 1
endProcedure sqlFetch
sqlFetchLn: procedure expose m.
parse arg cx, var
st = 'SQL.'cx'.FET'
if ^ sqlFetch(cx, st) then
return 0
m.var = oFldCat(sqlType(cx), st)
return 1
endProcedure sqlFetchLn
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
if abbrev(sp, '=') then
return substr(sp, 2)
if sp = '' then
sp = '*st'
m.ff.0 = m.sql.cx.d.sqlD
m.ff.flds = oFlds(sqlType(cx))
if abbrev(sp, '*') then do
do ix=1 to m.ff.0
m.ff.ix = substr(sp, 2)
end
return ff
end
if abbrev(fmts, '=') then
m.Sql.cx.FMT = substr(fmts, 2)
defs = 'ir7 fr9 sl12 Tl26' sp
do wx = 1 to words(defs)
parse value word(defs, wx) with ty 2 fo
select
when ty = 'd' then t.384 = fo
when ty = 'f' then t.480 = fo'/f'
when ty = 'i' then t.496 = fo'/i'
when ty = 'n' then t.484 = fo'/n'
when ty = 's' then t.448 = fo
when ty = 't' then t.388 = fo
when ty = 'T' then t.392 = fo
otherwise call err 'bad type' ty 'for format' fo
end
end
if symbol('t.496') == 'VAR' then
t.500 = t.496
if symbol('t.448') == 'VAR' then do
t.452 = t.448
t.456 = t.448
t.464 = t.448
end
do wx = 1 to m.ff.0
ty = m.sql.cx.d.wx.sqlType
le = m.sql.cx.d.wx.sqlLen
withNulls = ty // 2
ty = ty - withNulls
if symbol('t.ty') <> 'VAR' then
call err 'sqlType' ty 'not supported'
parse var t.ty fo 2 fl '/' op
if op = 'i' then
if le = 2 then le = 6
else le = 12
else if op <> '' then
call err 'length for sqlType' ty 'op' op 'not implemented'
if fl = '=' then
fl = le
else if abbrev(fl, '<') then
fl = min(le, substr(fl, 2))
m.ff.wx = fo || fl
end
return ff
endProcedure sqlGenFmt
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
sqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call sqlExec "connect" ggSys, ggRetCon ,1
return
endProcedure sqlConnect
sqlDisconnect: procedure
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggRes = 'sqlCode' sqlCodeText(sqlCode, sqlErrMc),
'\nstate' sqlState 'warn'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
ggRes = ggRes'\nstmt = ' ggSqlStmt
ggPref = '\nwith\n '
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
sqlCodeText: procedure expose m.
parse arg co, mc
expEq = 0
if symbol('m.sql.code.0') <> 'VAR' then do
dsn = "'A540769.wk.texv(sql)'"
dsn = "'ORG.U0009.B0106.KIUT23.TEXV(SQLCODES)'"
m.sql.code.0 = 0
if sysDsn(dsn) <> 'OK' then
say 'sqlCode dsn' dsn':' sysDsn(dsn)
else
call readDsn dsn, 'M.SQL.CODE.'
end
co = co + 0
if length(co) < 3 then
co = left(co, 3, 0)
if co > 0 then
co = '+'co
co = co' '
do cx=1 to m.sql.code.0 until abbrev(m.sql.code.cx, co)
end
if cx > m.sql.code.0 then
li = "<<text for sqlCode" co "not found>>"
else
li = m.sql.code.cx
cx = 1
px = 1
res = ''
do forever
nx = pos('${', li, cx)
if nx < 1 then
leave
ex = pos('}', li, nx)
if ex < cx then
call err 'closing } missing in' li
res = res || substr(li, cx, nx - cx)
if expEq then
res = res || '<<' || substr(li, nx+2, ex-nx-2) || ' = '
cx = ex+1
if px > length(mc) then do
res = res || '<<missing>>'
end
else do
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res || substr(mc, px, qx-px)
if expEq then
res = res'>>'
px = qx + 1
end
end
res = res || substr(li, cx)
do while px <= length(mc)
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res '<<extraMsgArg =' substr(mc, px, qx-px)'>>'
px = qx + 1
end
return res
endProcedure sqlCodeText
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure sqlDsn
/*--- sql o interface ------------------------------------------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
if ty = '' then
ty = '*'
if src == '' then
src = envCatStr(' ', 'sb')
call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
call oMutate 'SQL.TY.'cx, 'SqlType'
return 'SQL.TY.'cx
endProcedure sql2obj
sql: procedure expose m.
parse arg cx, src, ty, fo
call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
return
endProcedure sql
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
if fo = '' then
fo = '~'
squash = abbrev(fo, '~')
if ^ abbrev(fo, '=') then
fo = left(fo, squash) 'sl=' substr(fo, squash+1)
t = sql2Obj(cx, src, ty, fo)
if squash then do
call fmtFldSquashRw t, 'opCl'
return
end
m = 'SQL.LN.'cx
call oMutate m, 'SqlLn'
call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
call jWriteAll m.j.jOut, "r£", m
return
endProcedure sqlLn
sqlOini: procedure expose m.
if m.sqlO.ini == 1 then
return
m.sqlO.ini = 1
call sqlIni
call envIni
call oDecMethods oNewClass("SqlType"),
, "jOpen call sqlOpen substr(m, 8)",
, "jClose call sqlClose substr(m, 8)",
, "jRead return sqlFetch(substr(m, 8), var)"
call oDecMethods oNewClass("SqlLn", "SqlType"),
, "jRead return sqlFetchLn(substr(m, 8), var)"
return
endProcedure sqlOini
/* copy sql end **************************************************/
/* copy fmt begin **************************************************/
fmt: procedure
parse arg v, f 2 l
if abbrev('-', f) then
return v
else if f = 'l' then
return left(v, l)
else if f = 'r' then
return right(v, l)
else if f = 's' then
if l = '' then
return strip(v, 't')
else
return strip(v, l)
else if f = 'w' then do
parse var l st ',' le
return substr(v, st, le)
end
else
call err 'bad format' f l 'for' v
endProcedure fmt
/*--- format special (title, null Value also for numbers) ------------*/
fmtS: procedure expose m.
parse arg v, f
return fmt(v, f)
endProcedure fmtS $
/* copy fmt end **************************************************/
/* copy oFld begin ****************************************************/
oFldNew: procedure expose m.
parse arg name, va, st, flds, dup
if pos('*', name) > 0 then
name = oPut('O.CLA', name, , '*')
else
call oPut 'O.CLA', name, , 'n'
m.o.cla.name.inst = 0
m.o.cla.name.val = va
m.o.cla.name.stem = st
m.o.cla.name.FLD.0 = 0
m.o.cla.name.MET.0 = 0
return oFldAdd(name, flds, dup)
endProcedure oFldNew
oFldOnly: procedure expose m.
parse arg fs, dup
kk = space(fs, 1) dup
if symbol('m.o.fldOnly.kk') = 'VAR' then
return m.o.fldOnly.kk
nn = oFldNew('FldType*')
st = 'O.CLA.'nn'.FLD'
ll = ''
do wx=1 to words(fs)
ll = ll oPut(st, word(fs, wx), '=', dup)
end
if symbol('m.o.fldOnly.ll') = 'VAR' then
nn = m.o.fldOnly.ll
m.o.fldOnly.kk = nn
m.o.fldOnly.ll = nn
return nn
endProcedure oFldOnly
oFldCat: procedure expose m.
parse arg ty, st, fmt
flds = oFlds(ty)
res = ''
do ix=1 to m.flds.0
f = m.flds.ix
if fmt == '' then
res = res m.st.f
else
res = res fmt(m.st.f, m.fmt.ix)
end
return substr(res, 2)
endProcedure oFldCat
oFldAdd: procedure expose m.
parse arg cla, fs, dup
st = 'O.CLA.'cla'.FLD'
do ix=1 by 2 to words(fs)
call oPut st, word(fs, ix), word(fs, ix+1), dup
end
return cla
endProcedure oFldAdd
oFlds: procedure expose m.
parse arg type
return 'O.CLA.'type'.FLD'
oPut: procedure expose m.
parse arg st, k, v, dup
if dup = '*' then do
cx = pos('*', k)
if cx < 1 then
call err 'no * in key' k
k = oPutDupResolve(st, left(k, cx-1), 1)
end
else if symbol('m.st.k') = 'VAR' then do
if dup = '' | dup = 'o' then do
m.st.k = v
return k
end
if dup = '=' then do
if v <> m.st.k | ^ (v = '' & datatype(m.st.k, 'n')) then
call err 'not =: m.'st'.'k '=>' m.st.k '<>' v
return k
end
if dup = 'e' then
k = oPutDupResolve(st, k, 2)
else
call err 'key' k 'exists in' st 'but dup' dup
end
else if dup = 'o' then
call err 'old key' k 'does not exist in' st
if datatype(k, 'n') | words(k) <> 1 | pos('.', k) > 0 then
call err 'illegal name' name
x = m.st.0 + 1
m.st.0 = x
m.st.x = k
if v == '' then
m.st.k = x
else
m.st.k = v
return k
endProcedure oPut
oPutDupResolve: procedure expose m.
parse arg st, k, b
do ix=b
a = k || ix
if symbol('m.st.a') <> 'VAR' then
return a
end
endProcedure oPutDupResolve
/*--- parameterized types --------------------------------------------*/
oGetTypePara: procedure expose m.
parse arg m
if symbol('m.o.tyPa.m') == 'VAR' then
return m.o.tyPa.m
else
return '='
endProcedure oGetTypePara
oSetTypePara: procedure expose m.
parse arg m, type, noCall
if type = '' then
type = '='
if oGetTypePara(m) == type then
return
if noCall ^== 'noCall' then
interpret oObjMethod(m, 'oSetTypePara')
m.o.tyPa.m = type
return
endProcedure oSetTypePara
oFldIni: procedure expose m.
if m.oFld.ini = 1 then
return
m.oFld.ini = 1
m.o.cla.0 = 0
call oFldNew 'Class', '=', , ,
'INST = MET .<>= FLD .<>=Class STEM =Class'
return
endProcedure oFldIni
/* copy oFld 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 -------------------------------------------*/
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 do
nn = m.adrTso
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 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 m begin ********************************************************
stem handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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
debug: procedure expose m.
parse arg msg
if m.debug == 1 then
say 'debug' msg
return
endProcedure debug
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:
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CDT) cre=2006-06-07 mod=2007-12-24-15.59.37 F540769 ---
/* REXX *************************************************************
this editmacro replaces all #dt# by the current date time
changes mgmtClass D005Y000 to A008Y003
'LOCK EXCLUSIVE' to 'LOCK SHARE'
and jumps to cleanup --> remove this step
**********************************************************************/
call adrEdit('macro (args)')
say 'macro args' args
tst = time('N')
tst = 'D'date('j')'.T'left(tst,2)substr(tst, 4, 2)right(tst,2)
say 'timestamp' tst
if adrEdit("c '#dt#' '"tst"' all", 4) = 4 then
say 'no #dt# found'
if adrEdit("c D005Y000 A008Y003 all", 4) = 4 then
say 'no D005Y000 found'
if adrEdit("c 'LOCK EXCLUSIVE' 'LOCK SHARE' all", 4) = 4 then
say 'no LOCK EXCLUSIVE found'
call adrEdit "f cleanup first"
exit 0
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
/* 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 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, ggStem, ggOpt
drop err handler opt
if ggOpt == '' & symbol('m.err.handler') == 'VAR' then
interpret m.err.handler
say 'fatal error:' ggTxt
if ggOpt == '' | ggOpt == '*' then
ggOpt = translate(value('m.err.opt'), 'ht', 'HT')
if ggStem ^== '' then do
do ggXX=1 to m.ggStem.0
say ' ' m.ggStem.ggXX
end
if ggXX > 3 then
say 'fatal error in' ggS3':' ggTxt
end
parse source . . ggS3 . /* current rexx */
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
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, st, op
say 'fatal error:' msg
call help
call err msg, st, 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CHARSET) cre=2008-05-22 mod=2008-05-22-17.54.46 F540769 ---
do i=0 by 16 to 240
m = "'x" c2x(d2c(i)) "-" c2x(d2c(i+15)) "= "
do j=i to i+15
if d2c(j) == "'" then
m = m"''"
else
m = m || d2c(j)
end
$£ m"'"
end
$***out 20080522 17:54:35
'x 00 - 0F = œ †—Ž
'
'x 10 - 1F =
‡’ '
'x 20 - 2F = €‚ƒ„…ˆ‰Š‹Œ'
'x 30 - 3F = ‘“”•–˜™š›ž'
'x 40 - 4F = âäàáãåçñ¢.<(+|'
'x 50 - 5F = &éêëèíîïìß!$*);^'
'x 60 - 6F = -/ÂÄÀÁÃÅÇѦ,%_>?'
'x 70 - 7F = øÉÊËÈÍÎÏÌ`:#@''="'
'x 80 - 8F = Øabcdefghi«»ðýþ±'
'x 90 - 9F = °jklmnopqrªºæ¸Æ¤'
'x A0 - AF = µ~stuvwxyz¡¿Ð[Þ®'
'x B0 - BF = ¬£¥·©§¶¼½¾Ý¨¯]´×'
'x C0 - CF = {ABCDEFGHIôöòóõ'
'x D0 - DF = }JKLMNOPQR¹ûüùúÿ'
'x E0 - EF = \÷STUVWXYZ²ÔÖÒÓÕ'
'x F0 - FF = 0123456789³ÛÜÙÚŸ'
$***out 20080522 17:53:20
x 00 - 0F = ' œ †—Ž
'
x 10 - 1F = '
‡’ '
x 20 - 2F = '€‚ƒ„…ˆ‰Š‹Œ'
x 30 - 3F = '‘“”•–˜™š›ž'
x 40 - 4F = ' âäàáãåçñ¢.<(+|'
x 50 - 5F = '&éêëèíîïìß!$*);^'
x 60 - 6F = '-/ÂÄÀÁÃÅÇѦ,%_>?'
x 70 - 7F = 'øÉÊËÈÍÎÏÌ`:#@''="'
x 80 - 8F = 'Øabcdefghi«»ðýþ±'
x 90 - 9F = '°jklmnopqrªºæ¸Æ¤'
x A0 - AF = 'µ~stuvwxyz¡¿Ð[Þ®'
x B0 - BF = '¬£¥·©§¶¼½¾Ý¨¯]´×'
x C0 - CF = '{ABCDEFGHIôöòóõ'
x D0 - DF = '}JKLMNOPQR¹ûüùúÿ'
x E0 - EF = '\÷STUVWXYZ²ÔÖÒÓÕ'
x F0 - FF = '0123456789³ÛÜÙÚŸ'
$***out 20080522 17:51:34
}¢--- A540769.WK.REXX.O08(CHECKRTC) cre=2008-04-04 mod=2008-05-20-13.26.35 F540769 ---
/* rexx ****************************************************************
rebuild null ||| und prüfen ||||
***********************************************************************/
call mapIni
call sqlIni
parse arg list
if 0 & list = '' then
list = QR30403
Pref = dsn2jcl('~CHECKRTS')
tsPref = pref'.OLITS'
ixPref = pref'.OLIIX'
m.spPref = dsn2jcl('~CHECKRTS.OPR')
if list = '-alloc' | list = '-delete' then do
f = substr(list, 2, 1)
call alcDlt f, A540769.CHECKRTS.OLIIXNEW, 'F'
call alcDlt f, A540769.CHECKRTS.OLIIXOLD, 'F'
call alcDlt f, A540769.CHECKRTS.OLITSNEW, 'F'
call alcDlt f, A540769.CHECKRTS.OLITSOLD, 'F'
call alcDlt f, A540769.CHECKRTS.OPRIXNEW, 'V'
call alcDlt f, A540769.CHECKRTS.OPRIXOLD, 'V'
call alcDlt f, A540769.CHECKRTS.OPRTSNEW, 'V'
call alcDlt f, A540769.CHECKRTS.OPRTSOLD, 'V'
call alcDlt f, A540769.CHECKRTS.SYSPRINT, 'V'
exit
end
if list = '-c' then do
call countNew pref'.OPRTSNEW'
call countNew pref'.OPRIXNEW'
exit
end
call sqlConnect 'DBTF'
call qeysIni 'E equal' ,
, 'NLN n LoadNull' ,
/* , 'NB n Reb noNu only' */ ,
, 'NBN n Rebu null' ,
, 'NO1N n old 1 null' ,
/* , 'NRN n ReoNul LoaOld' */ ,
, 'NZ n rows=0' ,
, 'NM n no RTS' ,
, 'OS o rows<100' ,
, 'OLG o ReoOldLoaNew' ,
, 'OSP o spaeter'
if list = '' | list = '*' then do
call cmpPds tsPref'OLD', tsPref'NEW'
call qeysSayLong
call cmpPds ixPref'OLD', ixPref'NEW'
end
else do
say m.qTit
do lx=1 to words(list)
lw = word(list, lx)
say '*** comparing' lw
call cmpMbr lw, tsPref'OLD', tsPref'NEW'
call cmpMbr lw, ixPref'OLD', ixPref'NEW'
end
say m.qTit
end
call sqlDisconnect
call qeysSayLong
exit
alcDlt: procedure expose m.
parse arg fun, dsn, ii
if fun = 'd' then
call adrTso "delete '"dsn"'"
else do
ff = dsnAlloc(dsn'(A) dd(x) ::'ii)
interpret subword(ff, 2)
end
return
cmpPds: procedure expose m.
parse arg old, new
iO = lmmBegin(old)
mO = lmmNext(iO)
iN = lmmBegin(new)
mN = lmmNext(iN)
say m.qTit
do forever
if mO = mN then do
if mO = '' then
leave
if 0 & mO > 'QR02501' then
leave
call cmpMbr mO, old, new
mO = lmmNext(iO)
mN = lmmNext(iN)
end
else
call err 'member old' mO '<>' mN
end
call lmmEnd iO
call lmmEnd iN
say m.qTit
return
endProcedure cmpPds
cmpMbr: procedure expose m.
parse arg mbr, old, new
yeOl = translate('1234-56-78', (date(s) - 10000)'-', '12345678-')
yeOl = left(yeOl, 8)right(right(yeOl,2)+1, 2, 0) /* SchaltJahr */
call mapReset c, 'K'
m.type = ''
call ext c, 'old', old'('mbr')'
call ext c, 'new', new'('mbr')'
k = mapKeys(c)
do kx=1 to m.k.0
ff = mapGet(c, m.k.kx)
tt = left(m.type, 1)
if ff = '=' then do
m.cCnt.E = m.cCnt.E + 1
iterate
end
call selRts m.type, m.k.kx
q = ''
if m.r.0 <> 1 then do
if ^ (m.r.0 = 0 & ff = 'new') then do
say '??? 1 <>' m.r.0 'rts count' tt mbr m.k.kx
if m.r.0 = 0 then
iterate
end
if m.r.0 = 0 then
m.r.1.nActive = m.sql.null
end
if m.r.0 = 0 & ff = 'new' then
q = NM
else if ff = 'new' & m.r.1.reorgLastTime ^== m.sql.null ,
& m.r.1.loadRLastTime == m.sql.null then
q = NLN
/* else if ff = 'new' & m.r.1.reorgLastTime == m.sql.null ,
& m.r.1.loadRLastTime ^== m.sql.null ,
& left(m.r.1.loadRLastTime, 10) << yeOl then
q = NRN
else if ff = 'new' & tt = 'I' ,
& m.r.1.REBUILDLASTTIME ^== m.sql.null ,
& m.r.1.reorgLastTime == m.sql.null ,
& m.r.1.loadRLastTime == m.sql.null then
q = NB
*/ else if ff = 'new' & tt = 'I' ,
& (m.r.1.REBUILDLASTTIME == m.sql.null ,
| m.r.1.reorgLastTime == m.sql.null ,
| m.r.1.loadRLastTime == m.sql.null ) ,
& left(m.r.1.rebuildLastTime, 10) << yeOl ,
& left(m.r.1.reorgLastTime , 10) << yeOl ,
& left(m.r.1.loadRLastTime , 10) << yeOl then
q = NO1N
else if ff = 'new' & tt = 'T' ,
& ( m.r.1.reorgLastTime == m.sql.null ,
| m.r.1.loadRLastTime == m.sql.null ) ,
& left(m.r.1.reorgLastTime , 10) << yeOl ,
& left(m.r.1.loadRLastTime , 10) << yeOl then
q = NO1N
else if ff = 'new' ,
& ((tt = 'T' & m.r.1.totalRows <= 0) ,
|(tt = 'I' & m.r.1.totalEntries <= 0)) then
q = NZ
else if ff = 'old' ,
& ((tt = 'T' & m.r.1.totalRows < 100) ,
|(tt = 'I' & m.r.1.totalEntries < 100)) then
q = OS
else if ff = 'old' & m.r.1.reorgLastTime ^== m.sql.null ,
& left(m.r.1.reorgLastTime, 10) << yeOl,
& m.r.1.loadRLastTime ^== m.sql.null ,
& left(m.r.1.loadRLastTime, 10) >>= yeOl then
q = OLG
/* else if m.r.1.UPDATESTATSTIME >> '2008-04-06-15.31 ???' then
q = N
*/ else if ff = 'old' & spaeter(mbr, m.type, m.k.kx) then
q = oSp
/* else if ff = 'new' & tt = 'I' ,
& m.r.1.REBUILDLASTTIME == m.sql.null then
q = NBN
*/ else do
say '??? no explanation for' mbr ff m.type m.k.kx
say ' ' m.spaeter
end
if q <> '' then do
if 1 & m.cCnt.q = 0 then
say '?? first' q 'for' mbr ff m.type m.k.kx,
'cAct' m.cAct.q 'nActive' m.r.1.nActive
m.cCnt.q = m.cCnt.q+1
if m.r.1.nActive ^== m.sql.null then
m.cAct.q = m.cAct.q + m.r.1.nActive
end
end
if m.k.0 > 0 then
say qeysFmt(ff, tt, mbr)
return
endProcedure cmpMbr
qeysFmt: procedure expose m.
parse arg ff, ty, mbr
r = left(ff, 4) left(ty, 1) left(mbr, 8)
do qx=1 to words(m.qeys)
qq = word(m.qeys, qx)
r = r || right(m.cCnt.qq, 6)
end
return r
endProcedure qeysFmt
qeysSayLong: procedure expose m.
do qx=1 to words(m.qeys)
qq = word(m.qeys, qx)
say left(qq ,3) left(strip(m.qeyTxt.qx), 20) ,
right(m.cCnt.qq, 10) right(m.cAct.qq, 20)
end
return
endProcedure qeysSayLong
qeysIni: procedure expose m.
qx = 0
m.qeys = ''
do ax=1 to arg()
parse value arg(ax) with k m.qeyTxt.ax
m.cCnt.k = k
m.qeys = m.qeys k
end
m.qTit = qeysFmt()
do qx=1 to words(m.qeys)
qq = word(m.qeys, qx)
m.cCnt.qq = 0
m.cAct.qq = 0
end
return
qeysIni
spaeter: procedure expose m.
parse arg mbr, ty, obj ':' pa
if abbrev(ty, 'TAB') then do
dsn = 'TS'
src = obj
end
else do
dsn = 'IX'
ox = pos('.', obj)
call sql2st qq,
, "select strip(creator) ||'.'|| strip(name) o",
"from sysibm.sysindexes",
"where dbName = '"left(obj, ox-1)"'",
"and indexspace = '"substr(obj, ox+1)"'"
if m.qq.0 <> 1 then
call err 'index not found for' mbr ty obj':'pa
src = m.qq.1.o
end
dsn = m.spPref || dsn || 'NEW('mbr')'
m.spaeter = 'not in new' mbr ty obj':'pa src
if m.sp <> dsn then do
call readDsn dsn, m.sp.
m.sp = dsn
end
do ix=1 to m.sp.0
w = word(m.sp.ix, 2)
if word(m.sp.ix, 2) ^== src then
iterate
if word(m.sp.ix, 3) ^= pa then
iterate
m.spaeter = strip(m.sp.ix)
if word(m.sp.ix, 1) = 'spaeter' then
return 1
end
return 0
endProcedure spaeter
ext: procedure expose m.
parse arg m, fun, dsn
ty = m.type
call readDsn dsn, x.
do x=1 to x.0
if word(x.x, 1) ^== 'INCLUDE' then
iterate
if ty == '' then
ty = word(x.x, 2)
else if ty ^== word(x.x, 2) then
call err 'type change from' ty 'to' word(x.x, 2) ,
'in line' x x.x 'of' dsn
obj = word(x.x, 3)
pa = word(x.x, 4)
if pa = '' then
pa = 0
else if ^ abbrev(pa, 'PARTLEVEL(') then
call err 'bad part' pa 'in line' x x.x 'of' dsn
else
pa = substr(pa, 11, length(pa) - 11)+0
obj = obj':'pa
if ^ mapHasKey(m, obj) then
call mapAdd m, obj, fun
else if wordPos(mapGet(m, obj), '=' fun) > 0 then
call err 'duplicate' fun obj 'old' mapGet(m, obj) dsn
else
call mapPut m, obj, '='
end
m.type = ty
return
endProcedure ext
selRts: procedure expose m.
parse arg type, db'.'sp':'pa
if type = 'INDEXSPACE' then
s = "select r.*" ,
"from sysIbm.indexSpaceStats r",
"join sysIbm.sysIndexes i",
"ON r.DBID = i.DBID",
"AND r.ISOBID = i.ISOBID",
"AND r.DBNAME = i.DBName",
"AND r.indexSpace = i.indexSpace",
"where i.dbName = '"db"' and i.indexSpace = '"sp"'"
else if type = 'TABLESPACE' then
s = "select * from sysIbm.tableSpaceStats r",
"join sysIbm.sysTableSpace s",
"ON r.DBID = S.DBID" ,
"AND r.PSID = S.PSID" ,
"AND r.DBNAME = S.DBNAME",
"AND r.NAME = S.NAME" ,
"where s.dbName = '"db"' and s.name = '"sp"'"
else
call err 'bad type' type
call sql2st r, s 'and partition =' pa , '*type'type
return
endProcedure selRts
countNew: procedure expose m.
parse arg pds
ii = lmmBegin(pds)
mbr = lmmNext(ii)
tot = 0
reo = 0
day = 0
do while mbr <> ''
call readDsn pds'('mbr')', i.
do x=1 to min(i.0, 20)
i.x = substr(i.x, 2)
if wordPos('activePgByte', i.x) < 1 then
iterate
tot = tot + Word(i.x, words(i.x))
end
do x=i.0 by -1 to max(i.0-20, 1)
i.x = substr(i.x, 2)
if wordPos('reorganisiere', i.x) < 1 then
iterate
if words(i.x) ^= 7 & word(i.x, 7) ^= 'TagesLimite' then
call err 'bad limite' mbr x i.x
reo = reo + Word(i.x, 2)
day = day + word(i.x, 5)
leave
end
mbr = lmmNext(ii)
end
call lmmEnd ii
say 'total' pds
say ' tot' tot 'reo' reo 'day' day
return
endProcedure cmpPds
/* 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 sql begin ***************************************************
sql interface
sqlIni --> nur sql ohne o und j Anbindung
sqlOini --> sql mit o und j Anbindung
***********************************************************************/
sqlIni: procedure expose m.
if m.sql.ini == 1 then
return
m.sql.ini = 1
call oFldIni
m.sql.null = '---'
return
endProcedure sqlIni
sql2St: procedure expose m.
parse arg st, src, ty, fmt
cx = 49
call sql2Cursor cx, src, ty, fmt
call sqlOpen cx
do ix=1 by 1 while sqlFetch(cx, st'.'ix)
end
m.st.0 = ix-1
call sqlClose cx
return ix-1
endProcedure sql2St
sqlPrepare: procedure expose m.
parse arg cx, src, desc
call sqlExec 'prepare s'cx 'from :src'
if desc == 1 | (desc == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
sqlExecute: procedure expose m.
parse arg cx
do ix=1 to arg()-1
val = arg(ix+1)
if val ^== m.sql.null then do
m.sql.cx.i.ix.sqlInd = 0
m.sql.cx.i.ix.sqlData = val
end
else do
m.sql.cx.i.ix.sqlInd = -1
end
end
if ^ m.noInsert then /* ??? wk test */
call sqlExec 'execute s'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure
sqlExImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure sqlExImm
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
call sqlExec 'prepare s'cx 'into :M.SQL.'cx'.D from :src'
call sqlExec 'declare c'cx 'cursor for s'cx
if ty ^= '*' & abbrev(ty, '*') then
if oIsCla(substr(ty, 2)) then
ty = substr(ty, 2)
if abbrev(ty, '*') | ty = '' then do
flds = 'SQL.'cx'.FLD'
ff = ''
do ix=1 to m.sql.cx.d.sqlD
f1 = word(m.sql.cx.d.ix.sqlName, 1)
if f1 == '' then
f1 = 'COL'ix
ff = ff f1
end
if length(ty) > 1 then
ty = oFldOnly(ff, 'e', substr(ty, 2))
else
ty = oFldOnly(ff, 'e')
end
call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
flds = oFlds(ty)
m.Sql.cx.FMT.0 = 0
m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
ff = m.Sql.cx.FMT
call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
return
endProcedure sql2Cursor
sqlType: procedure expose m.
parse arg cx
return oGetTypePara('SQL.TY.'cx)
sqlOpen: procedure expose m.
parse arg cx
return sqlExec('open c'cx)
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
sqlFetchInto:
parse arg ggCx, ggVars
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
sqlFetch: procedure expose m.
parse arg cx, dst
if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
return 0
if dst == '' then
return 1
fi = oFlds(sqlType(cx))
fo = m.sql.cx.fmt
do ix=1 to m.sql.cx.d.SQLD
f = m.fi.ix
if m.sql.cx.d.ix.sqlInd = 0 then
m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
else
m.dst.f = fmtS(m.sql.null, m.fo.ix)
end
return 1
endProcedure sqlFetch
sqlFetchLn: procedure expose m.
parse arg cx, var
st = 'SQL.'cx'.FET'
if ^ sqlFetch(cx, st) then
return 0
m.var = oFldCat(sqlType(cx), st)
return 1
endProcedure sqlFetchLn
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
if abbrev(sp, '=') then
return substr(sp, 2)
if sp = '' then
sp = '*st'
m.ff.0 = m.sql.cx.d.sqlD
m.ff.flds = oFlds(sqlType(cx))
if abbrev(sp, '*') then do
do ix=1 to m.ff.0
m.ff.ix = substr(sp, 2)
end
return ff
end
if abbrev(fmts, '=') then
m.Sql.cx.FMT = substr(fmts, 2)
defs = 'ir7 fr9 sl12 Tl26' sp
do wx = 1 to words(defs)
parse value word(defs, wx) with ty 2 fo
select
when ty = 'd' then t.384 = fo
when ty = 'f' then t.480 = fo'/f'
when ty = 'i' then t.496 = fo'/i'
when ty = 'n' then t.484 = fo'/n'
when ty = 's' then t.448 = fo
when ty = 't' then t.388 = fo
when ty = 'T' then t.392 = fo
otherwise call err 'bad type' ty 'for format' fo
end
end
if symbol('t.496') == 'VAR' then
t.500 = t.496
if symbol('t.448') == 'VAR' then do
t.452 = t.448
t.456 = t.448
t.464 = t.448
end
do wx = 1 to m.ff.0
ty = m.sql.cx.d.wx.sqlType
le = m.sql.cx.d.wx.sqlLen
withNulls = ty // 2
ty = ty - withNulls
if symbol('t.ty') <> 'VAR' then
call err 'sqlType' ty 'not supported'
parse var t.ty fo 2 fl '/' op
if op = 'i' then
if le = 2 then le = 6
else le = 12
else if op <> '' then
call err 'length for sqlType' ty 'op' op 'not implemented'
if fl = '=' then
fl = le
else if abbrev(fl, '<') then
fl = min(le, substr(fl, 2))
m.ff.wx = fo || fl
end
return ff
endProcedure sqlGenFmt
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
sqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call sqlExec "connect" ggSys, ggRetCon ,1
return
endProcedure sqlConnect
sqlDisconnect: procedure
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggRes = 'sqlCode' sqlCodeText(sqlCode, sqlErrMc),
'\nstate' sqlState 'warn'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
ggRes = ggRes'\nstmt = ' ggSqlStmt
ggPref = '\nwith\n '
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
sqlCodeText: procedure expose m.
parse arg co, mc
expEq = 0
if symbol('m.sql.code.0') <> 'VAR' then do
dsn = "'A540769.wk.texv(sql)'"
dsn = "'ORG.U0009.B0106.KIUT23.TEXV(SQLCODES)'"
m.sql.code.0 = 0
if sysDsn(dsn) <> 'OK' then
say 'sqlCode dsn' dsn':' sysDsn(dsn)
else
call readDsn dsn, 'M.SQL.CODE.'
end
co = co + 0
if length(co) < 3 then
co = left(co, 3, 0)
if co > 0 then
co = '+'co
co = co' '
do cx=1 to m.sql.code.0 until abbrev(m.sql.code.cx, co)
end
if cx > m.sql.code.0 then
li = "<<text for sqlCode" co "not found>>"
else
li = m.sql.code.cx
cx = 1
px = 1
res = ''
do forever
nx = pos('${', li, cx)
if nx < 1 then
leave
ex = pos('}', li, nx)
if ex < cx then
call err 'closing } missing in' li
res = res || substr(li, cx, nx - cx)
if expEq then
res = res || '<<' || substr(li, nx+2, ex-nx-2) || ' = '
cx = ex+1
if px > length(mc) then do
res = res || '<<missing>>'
end
else do
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res || substr(mc, px, qx-px)
if expEq then
res = res'>>'
px = qx + 1
end
end
res = res || substr(li, cx)
do while px <= length(mc)
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res '<<extraMsgArg =' substr(mc, px, qx-px)'>>'
px = qx + 1
end
return res
endProcedure sqlCodeText
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure sqlDsn
/*--- sql o interface ------------------------------------------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
if ty = '' then
ty = '*'
if src == '' then
src = envCatStr(' ', 'sb')
call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
call oMutate 'SQL.TY.'cx, 'SqlType'
return 'SQL.TY.'cx
endProcedure sql2obj
sql: procedure expose m.
parse arg cx, src, ty, fo
call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
return
endProcedure sql
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
if fo = '' then
fo = '~'
squash = abbrev(fo, '~')
if ^ abbrev(fo, '=') then
fo = left(fo, squash) 'sl=' substr(fo, squash+1)
t = sql2Obj(cx, src, ty, fo)
if squash then do
call fmtFldSquashRw t, 'opCl'
return
end
m = 'SQL.LN.'cx
call oMutate m, 'SqlLn'
call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
call jWriteAll m.j.jOut, "r£", m
return
endProcedure sqlLn
sqlOini: procedure expose m.
if m.sqlO.ini == 1 then
return
m.sqlO.ini = 1
call sqlIni
call envIni
call oDecMethods oNewClass("SqlType"),
, "jOpen call sqlOpen substr(m, 8)",
, "jClose call sqlClose substr(m, 8)",
, "jRead return sqlFetch(substr(m, 8), var)"
call oDecMethods oNewClass("SqlLn", "SqlType"),
, "jRead return sqlFetchLn(substr(m, 8), var)"
return
endProcedure sqlOini
/* copy sql end **************************************************/
/* copy oFld begin ****************************************************/
oFldIni: procedure expose m.
if m.oFld.ini = 1 then
return
m.oFld.ini = 1
call mIni
m.o.cla.0 = 0
call oFldNew 'Class', '=', , ,
'INST = MET .<>= FLD .<>=Class STEM =Class'
return
endProcedure oFldIni
oFldNew: procedure expose m.
parse arg name, va, st, flds, dup
if pos('*', name) > 0 then
name = oPut('O.CLA', name, , '*')
else
call oPut 'O.CLA', name, , 'n'
m.o.cla.name.inst = 0
m.o.cla.name.val = va
m.o.cla.name.stem = st
m.o.cla.name.FLD.0 = 0
m.o.cla.name.MET.0 = 0
return oFldAdd(name, flds, dup)
endProcedure oFldNew
oIsCla: procedure expose m.
parse arg nm
return symbol('m.o.cla.nm') == 'VAR'
oFldOnly: procedure expose m.
parse arg fs, dup, nm
if nm <> '' then do
nn = oFldNew(nm)
end
else do
kk = space(fs, 1) dup
if symbol('m.o.fldOnly.kk') = 'VAR' then
return m.o.fldOnly.kk
nn = oFldNew('FldType*')
end
st = 'O.CLA.'nn'.FLD'
ll = ''
do wx=1 to words(fs)
ll = ll oPut(st, word(fs, wx), '=', dup)
end
if nm = '' then do
m.o.fldOnly.kk = nn
m.o.fldOnly.ll = nn
end
return nn
endProcedure oFldOnly
oFlds: procedure expose m.
parse arg type
return 'O.CLA.'type'.FLD'
oFldCat: procedure expose m.
parse arg ty, st, fmt
flds = oFlds(ty)
res = ''
do ix=1 to m.flds.0
f = m.flds.ix
if fmt == '' then
res = res m.st.f
else
res = res fmt(m.st.f, m.fmt.ix)
end
return substr(res, 2)
endProcedure oFldCat
oFldAdd: procedure expose m.
parse arg cla, fs, dup
st = 'O.CLA.'cla'.FLD'
do ix=1 by 2 to words(fs)
call oPut st, word(fs, ix), word(fs, ix+1), dup
end
return cla
endProcedure oFldAdd
oPut: procedure expose m.
parse arg st, k, v, dup
if dup = '*' then do
cx = pos('*', k)
if cx < 1 then
call err 'no * in key' k
k = oPutDupResolve(st, left(k, cx-1), 1)
end
else if symbol('m.st.k') = 'VAR' then do
if dup = '' | dup = 'o' then do
m.st.k = v
return k
end
if dup = '=' then do
if v <> m.st.k | ^ (v = '' & datatype(m.st.k, 'n')) then
call err 'not =: m.'st'.'k '=>' m.st.k '<>' v
return k
end
if dup = 'e' then
k = oPutDupResolve(st, k, 2)
else
call err 'key' k 'exists in' st 'but dup' dup
end
else if dup = 'o' then
call err 'old key' k 'does not exist in' st
if datatype(k, 'n') | words(k) <> 1 | pos('.', k) > 0 then
call err 'illegal name' name
x = m.st.0 + 1
m.st.0 = x
m.st.x = k
if v == '' then
m.st.k = x
else
m.st.k = v
return k
endProcedure oPut
oPutDupResolve: procedure expose m.
parse arg st, k, b
do ix=b
a = k || ix
if symbol('m.st.a') <> 'VAR' then
return a
end
endProcedure oPutDupResolve
/*--- parameterized types --------------------------------------------*/
oGetTypePara: procedure expose m.
parse arg m
if symbol('m.o.tyPa.m') == 'VAR' then
return m.o.tyPa.m
else
return '='
endProcedure oGetTypePara
oSetTypePara: procedure expose m.
parse arg m, type, noCall
if type = '' then
type = '='
if oGetTypePara(m) == type then
return
if noCall ^== 'noCall' then
interpret oObjMethod(m, 'oSetTypePara')
m.o.tyPa.m = type
return
endProcedure oSetTypePara
/* copy oFld end ****************************************************/
/* copy fmt begin **************************************************/
fmt: procedure
parse arg v, f 2 l
if abbrev('-', f) then
return v
else if f = 'l' then
return left(v, l)
else if f = 'r' then
return right(v, l)
else if f = 's' then
if l = '' then
return strip(v, 't')
else
return strip(v, l)
else if f = 'w' then do
parse var l st ',' le
return substr(v, st, le)
end
else
call err 'bad format' f l 'for' v
endProcedure fmt
/*--- format special (title, null Value also for numbers) ------------*/
fmtS: procedure expose m.
parse arg v, f
return fmt(v, f)
endProcedure fmtS $
/* copy fmt 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 -------------------------------------------*/
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 = '' & ^ abbrev(disp, 'SYSO') then
return 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 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 map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = ''
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
return a
endProcedure
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
mapAdd: procedure expose m.
parse arg a, ky, val
if symbol('m.a.ky') == 'VAR' then
call err 'duplicate key in mAdd('a',' ky',' val')'
m.a.ky = val
if m.map.keys.a ^== '' then
return mAdd(m.map.keys.a, ky)
return
endProcedure mapAdd
mapPut: procedure expose m.
parse arg a, ky, val
if m.map.keys.a ^== '' then
if symbol('m.a.ky') ^== 'VAR' then
call mAdd m.map.keys.a, ky
m.a.ky = val
return val
endProcedure mapPut
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
drop m.a.ky
return val
endProcedure mapRemove
mapHasKey: procedure expose m.
parse arg a, ky
return symbol('m.a.ky') == 'VAR'
endProcedure mapHasKey
mapGet: procedure expose m.
parse arg a, ky
if symbol('m.a.ky') ^== 'VAR' then
call err 'missing key in mapGet('a',' ky')'
return m.a.ky
endProcedure mapGet
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy m begin ********************************************************
stem handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CHECKRTS) cre=2008-01-28 mod=2008-09-08-13.57.07 F540769 ---
/* REXX */
/******************************************************************/
/* CHECKRTS */
/* -------- */
/* */
/* 1 function: db2 real time statistics für reorg anwenden: */
/* 1. preview der listdefs einlesen */
/* 2. listdefs einlesen */
/* 3. rts abfragen */
/* 4. neue listdef erstellen */
/* */
/* 2 history: */
/* 25.10.2004 v1.0 grundversion (m.streit,A234579) */
/* 16.09.2005 v1.1 inkl.reorg index ohne rts (A234579) */
/* 20.09.2005 v1.2 erweiterte abfrage auf noload repl */
/* 23.09.2005 v2.0 index mit rts-abfrage (A234579) */
/* 10.11.2005 v2.1 schwellwerte erweitert (A234579) */
/* 10.04.2006 v2.2 pgm läuft auch ohne ispf (A234579) */
/* Diagnose Statement erlaubt (A234579) */
/* 20.11.2006 v2.21 RSU0610 bewirkt Meldung: */
/* 'insuff. operands for keyword listdef'*/
/* Neu wird leeres Member erstellt falls */
/* keine Objekte die Schwellwerte erreich*/
/* 04.12.2006 v2.3 Optimierung mit Gruppenbruch-Logik */
/* 10.04.2008 v4.0 Umstellung auf neue exception tabl/vws*/
/* 20.05.2008 v4.1 Bereinigung */
/* 21.08.2008 v4.2 vRtsReoIx.cr (statt .Creator) fuer V9 */
/* 08.09.2008 v4.3 vRtsReoIx.is fuer Indexspace */
/* (nicht null bei fehlenden rts Daten) */
/* */
/* 3 usage checkrts programm(rexx) */
/* S100447.vRtsReoTS db2 ts part Grenzwerte */
/* S100447.vRtsReoIX db2 ix part Grenzwerte */
/* */
/* 4 parms checkrts <parm1> <parm2> */
/* parm1 = db2 subsystem */
/* parm2 = type ts or ix */
/* */
/* 5 location tso.rzx.p0.user.exec */
/* */
/******************************************************************/
m.debug = 0
parse upper arg ssid type fun
if 0 & ssid = '' then /* für online test */
parse upper value 'DBTF TS TEST' with ssid type fun
say "CheckRts Programmversion = 4.3"
say " DB2 Subsystem = "ssid
if type = '' then do
type = 'TS'
say " kein Type gewählt, also TS-Reorg getriggert"
end
say " Type = "type
call errReset 'h'
call mapIni
call sqlIni
call sqlConnect ssid
/*-------------- Hauptprogramm -----------------------------------*/
if fun = '' then
call doCheckRts type, '-ddIn1', '-ddIn2', dsn4allocated('ddOUt1')
else if fun = 'TEST' then
call testCheckRts type
else if fun = 'T0' then
call testRT0 ssid type
else
call err 'bad fun' fun 'in Argumenten' arg(1)
call sqlDisconnect
exit
testRT0: procedure expose m.
parse arg ssid type
MBR=QR04412
MBR=QR57101
call adrTso "alloc dd(ddIn1) shr" ,
"dsn('A540769.CHECKRTS.SYSPRINT("MBR")')"
call adrTso "alloc dd(ddIn2) shr" ,
"dsn('"ssid".DBAA.LISTDEF("MBR"1)')"
/* "dsn('A540769.CHECKRTS.LISTDEF("MBR"1)')" */
call adrTso "alloc dd(ddOut1) shr" ,
"dsn('A540769.CHECKRTS.OLI"type"NEW("MBR")')"
if 1 then do /* neu */
call doCheckRts type, '-ddIn1', '-ddIn2',
, dsn4allocated('ddOUt1')
end
else do /* alt */
call checkRt0 ssid type
say 'checkRt0 rc' rc
end
call adrTso 'free dd(ddIn1 ddIn2 ddOut1)'
return
endProcedure testRT0
testCheckRts: procedure expose m.
parse arg type
mbrs = 'QR04412 QR03202 QR20801'
mbrs = 'QR04412'
mbrs = QR30403
mbrs = QR06801
do mx=1 to words(mbrs)
mb = word(mbrs, mx)
say 'member' mb '**********'
call doCheckRts type, '~checkrts.sysprint('mb')',
, 'DBTF.DBAA.listDef('mb'1)',
, '~checkrts.output('mb')'
/* , '~checkrts.listDef('mb'1)' */
end
return
endProcedure testCheckRts
/*--- main function
analyse utility preview sysprint
analyse utitlity listdef input
check rts
generate new utility ctrl cards ----------------------------*/
doCheckRts: procedure expose m.
parse arg type, ddIn1, ddIn2, ddOut
call mapReset lst, 'K'
call analyzeSysprint lst, ddIn1
call debugLst lst, 'lists in sysprint'
call mapReset ctl, 'K'
call analyzeListdef ctl, ddIn2
call debugListdef ctl
call mapReset rl, 'K'
kk = mapKeys(ctl)
typ1 = left(type, 1)
do kx=1 to m.kk.0
listName = m.kk.kx
if ^ mapHasKey(lst, listName) then do
say '*** warning' listName 'in ListDef,',
'aber nicht im SysPrint (leer?)'
end
else if word(m.lst.listName, 1) ^== typ1 then do
call debug 'list' listName '->' m.lst.listName ,
'nicht type' type 'wird ignoriert'
end
else do
call mapPut rl, listName
call mapReset rl'.'listName, 'K'
call selectRts rl'.'listName, lst'.'listName, type
lstKeys = mapKeys(lst'.'listName)
rtsKeys = mapKeys(rl'.'listName)
if m.lstKeys.0 <> m.rtsKeys.0 then
call err 'Liste' listName 'Anzahl Objekte:',
'sysPrint' m.lstKeys.0 '<> rts' m.rtsKeys.0
end
end
call debugLst rl, 'lists rts selection'
call genCtrl ddOut, rl, type, ctl
return
endProcedure doCheckRts
/*--- generate utiltity ctrl cards for run
ddOut: output dd spec to write ctrl to
all: map of partitions to reorg
type: TS or IX
ctl: input ctrl cards ------------------------------------*/
genCtrl: procedure expose m.
parse arg ddOut, all, type, ctl
if type = 'TS' then
ldType = 'TABLESPACE'
else if type = 'IX' then
ldType = 'INDEXSPACE'
else
call err 'bad type' type
m.o.1 = ' -- checkRts' date('s') time()
m.o.0 = 1
kk = mapKeys(all)
do kx = 1 to m.kk.0
lst = m.kk.kx
call mAdd o, m.lstCount.lst
oStart = m.o.0
lstKeys = mapKeys(all'.'lst)
do lx=1 to m.lstKeys.0
ob = m.lstKeys.lx
rng = mapGet(all'.'lst, ob)
do rx=1 to words(rng)
parse value word(rng, rx) with von '-' bis
if bis = '' then
bis = von
do pa=von to bis
if pa = 0 then
paLe = ''
else
paLe = 'PARTLEVEL('pa')'
call mAdd o, ' INCLUDE' ldType ob paLe
end /* do pa */
end /* do rx */
end /* do ob */
if m.o.0 = oStart then do
m.o.0 = oStart - 1
end
else do
st = ctl'.'lst
do s1=1 to m.st.0
call mAdd o, ' -- utility' s1 'for' lst
do s2=1 to m.st.s1.0
call mAdd o, strip(m.st.s1.s2, 't')
end
end
end
end /* do lst */
call writeDsn ddOut, 'M.'o'.', ,0
return
endProcedure genCtrl
/*--- debug a listDef ------------------------------------------------*/
debugListDef: procedure expose m.
parse arg lst, tit
if m.debug ^== 1 then
return
call debug tit
kk = mapKeys(lst)
do kx=1 to m.kk.0
call debug 'list' m.kk.kx
st = lst'.'m.kk.kx
do s1=1 to m.st.0
do s2=1 to m.st.s1.0
call debug ' ' st'.'s1'.'s2 strip(m.st.s1.s2, t)
end
end
end
return
endProcedure debugListDef
/*--- debug a list ---------------------------------------------------*/
debugLst: procedure expose m.
parse arg lst, tit
if m.debug ^== 1 then
return
call debug tit
k1 = mapKeys(lst)
do kx=1 to m.k1.0
call debug 'list' m.k1.kx '-->' mapGet(lst, m.k1.kx)
call debugMap lst'.'m.k1.kx, ' '
end
return
endProcedure debugLst
/*--- debug a map ----------------------------------------------------*/
debugMap: procedure expose m.
parse arg mp, pr
if m.debug ^== 1 then
return
kk = mapKeys(mp)
do kx=1 to m.kk.0
k2 =
call debug pr m.kk.kx '->' mapGet(mp, m.kk.kx)
end
return
endProcedure debugMap
/*--- select the rts views and
put the partitions to reorg in the map slt -----------------*/
selectRts: procedure expose m.
parse arg slt, lst, type
if type = 'IX' then
sql = 'select db, is, cr, ix, part, reason,',
'real(totalEntries) rows,',
'real(nActive)*4*1024 act,',
'real(space)*1024 space' ,
'from S100447.vRtsReoIX' ,
'where' genWhere(word(m.lst, 1), lst)
else if type = 'TS' then
sql = 'select db, ts, db db2, ts ts2, part, reason,',
'real(totalRows) rows,',
'real(nActive)*pgSize*1024 act,',
'real(space)*1024 space' ,
'from S100447.vRtsReoTS' ,
'where' genWhere(word(m.lst, 1), lst)
else
call err 'selectRts type' type
call debug 'sql1' sql
gr = "case when left(reason, 3) = 'no' then 'NO'" ,
"when left(reason, 10) = 'reorgDays' then 'DAY'" ,
"else 'REO' end"
sql = "with s as ("sql")",
"select * from s" ,
"union all (select ' db', ' ts', 'cr', 'nm', -9," gr ",",
"sum(rows), sum(act), sum(space)",
"from s group by" gr ")",
"order by 1, 2, 5"
call debug 'sql2' sql
call sqlPreOpen 1, sql
act.day = 0
act.no = 0
act.reo = 0
act.sum = -99 /* in case no records fetched */
act.dLi = -99 /* in case no records fetched */
reoMax = .25 /* if we have to reorg more than this part
of the total size */
dayMin = .15 /* than reduce reorg of year old partititons
to that part of size */
dayCum = 0
reoCum = 0
actCalc = 1
drop sql o
feFi = sqlVars('M.O', 'DB TS CR NM PART REASON ROWS ACT SPACE', 1)
do while sqlFetchInto(1, feFi)
if left(m.o.db, 1) = ' ' then do
if ^ actCalc then
call err 'act space must be in beginning'
g = m.o.reason
if m.o.act ^== m.sql.null then
act.g = m.o.act
else
act.g = 1e7
iterate
end
if actCalc then do
actCalc = 0
act.sum = act.day + act.no + act.reo
/* compute the limit for old partitions */
act.dLi = max(act.sum * reoMax - act.reo, dayMin * act.day)
end
key = strip(m.o.db)'.'strip(m.o.ts)
pa = m.o.part + 0
if ^rangeIsIn(mapGet(lst, key), pa) then
call debug 'part' pa 'not in' key
else do
if left(m.o.reason, 3) == 'no ' then
f = 'ignoriere '
else if left(m.o.reason, 10) ^== 'reorgDays ' then do
if m.o.act ^== m.sql.null then
reoCum = reoCum + m.o.act
f = 'reorganisiere'
end
else if dayCum < act.dLi then do
if m.o.act ^== m.sql.null then
dayCum = dayCum + m.o.act
f = 'reorganisiere'
end
else /* over limit for old partitions */
f = 'spaeter '
if ^mapHasKey(slt, key) then
call mapPut slt, key, ''
if abbrev(f, 'r') then
call mapPut slt, key, rangeAdd(mapGet(slt, key), pa)
say f strip(m.o.cr)'.'strip(m.o.nm)||right(pa, 4) m.o.reason
end
end
say statsline('')
say statsLine('Space dieser Objekte')
say statsline(' nicht zu reorganisieren' , act.no)
say statsline(' zu reorganisieren wegen Schwellwerten' , act.reo)
say statsline(' zu reorganisieren da aelter als x Tage' , act.day)
say statsline('' , '=')
say statsLine(' Total' , act.sum)
say statsline('')
say statsLine('Space der generierten Reorgs')
say statsline(' generierte Reorgs wegen Schwellwerten' , reoCum)
say statsline(' generierte Reorgs da aelter als x Tage' , dayCum)
say statsline('' , '=')
say statsLine(' Total generierte Reorgs' , reoCum + dayCum)
say statsline('')
say statsline(' auf spaeter verschobene Reorgs' ,
, act.reo+act.day - reoCum - dayCum)
say statsline(' aelter als x Tage,')
say statsline(' da ueber berechneter Limite von')
say statsline(' ' asMB(act.dLi) 'MB =',
'max('asMB(act.sum) '*' reoMax '-' asMB(act.reo)',' ,
asMB(act.day) '*' dayMin')')
call sqlClose 1
return
endProcedure selectRts
statsLine: procedure expose m.
parse arg m1, by
r = left(m1, 50)
if by == '=' then
r = r || left('', 11, by)
else if by ^== '' then
r = r || right(asMB(by), 8) 'MB'
return r
endProcedure statsLine
asMB: procedure expose m.
parse arg by
return trunc(by/1024/1024 + .5, 0)
/*--- analyze sysprint of utility preview
put listelements in map lst -----------------------------*/
analyzeSysprint: procedure expose m.
parse arg lst, inp
call mapReset lst, 'K'
call readDsn inp, i1.
rx = 1
listName = ''
do while rx <= i1.0
if word(i1.rx, 1) == 'DSNU1020I' then do
ex = wordPos('EXPANDING', i1.rx)
listName = word(i1.rx, ex + 2)
if listName = '' | word(i1.rx, ex + 1) ^== 'LISTDEF' then
call err 'bad expanding line' i1.rx
call mapAdd lst, listName
call mapReset lst.listName, 'K'
rx = rx + 1
end
else if word(i1.rx, 1) == 'LISTDEF' then do
if listname ^== word(i1.rx,2) then
call err 'mismatch in list' listName 'line' i1.rx
m.lstCount.listName = strip(i1.rx)
types = ''
dbs = ''
do rx=rx+1 TO I1.0 while word(i1.rx, 1) = 'INCLUDE'
parse var i1.rx . obj db'.'ts prt
if wordPos(obj, 'TABLESPACE INDEXSPACE') < 1 then
call err 'bad obj type' obj 'in' i1.rx
ty = left(obj, 1)
if types == '' then
types = ty
else if types ^== ty then
call err 'Liste' lst 'mit verschiedene Types' i1.rx
if wordPos(db, dbs) < 1 then
dbs = dbs db
parse var prt 'PARTLEVEL(' part ')'
if part = '' then
part = 0
else
part = part + 0
ky = db'.'ts
if mapHasKey(lst'.'listName, ky) then
call mapPut lst'.'listName, ky,
, rangeAdd(mapGet(lst'.'listName, ky), part)
else
call mapPut lst'.'listName, ky, part
/* say ky '+' part '->' mapGet(lst'.'listName, ky)
*/ end
say 'sysprint list' listName types dbs
call mapPut lst, listName, types dbs
listName = ''
end
else do
rx = rx+1
end
end
return
endProcedure analyzeSysprint
/*--- return the sql where condition
from the partition list in map lst ------------------*/
genWhere: procedure expose m.
parse arg ty, lst
if ty = 'I' then
spFi = 'is'
else if ty = 'T' then
spFi = 'ts'
else
call err 'bad type in genWhere('ty',' lst')'
tyDbs = m.lst
keys = mapKeys(lst)
call debug 'genWhere' lst '-->' m.lst '-->' mapKeys(lst)
wh = ''
do dx=2 to words(tyDbs)
db = word(tyDbs, dx)
fo = 0
do kx=1 to m.keys.0
if ^ abbrev(m.keys.kx, db'.') then
iterate
parse var m.keys.kx pDb '.' pTs
fo = fo + 1
if fo = 1 then
wh = wh "or (db = '"db"' and" spFi "in("
wh = wh "'"pTs"',"
end
if fo > 0 then
wh = left(wh, length(wh)-1)'))'
end
if wh = '' then
return ''
else
return substr(wh, 4)
endProcedure genWhere
rangeTest:
call rt1 '', 1
call rt1 '5', 1
call rt1 '5', 4
call rt1 '5', 5
call rt1 '5', 6
call rt1 '5', 9
call rt1 '4-6', 1
call rt1 '4-6', 3
call rt1 '4-6', 4
call rt1 '4-6', 5
call rt1 '4-6', 6
call rt1 '4-6', 7
call rt1 '4-6', 9
call rt1 '0 4-6', 1
call rt1 '0 4-6', 3
call rt1 '0 4-6', 4
call rt1 '0 4-6', 5
call rt1 '0 4-6', 6
call rt1 '0 4-6', 7
call rt1 '0 4-6', 9
call rt1 '0 4-6 11-12 15', 1
call rt1 '0 4-6 11-12 15', 3
call rt1 '* 4-6 11-12 15', 4
call rt1 '* 4-6 11-12 15', 5
call rt1 '* 4-6 11-12 15', 6
call rt1 '* 4-6 11-12 15', 7
call rt1 '* 4-6 11-12 15', 9
return
endProcedure rangeTest
rt1:procedure
parse arg ra, nn
res = rangeAdd(ra, nn)
say 'rangeAdd' ra',' nn '->' res
return res
endProcedure rt1
/*--- add a member to a range
a range is a string of the form '7 6-9 11' ---------------------*/
rangeAdd: procedure expose m.
parse arg ra, nn
do wx=1 to words(ra)
parse value word(ra, wx) with von '-' bis
if bis = '' then
bis = von
if nn-1 > bis then
iterate
else if nn-1 = bis then
bis = nn
else if nn >= von then
return ra
else if nn+1 = von then
von = nn
else
return strip(subWord(ra, 1, wx-1) nn subWord(ra, wx))
return strip(subWord(ra, 1, wx-1) von'-'bis subWord(ra, wx+1))
end
return strip(ra nn)
endProcedure rangeAdd
/*--- return true/false whether nn is in range ra --------------------*/
rangeIsIn: procedure expose m.
parse arg ra, nn
do wx=1 to words(ra)
parse value word(ra, wx) with von '-' bis
if bis = '' then
bis = von
if nn < von then
return 0
if nn <= bis then
return 1
end
return 0
endProcedure rangeIsIn
/*--- analyse a listdef in dsn spec inp
put the different parts into map ctl -----------------------*/
analyzeListdef: procedure expose m.
parse arg ctl, inp
call readDsn inp, i2.
st = ''
do rx=1 to i2.0
w = word(i2.rx, 1)
if w = '' then do
end
else if wordPos(w, 'REORG COPY REBUILD CHECK QUIESCE UNLOAD' ,
'LOAD MERGECOPY MODIFY RECOVER RUNSTATS DIAGNOSE') ,
> 0 then do
lx = wordPos('LIST', i2.rx)
listName = word(i2.rx, lx+1)
if lx < 1 | lstName = '' then do
say 'no list in' i2.rx
/* could be reorg option unload continue,
thus, ignore it | */
end
else do
if ^ mapHasKey(ctl, listName) then do
call mapAdd ctl, listName
m.ctl.listName.0 = 0
end
st = ctl'.'listName'.'mInc(ctl'.'listName'.0')
m.st.0 = 0
call debug w 'list' listName '->' st
end
end
if st ^== '' then
call mAdd st, i2.rx
end
return
endProcedure analyzeListdef
/*--- search the ds Name alloctade to dd dd --------------------------*/
dsn4Allocated: procedure expose m.
parse upper arg dd
/* it would be much easier with listDsi,
unfortuneatly listDsi returns pds name without member*/
dd = ' 'dd' '
oldOut = outtrap(l.)
call adrTso "listAlc st"
xx = outtrap(off)
do i=2 to l.0 while ^abbrev(l.i, dd)
end
if i > l.0 then
return '' /* dd not found */
j = i-1
dsn = word(l.j, 1)
if abbrev(l.j, ' ') | dsn = '' then
call err 'bad dd lines line\n'i l.i'\n'j l.j
return dsn
endProcedure dsn4Allocated
/***********************************************************************
ende Programm
ab hier kommen nur noch allgemeine Service Routinen
***********************************************************************/
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure
parse arg ggSys, ggRetCon
call sqlIni
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call sqlExec "connect" ggSys, ggRetCon ,1
return
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql end **************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = ''
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
if abbrev(a, 'MAP.') then do
do kx=1 to m.map.loKy.a.0
drop m.map.loKy.a.kx m.map.loVa.a.kx
end
m.map.loKy.a.0 = 0
end
return a
endProcedure mapClear
/*--- return a stem of all keys (including removed ones) -------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
if mapValAdr(a, ky) ^== '' then
call err 'duplicate key in mAdd('a',' ky',' val')'
if length(ky) < 200 then do
m.a.ky = val
end
else do
kx = mInc('MAP.LOKY.'a'.0')
m.map.loKy.a.kx = ky
m.map.loVa.a.kx = val
end
if m.map.keys.a ^== '' then
return mAdd(m.map.keys.a, ky)
return
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky)
if vv ^== '' then
m.vv = val
else
call mapAdd a, ky, val
return val
endProcedure mapPut
/*--- return the value pointer for a key, '' if non existang ---------*/
mapValAdr: procedure expose m.
parse arg a, ky
if length(ky) < 200 then do
if symbol('m.a.ky') == 'VAR' then
return a'.'ky
end
else if ^ abbrev(a, 'MAP.') then do
call err 'key too long mapValAdr('a',' ky')'
end
else do
do kx=1 to m.map.loKy.a.0
if m.map.loKy.a.kx == ky then
return 'MAP.LOVA.'a'.'kx
end
end
return ''
endProcedure mapValAdr
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if abbrev(vv, 'MAP.LOVA.') then
call err 'not implemented mapRemove('a',' ky')'
drop m.a.ky
return val
endProcedure mapRemove
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a,
fail if it does not exist ----------------------------------*/
mapGet: procedure expose m.
parse arg a, ky, noKey
vv = mapValAdr(a, ky)
if vv == '' then
call err 'missing key in mapGet('a',' ky')'
return m.vv
endProcedure mapGet
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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(s005y000) 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CHECKRTX) cre=2008-02-25 mod=2008-11-24-17.34.15 F540769 ---
/* REXX */
/******************************************************************/
/* CHECKRTS */
/* -------- */
/* */
/* 1 function: db2 real time statistics für reorg anwenden: */
/* 1. listdef einlesen */
/* 2. schwellwerte lesen (S100447.texceptions) */
/* 3. rts abfragen */
/* 4. neue listdef erstellen */
/* */
/* 2 history: */
/* 25.10.2004 v1.0 grundversion (m.streit,A234579) */
/* 16.09.2005 v1.1 inkl.reorg index ohne rts (A234579) */
/* 20.09.2005 v1.2 erweiterte abfrage auf noload repl */
/* 23.09.2005 v2.0 index mit rts-abfrage (A234579) */
/* 10.11.2005 v2.1 schwellwerte erweitert (A234579) */
/* 10.04.2006 v2.2 pgm läuft auch ohne ispf (A234579) */
/* Diagnose Statement erlaubt (A234579) */
/* 20.11.2006 v2.21 RSU0610 bewirkt Meldung: */
/* 'insuff. operands for keyword listdef'*/
/* Neu wird leeres Member erstellt falls */
/* keine Objekte die Schwellwerte erreich*/
/* 04.12.2006 v2.3 Optimierung mit Gruppenbruch-Logik */
/* */
/* 3 usage checkrts programm(rexx) */
/* S100447.texceptions_ts db2 tb ausnahmen ts */
/* S100447.vexceptions_ts db2 tb ausnahmen ts view */
/* S100447.texceptions_ix db2 tb ausnahmen ix */
/* S100447.vexceptions_ix db2 tb ausnahmen ix view */
/* */
/* 4 parms checkrts <parm1> <parm2> */
/* parm1 = db2 subsystem */
/* parm2 = type ts or ix */
/* */
/* 5 location tso.rzx.p0.user.exec */
/* */
/******************************************************************/
debug = 0
call mapIni
parse upper arg ssid type
if ssid = '' then
parse value 'TS DBAF' with ssid type
say "Programmversion = 3.1"
say "DB2 Subsystem = "ssid
if type = '' then do
type = 'TS'
say "kein Type gewählt, nur TS-Reorg getriggert"
end
/*-------------- Hauptprogramm -----------------------------------*/
/*----------------------------------------------------------------*/
mbrs = 'QR04412 QR03202 QR20801'
mbrs = 'QR04412'
do mx=1 to words(mbrs)
mb = word(mbrs, mx)
say 'member' mb '**********'
call adrTso 'alloc dd(ddIn1) shr dsn(checkrts.sysprint('mb'P))'
call adrTso 'alloc dd(ddIn2) shr dsn(checkrts.listDef('mb'1))'
call analyzeSysprint
k1 = mapKeys(lst)
do kx=1 to m.k1.0
say 'list' m.k1.kx '-->' mapGet('LST', m.k1.kx)
l2 = 'LST.'m.k1.kx
say l2 m.l2 'genWhere' genWhere(left(m.l2, 1), l2)
k2 = mapKeys(l2)
do x2=1 to m.k2.0
say ' ' m.k2.x2 '-->' mapGet(l2, m.k2.x2)
end
end
call analyzeListdef
ty = 'IT'
do y=1 to length(ty)
l = 'CTRL.'substr(ty, y, 1)
do z=1 to m.l.0
say strip(l'.'z m.l.z, 't')
end
end
call adrTso 'free dd(ddIn1 ddIn2)'
call selectRts 'T'
end
exit
call read_dsn /* input-ds aus jcl einlesen */
call prepare_dsnrexx /* sql-schnittstelle aufbauen */
call connect_subsys /* db2 subsystem verbinden */
if type='TS' then do
call read_exceptions_ts /* lesen exceptions in s100447.texeptions_ts */
end
if type='IX' then do
call read_exceptions_ix /* lesen exceptions in s100447.texeptions_ix */
end
selectRts: procedure expose m.
parse arg t
k1 = mapKeys(lst)
do kx=1
if kx > m.k1.0 then
return 0
say 'list' m.k1.kx '-->' mapGet('LST', m.k1.kx)
l2 = 'LST.'m.k1.kx
if word(m.l2, 1) = t then
leave
end
if t = 'T' then
sql = 'select db, ts, part, reason, totalRows, nActive, space',
'from A540769.vRtsReoTS' ,
'where' genWhere(word(m.l2, 1), l2),
'order by 1, 2, 3'
else
call err 'selectRts type' t
say 'sql' sql
call sqlConnect 'DBAF'
call sql2Cursor 1, sql
return
endProcedure selectRts
analyzeSysprint: procedure expose m.
call mapReset lst, 'K'
call readDsn '-DDIN1', i1.
rx = 1
do while rx <= i1.0
if word(i1.rx, 1) == 'LISTDEF' then do
listname=word(i1.rx,2)
call mapAdd lst, listName
call mapReset lst.listName, 'K'
types = ''
dbs = ''
do rx=rx+1 TO I1.0 while word(i1.rx, 1) = 'INCLUDE'
parse var i1.rx . obj db'.'ts prt
if wordPos(obj, 'TABLESPACE INDEXSPACE') < 1 then
call err 'bad obj type' obj 'in' i1.rx
ty = left(obj, 1)
if pos(ty, types) < 1 then
types = types || ty
if wordPos(db, dbs) < 1 then
dbs = dbs db
parse var prt 'PARTLEVEL(' part ')'
if part = '' then
part = 0
else
part = part + 0
ky = ty':'db'.'ts
if mapHasKey('LST.'listName, ky) then
call mapPut 'LST.'listName, ky,
, rangeAdd(mapGet('LST.'listName, ky), part)
else
call mapPut 'LST.'listName, ky, part
/* say ky '+' part '->' mapGet('LST.'listName, ky)
*/ end
say 'sysprint list' listName types dbs
call mapPut lst, listName, types dbs
end
else do
rx = rx+1
end
end
return
endProcedure analyzeSysprint
genWhere: procedure expose m.
parse arg ty, lst
if ty = 'I' then
spFi = 'indexName'
else if ty = 'T' then
spFi = 'tsName'
else
call err 'bad type in genWhere('ty',' lst')'
tyDbs = m.lst
keys = mapKeys(lst)
say 'genWhere' lst '-->' m.lst '-->' mapKeys(lst)
wh = ''
do dx=2 to words(tyDbs)
db = word(tyDbs, dx)
fo = 0
do kx=1 to m.keys.0
if ^ abbrev(m.keys.kx, ty':'db'.') then
iterate
parse var m.keys.kx pTy ':' pDb '.' pTs
fo = fo + 1
if fo = 1 then
wh = wh "or (dbName = '"db"' and" spFi "in("
wh = wh "'"pTs"',"
end
if fo > 0 then
wh = left(wh, length(wh)-1)'))'
end
if wh = '' then
return ''
else
return substr(wh, 4)
do kx=1 to m.k1.0
say 'list' m.k1.kx '-->' mapGet('LST', m.k1.kx)
l2 = 'LST.'m.k1.kx
k2 = mapKeys(l2)
do x2=1 to m.k2.0
say ' ' m.k2.x2 '-->' mapGet(l2, m.k2.x2)
end
end
rangeTest:
call rt '', 1
call rt '5', 1
call rt '5', 4
call rt '5', 5
call rt '5', 6
call rt '5', 9
call rt '4-6', 1
call rt '4-6', 3
call rt '4-6', 4
call rt '4-6', 5
call rt '4-6', 6
call rt '4-6', 7
call rt '4-6', 9
call rt '0 4-6', 1
call rt '0 4-6', 3
call rt '0 4-6', 4
call rt '0 4-6', 5
call rt '0 4-6', 6
call rt '0 4-6', 7
call rt '0 4-6', 9
call rt '0 4-6 11-12 15', 1
call rt '0 4-6 11-12 15', 3
call rt '* 4-6 11-12 15', 4
call rt '* 4-6 11-12 15', 5
call rt '* 4-6 11-12 15', 6
call rt '* 4-6 11-12 15', 7
call rt '* 4-6 11-12 15', 9
return
rt:procedure
parse arg ra, nn
res = rangeAdd(ra, nn)
say 'rangeAdd' ra',' nn '->' res
return res
rangeAdd: procedure expose m.
parse arg ra, nn
do wx=1 to words(ra)
parse value word(ra, wx) with von '-' bis
if bis = '' then
bis = von
if nn-1 > bis then
iterate
else if nn-1 = bis then
bis = nn
else if nn >= von then
return ra
else if nn+1 = von then
von = nn
else
return strip(subWord(ra, 1, wx-1) nn subWord(ra, wx))
return strip(subWord(ra, 1, wx-1) von'-'bis subWord(ra, wx+1))
end
return strip(ra nn)
endProcedure rangeAdd
then partstm="AND PARTITION="||""right(part,4)""
else partstm=' '
/* Gruppenbruch Logik */
if db <> db_o then
db_flag=1 /* es wird eine neue DB verarbeitet */
else db_flag=0
if (db <> db_o) | (sn <> sn_o) then
sn_flag=1 /* es wird ein neuer TS/IS verarbeitet */
else sn_flag=0
if (obj='TABLESPACE' & type='TS') then do
/* checken ob spezielle schwellwert für ts vorhanden */
/* objekte in interner tabelle suchen */
if sn_flag then do
do q=1 to anztsobject
if (tsobject.q.1=db & tsobject.q.2=sn) then do
reorg_th = tsobject.q.3
unclust_th = tsobject.q.4
farindref_th = tsobject.q.5
nearindref_th = tsobject.q.6
extents_th = tsobject.q.7
inserts_th = tsobject.q.8
updates_th = tsobject.q.9
deletes_th = tsobject.q.10
reorgdays_th = tsobject.q.11
if debug then do
say" Db "db
say" Ts "sn
say" reorg_th "reorg_th
say" unclust_th "unclust_th
say" farindref_th "farindref_th
say" nearindref_th "nearindref_th
say" extents_th "extents_th
say" inserts_th "inserts_th
say" updates_th "updates_th
say" deletes_th "deletes_th
say" reorgdays_th "reorgdays_th
end
leave
end
else do
reorg_th = default_reorg_th
unclust_th = default_unclust_th
farindref_th = default_farindref_th
nearindref_th = default_nearindref_th
extents_th = default_extents_th
inserts_th = default_inserts_th
updates_th = default_updates_th
deletes_th = default_deletes_th
reorgdays_th = default_reorgdays_th
end
end /* do anztsobject */
end /* sn_flag */
if debug then say "call reorg_check_ts..."
call reorg_check_ts
if debug then say "reorg_check_ts ended. result= "ts_reorg
if ts_reorg = y then do
if title_written = 0 then do
queue listtitle
title_written = 1
end
queue ' '||in1.s /* zeile in stack schreiben */
cnt=cnt+1
end
end /* if obj='tablespace' */
if (obj='INDEXSPACE' & type='IX') then do
/* checken ob spezielle schwellwert für ix vorhanden */
/* objekte in interner tabelle suchen */
if sn_flag then do
do q=1 to anzixobject
if (ixobject.q.1=db & ixobject.q.2=sn) then do
reorg_th = ixobject.q.5
pagesplits_th = ixobject.q.6
ixinserts_th = ixobject.q.7
ixdeletes_th = ixobject.q.8
pseudodel_th = ixobject.q.9
reorgdays_th = ixobject.q.10
leave
end
else do
reorg_th = default_reorg_th
pagesplits_th = default_pagesplits_th
ixinserts_th = default_ixinserts_th
ixdeletes_th = default_ixdeletes_th
pseudodel_th = default_pseudodel_th
reorgdays_th = default_reorgdays_th
end
end /* do anzixobject */
end /* sn_flag */
if debug then say "call reorg_check_ix..."
call reorg_check_ix
if debug then say "reorg_check_ix ended. result= "ts_reorg
if ix_reorg = y then do
if title_written = 0 then do
queue listtitle
title_written = 1
end
queue ' '||in1.s /* zeile in stack schreiben */
cnt=cnt+1
end
end /* if obj='indexspace' */
s=s+1
in1.s=strip(in1.s,l)
end /* do while include */
queue '--'
if cnt=0 then do /* falls listdef leer, merke listname */
t=t+1
listobj.t=listname
end
title_written=0
end /* if = listdef */
r=r+1
end /* do until r=anz_in1 */
v=0
analyzeListdef: procedure expose m.
call readDsn '-DDIN2', i2.
say i2.0 i2.1
m.ctrl.i.0 = 0
m.ctrl.t.0 = 0
ty = ''
do rx=1 to i2.0
w = word(i2.rx, 1)
if w = '' then do
end
else if wordPos(w, 'REORG COPY REBUILD CHECK QUIESCE UNLOAD' ,
'LOAD MERGECOPY MODIFY RECOVER RUNSTATS DIAGNOSE') ,
> 0 then do
lx = wordPos('LIST', i2.rx)
if lx < 1 then
lx = 9999
listName = word(i2.rx, lx+1)
if listName = '' then
say 'no list in' i2.rx
else do
ty = word(mapGet(lst, listName), 1)
say 'ty='ty 'lst='listName 'for' i2.rx
end
end
do x=1 to length(ty)
call mAdd 'CTRL.'substr(ty, x, 1), i2.rx
end
end
return
do while v < in2.0 /* anzahl input-linien */
v=v+1
line=strip(in2.v,l)
select
when substr(line,1,12) = 'REORG INDEX ' then write=y
when substr(line,1,6) = 'REORG ' then write=y
when substr(line,1,5) = 'COPY ' then write=y
when substr(line,1,8) = 'REBUILD ' then write=y
when substr(line,1,6) = 'CHECK ' then write=y
when substr(line,1,8) = 'QUIESCE ' then write=y
when substr(line,1,7) = 'UNLOAD ' then write=y
when substr(line,1,5) = 'LOAD ' then write=y
when substr(line,1,10) = 'MERGECOPY ' then write=y
when substr(line,1,7) = 'MODIFY ' then write=y
when substr(line,1,8) = 'RECOVER ' then write=y
/* when substr(line,1,7) = 'REPORT ' then write=y */
when substr(line,1,9) = 'RUNSTATS ' then write=y
when substr(line,1,9) = 'DIAGNOSE ' then write=y
otherwise nop
end
if in2.v = '' then do
write=n /* kein statement vorhanden */
queue ' ' /* leere zeile schreiben */
end
if write=y then do
do e=1 to t
/* wenn liste leer, schreiben verhindern */
if wordpos(listobj.e,in2.v) > 0 then write=n
end
if write=y then queue in2.v /* statement schreiben */
end
end /* do while v < in2.0 */
queue /* nullstring fuer stack ende */
if debug then say "outds="outds
if member = '' then call write_seq
else call write_mem
exit /* Ende Hauptprogramm */
/*----------------------------------------------------------------*/
/*-------------- Output in seq. File schreiben -------------------*/
/*----------------------------------------------------------------*/
write_seq:
if debug then say "enter procedure write_seq..."
call alocds outds
outddn = result
address tso
"EXECIO "queued() " DISKW "outddn" (FINIS)";
if debug then say "ddout1 schreiben rc="rc
if rc > 8 then say "Output konnte nicht geschrieben werden rc="rc
address tso
"DELSTACK"
if debug then say "leave procedure write_seq..."
return
/*----------------------------------------------------------------*/
/*-------------- Output in Member schreiben ----------------------*/
/*----------------------------------------------------------------*/
write_mem:
if debug then say "enter procedure write_mem..."
if debug then say "DSN ="dsn
if debug then say "Member="member
anz_queue_el = queued()
dsn = "'"||dsn||"'"
address ispexec
"LMINIT DATAID(ID1) DATASET("dsn") ENQ(SHRW)"
if rc <> 0 then call fehler(lminit)
"LMOPEN DATAID("id1") OPTION(OUTPUT)"
if rc <> 0 then call fehler(lmopen)
do rec=1 to anz_queue_el
parse pull text
address ispexec
"LMPUT DATAID("id1") MODE(INVAR) DATALOC(TEXT) DATALEN(80)"
if rc <> 0 then call fehler(lmput)
end
"LMMREP DATAID("id1") MEMBER("member")"
if rc > 8 then call fehler(lmopen)
"LMCLOSE DATAID("id1")"
"LMFREE DATAID("id1")"
address tso
"DELSTACK"
if debug then say "leave procedure write_mem..."
return
/*----------------------------------------------------------------*/
/*-------------- Datasets einlesen, DDname zuordnen --------------*/
/*----------------------------------------------------------------*/
read_dsn:
if debug then say "enter procedure read_dsn..."
/* sysprint einlesen */
"EXECIO * DISKR DDIN1 (STEM IN1. FINIS"
anz_in1 = in1.0 /* anzahl input-linien */
/* listdef einlesen */
"EXECIO * DISKR DDIN2 (STEM IN2. FINIS"
/* lese dataset-info zu ddname */
tmp= outtrap(lista.)
address tso
"LISTA ST H"
do icnt=2 to lista.0
if wordpos('DDOUT1',lista.icnt) > 0 then do
iold = icnt-1
parse value lista.iold with dsn '(' member ')' .
/* dsn = pfad, member = membername */
end
end
outds = dsn
if debug then say "leave procedure read_dsn..."
return
/* ------------------------------------------------------------------ */
/* Prozedur zum erstellen eines neuen Files */
/* ------------------------------------------------------------------ */
alocds:
if debug then say "enter procedure alocjclds..."
arg dsn
aaa=dsn; /* DDname generieren */
dda=time();
ddb=translate('124578',dda,'12345678');
ddn='D'ddb;
if sysdsn("'"dsn"'") <> "OK" then do /* this file does not exist */
address tso
"ALLOC DDNAME("ddn") DA('"dsn"')" ,
" NEW CATALOG MGMTCLAS(COM#E005) SPACE (1,5) CYL RELEASE " ,
" BLKSIZE(3120) LRECL(80) RECFM(F , B) DSORG(PS) "
if rc>0 then do
/* dsn = jclds */
address ISPEXEC
'SETMSG MSG(DBSU006) ' /* can't alloc new file */
say "can't alloc new file"
exit('-1')
end
end
else do
address TSO
"ALLOC DDNAME("ddn") DSNAME('"dsn"') SHR REUSE "
if rc>0 then do
address ISPEXEC
'SETMSG MSG(DBSU001) '
say "tmpds konnte nicht alloziert werden"
end
end
if debug then say "leave procedure alocjclds..."
return (ddn)
/*----------------------------------------------------------------*/
/*--------------- zum db2 subsystem verbinden --------------------*/
/*----------------------------------------------------------------*/
prepare_dsnrexx:
if debug then say "enter procedure prepare_dsnrexx..."
address tso 'SUBCOM DSNREXX' /*host cmd env available*/
if rc=1 then /*no, let's make one*/
s_rc = rxsubcom('ADD','DSNREXX','DSNREXX') /*add host cmd env*/
if rc <> 0 & rc<> 1 then call sqlca(prepare dsnrexx)
if debug then say "leave procedure prepare_dsnrexx..."
return
/*----------------------------------------------------------------*/
/*--------------- zum db2 subsystem verbinden --------------------*/
/*----------------------------------------------------------------*/
connect_subsys:
if debug then say "enter procedure connect_subsys..."
address dsnrexx
"CONNECT "ssid
if sqlcode <> 0 then call sqlca(connect subsys)
if debug then say "leave procedure connect_subsys..."
return
/*----------------------------------------------------------------*/
/*--------------- pruefen ob reorg ts noetig ist -----------------*/
/*----------------------------------------------------------------*/
reorg_check_ts: /* x22 */
if debug then say "enter procedure reorg_check_ts..."
ts_reorg = n
address dsnrexx
if debug then say "REORG_TH = "reorg_th
select
when reorg_th = 'ALWAYS' then do
ts_reorg = y
say "TABLESPACE "db"."sn" "partstm||,
" DUE TO REORG = "reorg_th" EXCEPTION"
return
end
when reorg_th = 'NEVER' then do
ts_reorg = n
return
end
when reorg_th = 'THRESHOLD' then nop
when reorg_th = 'DEFAULT' then do
unclust_th = default_unclust_th
farindref_th = default_farindref_th
nearindref_th = default_nearindref_th
extents_th = default_extents_th
inserts_th = default_inserts_th
updates_th = default_updates_th
deletes_th = default_deletes_th
reorgdays_th = default_reorgdays_th
end
otherwise say "Wert ("reorg_th") fuer Feld Reorg ist nicht bekannt"
end /* select */
if debug then do
say "Datenbank = "db
say "Tablespace = "sn
say "Partition = "partstm
outsqlda.1.sqldata = 'dummy' /* schwellwert typ */
outsqlda.2.sqldata = 'dummy' /* schwellwert aktuell */
outsqlda.3.sqldata = 'dummy' /* unbenutzt */
outsqlda.4.sqldata = 'dummy' /* unbenutzt */
outsqlda.5.sqldata = 'dummy' /* unbenutzt */
outsqlda.6.sqldata = 'dummy' /* unbenutzt */
outsqlda.7.sqldata = 'dummy' /* unbenutzt */
end
/* sql statement -----------------------------------------------*/
sql_s1="SELECT 'UNCLUST' ",
",MAX((CAST(REORGUNCLUSTINS AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGUNCLUSTINS AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"unclust_th,
"UNION ",
"SELECT 'FARINDREF' ",
",MAX((CAST(REORGFARINDREF AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGFARINDREF AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"farindref_th,
"UNION ",
"SELECT 'NEARINDREF' ",
",MAX((CAST(REORGNEARINDREF AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGNEARINDREF AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"nearindref_th,
"UNION ",
"SELECT 'EXTENTS' ",
",MAX(EXTENTS) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
"HAVING MAX(EXTENTS)>"extents_th,
"UNION ",
"SELECT 'INSERTS' ",
",MAX((CAST(REORGINSERTS AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGINSERTS AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"inserts_th,
"UNION ",
"SELECT 'UPDATES' ",
",MAX((CAST(REORGUPDATES AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGUPDATES AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"updates_th,
"UNION ",
"SELECT 'DELETES' ",
",MAX((CAST(REORGDELETES AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGDELETES AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"deletes_th,
"UNION ",
"SELECT 'REORGDAYS' ",
",MAX(DAYS(CURRENT TIMESTAMP)-DAYS(REORGLASTTIME)) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX(DAYS(CURRENT TIMESTAMP)- ",
" DAYS(REORGLASTTIME)) > "reorgdays_th,
"UNION ",
"SELECT 'NO RTS DATA', COUNT(*) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND REORGLASTTIME IS NULL ",
" AND LOADRLASTTIME IS NULL ",
"HAVING COUNT(*) > 0 ",
"WITH UR "
/*--------------------------------------------------------------*/
address dsnrexx
"execsql declare c1 cursor for s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ts_declare)
address dsnrexx
"execsql prepare s1 into :outsqlda from :sql_s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ts_prepare)
"execsql open c1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ts_open)
do until (sqlcode<>0)
address dsnrexx
"execsql fetch c1 using descriptor :outsqlda"
if debug then do
say "ts schwellwert sqlcode = "sqlcode
say "outsqlda.1.sqldata= "outsqlda.1.sqldata
say "outsqlda.2.sqldata= "outsqlda.2.sqldata
say "outsqlda.3.sqldata= "outsqlda.3.sqldata
say "outsqlda.4.sqldata= "outsqlda.4.sqldata
say "outsqlda.5.sqldata= "outsqlda.5.sqldata
say "outsqlda.6.sqldata= "outsqlda.6.sqldata
say "outsqlda.7.sqldata= "outsqlda.7.sqldata
end
if sqlcode = 0 then do
if outsqlda.1.sqldata = 'NO RTS DATA' then do
say "TABLESPACE "db"."sn" "partstm ||" DUE TO NO RTS DATA"
end
if outsqlda.1.sqldata = 'REORGDAYS' then do
parse value outsqlda.2.sqldata with akt_rd '.'
if reorgdays_th <> default_reorgdays_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO REORGDAYS > "reorgdays_th" ("akt_rd") "ex
end
if outsqlda.1.sqldata = 'UNCLUST' then do
parse value outsqlda.2.sqldata with akt_uc '.'
if unclust_th <> default_unclust_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO UNCLUST > "unclust_th" ("akt_uc") "ex
end
if outsqlda.1.sqldata = 'FARINDREF' then do
parse value outsqlda.2.sqldata with akt_fi '.'
if farindref_th <> default_farindref_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO FARINDREF > "farindref_th" ("akt_fi") "ex
end
if outsqlda.1.sqldata = 'NEARINDREF' then do
parse value outsqlda.2.sqldata with akt_ni '.'
if nearindref_th <> default_nearindref_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO NEARINDREF > "nearindref_th" ("akt_ni") "ex
end
if outsqlda.1.sqldata = 'EXTENTS' then do
parse value outsqlda.2.sqldata with akt_ex '.'
if extents_th <> default_extents_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO EXTENTS > "extents_th" ("akt_ex") "ex
end
if outsqlda.1.sqldata = 'INSERTS' then do
parse value outsqlda.2.sqldata with akt_in '.'
if inserts_th <> default_inserts_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO INSERTS > "inserts_th" ("akt_in") "ex
end
if outsqlda.1.sqldata = 'UPDATES' then do
parse value outsqlda.2.sqldata with akt_up '.'
if updates_th <> default_updates_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO UPDATES > "updates_th" ("akt_up") "ex
end
if outsqlda.1.sqldata = 'DELETES' then do
parse value outsqlda.2.sqldata with akt_de '.'
if deletes_th <> default_deletes_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO DELETES > "deletes_th" ("akt_de") "ex
end
ts_reorg = y
end
end /* do until (sqlcode<>0) */
"execsql close c1"
if (sqlcode <> 0 ) then call sqlca(reorg_check_ts_close)
if debug then say "leave procedure reorg_check_ts..."
return
/*----------------------------------------------------------------*/
/*--------------- pruefen ob reorg ix noetig ist -----------------*/
/*----------------------------------------------------------------*/
reorg_check_ix: /* x33 */
if debug then say "enter procedure reorg_check_ix..."
ix_reorg = n
address dsnrexx
if debug then say "REORG_TH = "reorg_th
select
when reorg_th = 'ALWAYS' then do
ts_reorg = y
say "indexspace "db"."sn" "partstm||,
" DUE TO REORG = "reorg_th" EXCEPTION"
return
end
when reorg_th = 'NEVER' then do
ts_reorg = n
return
end
when reorg_th = 'THRESHOLD' then nop
when reorg_th = 'DEFAULT' then do
pagesplits_th = default_pagesplits_th
ixinserts_th = default_ixinserts_th
ixdeletes_th = default_ixdeletes_th
pseudodel_th = default_pseudodel_th
reorgdays_th = default_reorgdays_th
end
otherwise say "Wert ("reorg_th") fuer Feld Reorg ist nicht bekannt"
end /* select */
if debug then do
say "Datenbank = "db
say "Indexspace = "sn
say "Partition = "partstm
outsqlda.1.sqldata = 'dummy' /* schwellwert typ */
outsqlda.2.sqldata = 'dummy' /* schwellwert aktuell */
outsqlda.3.sqldata = 'dummy' /* unbenutzt */
outsqlda.4.sqldata = 'dummy' /* unbenutzt */
outsqlda.5.sqldata = 'dummy' /* unbenutzt */
outsqlda.6.sqldata = 'dummy' /* unbenutzt */
outsqlda.7.sqldata = 'dummy' /* unbenutzt */
end
/* sql statement -----------------------------------------------*/
sql_s1="SELECT 'PAGESPLITS', ",
" MAX((CAST(REORGLEAFFAR AS REAL)/ ",
" CAST(NACTIVE AS REAL))*100) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND T.NACTIVE > 0 ",
"HAVING MAX((CAST(REORGLEAFFAR AS REAL)/ ",
" CAST(NACTIVE AS REAL))*100)>"pagesplits_th,
"UNION ",
"SELECT 'INSERTS', ",
" MAX( CAST(REORGINSERTS AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND T.TOTALENTRIES > 0 ",
"HAVING MAX( CAST(REORGINSERTS AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) > "ixinserts_th,
"UNION ",
"SELECT 'DELETES', ",
" MAX( CAST(REORGDELETES AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND T.TOTALENTRIES > 0 ",
"HAVING MAX( CAST(REORGDELETES AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) > "ixdeletes_th,
"UNION ",
"SELECT 'PSEUDODEL', ",
" MAX( CAST(REORGPSEUDODELETES AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND T.TOTALENTRIES > 0 ",
"HAVING MAX( CAST(REORGPSEUDODELETES AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) > "pseudodel_th,
"UNION ",
"SELECT 'REORGDAYS',COUNT(*) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" HAVING ",
" MAX( DAYS(CURRENT TIMESTAMP) ",
" -DAYS(REBUILDLASTTIME)) > "reorgdays_th,
" AND ",
" MAX( DAYS(CURRENT TIMESTAMP) ",
" -DAYS(REORGLASTTIME)) > "reorgdays_th,
" AND ",
" MAX( DAYS(CURRENT TIMESTAMP) ",
" -DAYS(LOADRLASTTIME)) > "reorgdays_th,
" AND COUNT(*) > 0 ",
"UNION ",
"SELECT 'NO RTS DATA',COUNT(*) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND REORGLASTTIME IS NULL ",
" AND LOADRLASTTIME IS NULL ",
" AND REBUILDLASTTIME IS NULL ",
" HAVING COUNT(*) > 0 ",
"WITH UR "
/*--------------------------------------------------------------*/
address dsnrexx
"execsql declare c1 cursor for s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ix_declare)
address dsnrexx
"execsql prepare s1 into :outsqlda from :sql_s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ix_prepare)
"execsql open c1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ix_open)
do until (sqlcode<>0)
address dsnrexx
"execsql fetch c1 using descriptor :outsqlda"
if debug then say "ix schwellwert sqlcode = "sqlcode
if sqlcode = 0 then do
if outsqlda.1.sqldata = 'NO RTS DATA' then do
say "INDEXSPACE "db"."sn" "partstm ||" DUE TO NO RTS DATA"
end
if outsqlda.1.sqldata = 'REORGDAYS' then do
if reorgdays_th <> default_reorgdays_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO NO REORG SINCE "reorgdays_th" DAYS "ex
end
if outsqlda.1.sqldata = 'PAGESPLITS' then do
parse value outsqlda.2.sqldata with akt_ps '.'
if pagesplits_th <> default_pagesplits_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO PAGESPLITS > "pagesplits_th" ("akt_ps")"ex
end
if outsqlda.1.sqldata = 'INSERTS' then do
parse value outsqlda.2.sqldata with akt_in '.'
if ixinserts_th <> default_ixinserts_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO INSERTS > "ixinserts_th" ("akt_in")"ex
end
if outsqlda.1.sqldata = 'DELETES' then do
parse value outsqlda.2.sqldata with akt_de '.'
if ixdeletes_th <> default_ixdeletes_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO DELETES > "ixdeletes_th" ("akt_de")"ex
end
if outsqlda.1.sqldata = 'PSEUDODEL' then do
parse value outsqlda.2.sqldata with akt_de '.'
if pseudodel_th <> default_pseudodel_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO PSEUDODEL > "pseudodel_th" ("akt_de")"ex
end
ix_reorg = y
end
end
"execsql close c1"
if (sqlcode <> 0 ) then call sqlca(reorg_check_ix_close)
if debug then say "leave procedure reorg_check_ix..."
return
/*----------------------------------------------------------------*/
/*------pruefen ob für ts ausnahme definiert ist -----------------*/
/*----------------------------------------------------------------*/
read_exceptions_ts: /* x44 */
if debug then say "enter procedure read_exceptions_ts..."
y=0
address dsnrexx
/* sql statement -----------------------------------------------*/
sql_s1="SELECT DBNAME ",
" ,TSNAME ",
" ,REORG ",
" ,UNCLUST ",
" ,FARINDREF ",
" ,NEARINDREF ",
" ,EXTENTS ",
" ,INSERTS ",
" ,UPDATES ",
" ,DELETES ",
" ,REORGDAYS ",
" FROM S100447.TEXCEPTIONS_TS ",
" FOR FETCH ONLY ",
"WITH UR "
/*--------------------------------------------------------------*/
/* host variablen zuweisung ------------------------------------*/
hvs_s1=" :HVDBNAME ",
" ,:HVTSNAME ",
" ,:HVREORG :INDREORG ",
" ,:HVUNCLUST :INDUNCLUST ",
" ,:HVFARINDREF :INDFARINDREF ",
" ,:HVNEARINDREF :INDNEARINDREF ",
" ,:HVEXTENTS :INDEXTENTS ",
" ,:HVINSERTS :INDINSERTS ",
" ,:HVUPDATES :INDUPDATES ",
" ,:HVDELETES :INDDELETES ",
" ,:HVREORGDAYS :INDREORGDAYS "
/*--------------------------------------------------------------*/
address dsnrexx
"execsql declare c1 cursor for s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_declare)
address dsnrexx
"execsql prepare s1 from :sql_s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_prepare)
"execsql open c1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_open)
"execsql fetch c1 into "hvs_s1
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_fetch1)
do while (sqlcode = 0)
if debug then do
say "ts ausnahme sqlcode = "sqlcode
say "dbname = " translate(hvdbname)
say "tsname = " translate(hvtsname)
say "reorg = " hvreorg "ind = "indreorg
say "unclust = " hvunclust "ind = "indunclust
say "farindref = " hvfarindref "ind = "indfarindref
say "nearindref= " hvnearindref"ind = "indnearindref
say "extents = " hvextents "ind = "indextents
say "inserts = " hvinserts "ind = "indinserts
say "updates = " hvupdates "ind = "indupdates
say "deletes = " hvdeletes "ind = "inddeletes
say "reorgdays = " hvreorgdays "ind = "indreorgdays
end
/* wenn hostvariable=null, dann default, sonst wert aus hv */
y=y+1
tsobject.y.1 = translate(hvdbname)
tsobject.y.2 = translate(hvtsname)
if indreorg = '-1' then tsobject.y.3 = default_reorg_th
else tsobject.y.3 = hvreorg
if indunclust = '-1' then tsobject.y.4 = default_unclust_th
else tsobject.y.4 = hvunclust
if indfarindref = '-1' then tsobject.y.5 = default_farindref_th
else tsobject.y.5 = hvfarindref
if indnearindref= '-1' then tsobject.y.6 = default_nearindref_th
else tsobject.y.6 = hvnearindref
if indextents = '-1' then tsobject.y.7 = default_extents_th
else tsobject.y.7 = hvextents
if indinserts = '-1' then tsobject.y.8 = default_inserts_th
else tsobject.y.8 = hvinserts
if indupdates = '-1' then tsobject.y.9 = default_updates_th
else tsobject.y.9 = hvupdates
if inddeletes = '-1' then tsobject.y.10 = default_deletes_th
else tsobject.y.10 = hvdeletes
if indreorgdays = '-1' then tsobject.y.11 = default_reorgdays_th
else tsobject.y.11 = hvreorgdays
address dsnrexx
"execsql fetch c1 into "hvs_s1
end /* do while */
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_fetch)
anztsobject = y
"execsql close c1"
if (sqlcode <> 0 & sqlcode <> 100)
then call sqlca(read_exceptions_ts_close)
if debug then say "leave procedure read_exceptions_ts..."
return
/*----------------------------------------------------------------*/
/*------pruefen ob für ix ausnahme definiert ist -----------------*/
/*----------------------------------------------------------------*/
read_exceptions_ix: /* x66 */
if debug then say "enter procedure read_exceptions_ix..."
/* init local vars */
y=0
hvdbname = 'dummy'
hvisname = 'dummy'
hvreorg = 'dummy'
hvpagesplits = 'dummy'
hvixinserts = 'dummy'
hvixdeletes = 'dummy'
hvpseudodel = 'dummy'
hvreorgdays = 'dummy'
indreorg = 'dummy'
indpagesplits = 'dummy'
indixinserts = 'dummy'
indixdeletes = 'dummy'
indpseudodel = 'dummy'
indreorgdays = 'dummy'
address dsnrexx
/* sql statement -----------------------------------------------*/
sql_s1="SELECT IX.DBNAME ",
" ,IX.INDEXSPACE ",
" ,IX.CREATOR ",
" ,IX.NAME ",
" ,EXC.REORG ",
" ,EXC.PAGESPLITS ",
" ,EXC.INSERTS ",
" ,EXC.DELETES ",
" ,EXC.PSEUDODEL ",
" ,EXC.REORGDAYS ",
" FROM S100447.TEXCEPTIONS_IX EXC ",
" JOIN SYSIBM.SYSINDEXES IX ",
" ON EXC.INDEXNAME = IX.NAME ",
" AND EXC.CREATOR = IX.CREATOR ",
"WITH UR "
/*--------------------------------------------------------------*/
/* host variablen zuweisung ------------------------------------*/
hvs_s1=" :HVDBNAME ",
" ,:HVISNAME ",
" ,:HVIXCREATOR ",
" ,:HVIXNAME ",
" ,:HVREORG :INDREORG ",
" ,:HVPAGESPLITS :INDPAGESPLITS ",
" ,:HVIXINSERTS :INDIXINSERTS ",
" ,:HVIXDELETES :INDIXDELETES ",
" ,:HVPSEUDODEL :INDPSEUDODEL ",
" ,:HVREORGDAYS :INDREORGDAYS "
/*--------------------------------------------------------------*/
address dsnrexx
"execsql declare c1 cursor for s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ix_declare)
address dsnrexx
"execsql prepare s1 from :sql_s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ix_prepare)
"execsql open c1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ix_open)
do while (sqlcode = 0)
if debug then do
say "ix ausnahme sqlcode = "sqlcode
say "dbname = " translate(hvdbname)
say "indexspace = " translate(hvisname)
say "creator = " translate(hvixcreator)
say "indexname = " translate(hvixname)
say "reorg = " hvreorg "ind = "indreorg
say "pagesplits = " hvpagesplits "ind = "indpagesplits
say "inserts = " hvixinserts "ind = "indixinserts
say "deletes = " hvixdeletes "ind = "indixdeletes
say "pseudodel = " hvpseudodel "ind = "indpseudodel
say "reorgdays = " hvreorgdays "ind = "indreorgdays
end
/* wenn hostvariable=null, dann default, sonst wert aus hv */
y=y+1
ixobject.y.1 = translate(hvdbname)
ixobject.y.2 = translate(hvisname)
ixobject.y.3 = translate(hvixname)
ixobject.y.4 = translate(hvixcreator)
if indreorg = '-1' then ixobject.y.5 = default_reorg_th
else ixobject.y.5 = hvreorg
if indpagesplits = '-1' then ixobject.y.6 = default_pagesplits_th
else ixobject.y.6 = hvpagesplits
if indixinserts = '-1' then ixobject.y.7 = default_ixinserts_th
else ixobject.y.7 = hvixinserts
if indixdeletes = '-1' then ixobject.y.8 = default_ixdeletes_th
else ixobject.y.8 = hvixdeletes
if indpseudodel = '-1' then ixobject.y.9 = default_pseudodel_th
else ixobject.y.9 = hvpseudodel
if indreorgdays = '-1' then ixobject.y.10 = default_reorgdays_th
else ixobject.y.10 = hvreorgdays
address dsnrexx
"execsql fetch c1 into "hvs_s1
end /* do while */
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ix_fetch)
anzixobject = y
"execsql close c1"
if (sqlcode <> 0 & sqlcode <> 100)
then call sqlca(read_exceptions_ix_close)
if debug then say "leave procedure read_exceptions_ix..."
return
/*----------------------------------------------------------------*/
/*--------- ausgeben von sql-fehlerbeschreibung sqlca ------------*/
/*----------------------------------------------------------------*/
sqlca:
if debug then say "enter procedure sqlca..."
arg sqlca_description
say ""
say " -------------------------------------------"
say "¦ sqlca for... = "sqlca_description
say "¦ sqlcode = "sqlcode
say "¦ sqlerrmc = "sqlerrmc
say "¦ sqlerrp = "sqlerrp
say "¦ sqlerrd.3 = "sqlerrd.3
say "¦ sqlerrd.4 = "sqlerrd.4
say "¦ sqlerrd.5 = "sqlerrd.5
say "¦ sqlerrd.6 = "sqlerrd.6
say " -------------------------------------------"
say ""
if debug then say "leave procedure sqlca..."
return
/*----------------------------------------------------------------*/
/*--------- ausgeben von fehlermeldungen -------------------------*/
/*----------------------------------------------------------------*/
fehler:
if debug then say "enter procedure fehler..."
arg fehlerquelle
say "rc= "rc||" bei "fehlerquelle
if debug then say "leave procedure fehler..."
exit
return
/* copy sql begin ***************************************************
sql interface
sqlIni --> nur sql ohne o und j Anbindung
sqlOini --> sql mit o und j Anbindung
***********************************************************************/
sqlIni: procedure expose m.
if m.sql.ini == 1 then
return
m.sql.ini = 1
call mIni
m.sql.null = '---'
return
endProcedure sqlIni
sql2St: procedure expose m.
parse arg st, src, ty, fmt
cx = 49
call sql2Cursor cx, src, ty, fmt
call sqlOpen cx
do ix=1 by 1 while sqlFetch(cx, st'.'ix)
end
m.st.0 = ix-1
call sqlClose cx
return ix-1
endProcedure sql2St
sqlPrepare: procedure expose m.
parse arg cx, src, desc
call sqlExec 'prepare s'cx 'from :src'
if desc == 1 | (desc == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
sqlExecute: procedure expose m.
parse arg cx
do ix=1 to arg()-1
val = arg(ix+1)
if val ^== m.sql.null then do
m.sql.cx.i.ix.sqlInd = 0
m.sql.cx.i.ix.sqlData = val
end
else do
m.sql.cx.i.ix.sqlInd = -1
end
end
if ^ m.noInsert then /* ??? wk test */
call sqlExec 'execute s'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure
sqlExeImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure exeImm
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
call sqlExec 'prepare s'cx 'into :M.SQL.'cx'.D from :src'
call sqlExec 'declare c'cx 'cursor for s'cx
if ty == '*' | ty = '' then do
flds = 'SQL.'cx'.FLD'
ff = ''
do ix=1 to m.sql.cx.d.sqlD
f1 = word(m.sql.cx.d.ix.sqlName, 1)
if f1 == '' then
f1 = 'COL'ix
ff = ff f1
end
ty = oFldOnly(ff, 'e')
end
call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
flds = oFlds(ty)
m.Sql.cx.FMT.0 = 0
m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
ff = m.Sql.cx.FMT
call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
return
endProcedure sql2Cursor
sqlType: procedure expose m.
parse arg cx
return oGetTypePara('SQL.TY.'cx)
sqlOpen: procedure expose m.
parse arg cx
return sqlExec('open c'cx)
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
sqlFetchInto:
parse arg ggCx, ggVars
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
sqlFetch: procedure expose m.
parse arg cx, dst
if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
return 0
if dst == '' then
return 1
fi = oFlds(sqlType(cx))
fo = m.sql.cx.fmt
do ix=1 to m.sql.cx.d.SQLD
f = m.fi.ix
if m.sql.cx.d.ix.sqlInd = 0 then
m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
else
m.dst.f = fmtS(m.sql.null, m.fo.ix)
end
return 1
endProcedure sqlFetch
sqlFetchLn: procedure expose m.
parse arg cx, var
st = 'SQL.'cx'.FET'
if ^ sqlFetch(cx, st) then
return 0
m.var = oFldCat(sqlType(cx), st)
return 1
endProcedure sqlFetchLn
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
if abbrev(sp, '=') then
return substr(sp, 2)
if sp = '' then
sp = '*st'
m.ff.0 = m.sql.cx.d.sqlD
m.ff.flds = oFlds(sqlType(cx))
if abbrev(sp, '*') then do
do ix=1 to m.ff.0
m.ff.ix = substr(sp, 2)
end
return ff
end
if abbrev(fmts, '=') then
m.Sql.cx.FMT = substr(fmts, 2)
defs = 'ir7 fr9 sl12 Tl26' sp
do wx = 1 to words(defs)
parse value word(defs, wx) with ty 2 fo
select
when ty = 'd' then t.384 = fo
when ty = 'f' then t.480 = fo'/f'
when ty = 'i' then t.496 = fo'/i'
when ty = 'n' then t.484 = fo'/n'
when ty = 's' then t.448 = fo
when ty = 't' then t.388 = fo
when ty = 'T' then t.392 = fo
otherwise call err 'bad type' ty 'for format' fo
end
end
if symbol('t.496') == 'VAR' then
t.500 = t.496
if symbol('t.448') == 'VAR' then do
t.452 = t.448
t.456 = t.448
t.464 = t.448
end
do wx = 1 to m.ff.0
ty = m.sql.cx.d.wx.sqlType
le = m.sql.cx.d.wx.sqlLen
withNulls = ty // 2
ty = ty - withNulls
if symbol('t.ty') <> 'VAR' then
call err 'sqlType' ty 'not supported'
parse var t.ty fo 2 fl '/' op
if op = 'i' then
if le = 2 then le = 6
else le = 12
else if op <> '' then
call err 'length for sqlType' ty 'op' op 'not implemented'
if fl = '=' then
fl = le
else if abbrev(fl, '<') then
fl = min(le, substr(fl, 2))
m.ff.wx = fo || fl
end
return ff
endProcedure sqlGenFmt
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
sqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call sqlExec "connect" ggSys, ggRetCon ,1
return
endProcedure sqlConnect
sqlDisconnect: procedure
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggRes = 'sqlCode' sqlCodeText(sqlCode, sqlErrMc),
'\nstate' sqlState 'warn'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
ggRes = ggRes'\nstmt = ' ggSqlStmt
ggPref = '\nwith\n '
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
sqlCodeText: procedure expose m.
parse arg co, mc
expEq = 0
if symbol('m.sql.code.0') <> 'VAR' then do
dsn = "'A540769.wk.texv(sql)'"
dsn = "'ORG.U0009.B0106.KIUT23.TEXV(SQLCODES)'"
m.sql.code.0 = 0
if sysDsn(dsn) <> 'OK' then
say 'sqlCode dsn' dsn':' sysDsn(dsn)
else
call readDsn dsn, 'M.SQL.CODE.'
end
co = co + 0
if length(co) < 3 then
co = left(co, 3, 0)
if co > 0 then
co = '+'co
co = co' '
do cx=1 to m.sql.code.0 until abbrev(m.sql.code.cx, co)
end
if cx > m.sql.code.0 then
li = "<<text for sqlCode" co "not found>>"
else
li = m.sql.code.cx
cx = 1
px = 1
res = ''
do forever
nx = pos('${', li, cx)
if nx < 1 then
leave
ex = pos('}', li, nx)
if ex < cx then
call err 'closing } missing in' li
res = res || substr(li, cx, nx - cx)
if expEq then
res = res || '<<' || substr(li, nx+2, ex-nx-2) || ' = '
cx = ex+1
if px > length(mc) then do
res = res || '<<missing>>'
end
else do
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res || substr(mc, px, qx-px)
if expEq then
res = res'>>'
px = qx + 1
end
end
res = res || substr(li, cx)
do while px <= length(mc)
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res '<<extraMsgArg =' substr(mc, px, qx-px)'>>'
px = qx + 1
end
return res
endProcedure sqlCodeText
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure sqlDsn
/*--- sql o interface ------------------------------------------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
if ty = '' then
ty = '*'
if src == '' then
src = envCatStr(' ', 'sb')
call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
call oMutate 'SQL.TY.'cx, 'SqlType'
return 'SQL.TY.'cx
endProcedure sql2obj
sql: procedure expose m.
parse arg cx, src, ty, fo
call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
return
endProcedure sql
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
if fo = '' then
fo = '~'
squash = abbrev(fo, '~')
if ^ abbrev(fo, '=') then
fo = left(fo, squash) 'sl=' substr(fo, squash+1)
t = sql2Obj(cx, src, ty, fo)
if squash then do
call fmtFldSquashRw t, 'opCl'
return
end
m = 'SQL.LN.'cx
call oMutate m, 'SqlLn'
call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
call jWriteAll m.j.jOut, "r£", m
return
endProcedure sqlLn
sqlOini: procedure expose m.
if m.sqlO.ini == 1 then
return
m.sqlO.ini = 1
call sqlIni
call envIni
call oDecMethods oNewClass("SqlType"),
, "jOpen call sqlOpen substr(m, 8)",
, "jClose call sqlClose substr(m, 8)",
, "jRead return sqlFetch(substr(m, 8), var)"
call oDecMethods oNewClass("SqlLn", "SqlType"),
, "jRead return sqlFetchLn(substr(m, 8), var)"
return
endProcedure sqlOini
/* copy sql end **************************************************/
/* copy oFld begin ****************************************************/
oFldNew: procedure expose m.
parse arg name, va, st, flds, dup
if pos('*', name) > 0 then
name = oPut('O.CLA', name, , '*')
else
call oPut 'O.CLA', name, , 'n'
m.o.cla.name.inst = 0
m.o.cla.name.val = va
m.o.cla.name.stem = st
m.o.cla.name.FLD.0 = 0
m.o.cla.name.MET.0 = 0
return oFldAdd(name, flds, dup)
endProcedure oFldNew
oFldOnly: procedure expose m.
parse arg fs, dup
kk = space(fs, 1) dup
if symbol('m.o.fldOnly.kk') = 'VAR' then
return m.o.fldOnly.kk
nn = oFldNew('FldType*')
st = 'O.CLA.'nn'.FLD'
ll = ''
do wx=1 to words(fs)
ll = ll oPut(st, word(fs, wx), '=', dup)
end
if symbol('m.o.fldOnly.ll') = 'VAR' then
nn = m.o.fldOnly.ll
m.o.fldOnly.kk = nn
m.o.fldOnly.ll = nn
return nn
endProcedure oFldOnly
oFldCat: procedure expose m.
parse arg ty, st, fmt
flds = oFlds(ty)
res = ''
do ix=1 to m.flds.0
f = m.flds.ix
if fmt == '' then
res = res m.st.f
else
res = res fmt(m.st.f, m.fmt.ix)
end
return substr(res, 2)
endProcedure oFldCat
oFldAdd: procedure expose m.
parse arg cla, fs, dup
st = 'O.CLA.'cla'.FLD'
do ix=1 by 2 to words(fs)
call oPut st, word(fs, ix), word(fs, ix+1), dup
end
return cla
endProcedure oFldAdd
oPut: procedure expose m.
parse arg st, k, v, dup
if dup = '*' then do
cx = pos('*', k)
if cx < 1 then
call err 'no * in key' k
k = oPutDupResolve(st, left(k, cx-1), 1)
end
else if symbol('m.st.k') = 'VAR' then do
if dup = '' | dup = 'o' then do
m.st.k = v
return k
end
if dup = '=' then do
if v <> m.st.k | ^ (v = '' & datatype(m.st.k, 'n')) then
call err 'not =: m.'st'.'k '=>' m.st.k '<>' v
return k
end
if dup = 'e' then
k = oPutDupResolve(st, k, 2)
else
call err 'key' k 'exists in' st 'but dup' dup
end
else if dup = 'o' then
call err 'old key' k 'does not exist in' st
if datatype(k, 'n') | words(k) <> 1 | pos('.', k) > 0 then
call err 'illegal name' name
x = m.st.0 + 1
m.st.0 = x
m.st.x = k
if v == '' then
m.st.k = x
else
m.st.k = v
return k
endProcedure oPut
oPutDupResolve: procedure expose m.
parse arg st, k, b
do ix=b
a = k || ix
if symbol('m.st.a') <> 'VAR' then
return a
end
endProcedure oPutDupResolve
/*--- parameterized types --------------------------------------------*/
oGetTypePara: procedure expose m.
parse arg m
if symbol('m.o.tyPa.m') == 'VAR' then
return m.o.tyPa.m
else
return '='
endProcedure oGetTypePara
oSetTypePara: procedure expose m.
parse arg m, type, noCall
if type = '' then
type = '='
if oGetTypePara(m) == type then
return
if noCall ^== 'noCall' then
interpret oObjMethod(m, 'oSetTypePara')
m.o.tyPa.m = type
return
endProcedure oSetTypePara
oFldIni: procedure expose m.
if m.oType.ini = 1 then
return
m.o.cla.0 = 0
call oFldNew 'Class', '=', , ,
'INST = MET .<>= FLD .<>=Class STEM =Class'
return
endProcedure oFldIni
/* copy oFld end ***************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = ''
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
return a
endProcedure
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
mapAdd: procedure expose m.
parse arg a, ky, val
if symbol('m.a.ky') == 'VAR' then
call err 'duplicate key in mAdd('a',' ky',' val')'
m.a.ky = val
if m.map.keys.a ^== '' then
return mAdd(m.map.keys.a, ky)
return
endProcedure mapAdd
mapPut: procedure expose m.
parse arg a, ky, val
if m.map.keys.a ^== '' then
if symbol('m.a.ky') ^== 'VAR' then
call mAdd m.map.keys.a, ky
m.a.ky = val
return val
endProcedure mapPut
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
drop m.a.ky
return val
endProcedure mapRemove
mapHasKey: procedure expose m.
parse arg a, ky
return symbol('m.a.ky') == 'VAR'
endProcedure mapHasKey
mapGet: procedure expose m.
parse arg a, ky
if symbol('m.a.ky') ^== 'VAR' then
call err 'missing key in mapGet('a',' ky')'
return m.a.ky
endProcedure mapGet
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy m begin ********************************************************
stem handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CHECKRTZ) cre=2008-04-29 mod=2008-11-24-17.34.15 F540769 ---
/* REXX */
/******************************************************************/
/* CHECKRTS */
/* -------- */
/* */
/* 1 function: db2 real time statistics für reorg anwenden: */
/* 1. preview der listdefs einlesen */
/* 2. listdefs einlesen */
/* 3. rts abfragen */
/* 4. neue listdef erstellen */
/* */
/* 2 history: */
/* 25.10.2004 v1.0 grundversion (m.streit,A234579) */
/* 16.09.2005 v1.1 inkl.reorg index ohne rts (A234579) */
/* 20.09.2005 v1.2 erweiterte abfrage auf noload repl */
/* 23.09.2005 v2.0 index mit rts-abfrage (A234579) */
/* 10.11.2005 v2.1 schwellwerte erweitert (A234579) */
/* 10.04.2006 v2.2 pgm läuft auch ohne ispf (A234579) */
/* Diagnose Statement erlaubt (A234579) */
/* 20.11.2006 v2.21 RSU0610 bewirkt Meldung: */
/* 'insuff. operands for keyword listdef'*/
/* Neu wird leeres Member erstellt falls */
/* keine Objekte die Schwellwerte erreich*/
/* 04.12.2006 v2.3 Optimierung mit Gruppenbruch-Logik */
/* 10.04.2008 v4.0 Umstellung auf neue exception tabl/vws*/
/* */
/* 3 usage checkrts programm(rexx) */
/* S100447.vRtsReoTS db2 ts part Grenzwerte */
/* S100447.vRtsReoIX db2 ix part Grenzwerte */
/* */
/* 4 parms checkrts <parm1> <parm2> */
/* parm1 = db2 subsystem */
/* parm2 = type ts or ix */
/* */
/* 5 location tso.rzx.p0.user.exec */
/* */
/******************************************************************/
m.debug = 0
parse upper arg ssid type fun
if 1 & ssid = '' then
parse upper value 'DBTF TS TEST' with ssid type fun
if wordPos(ssid, 'DBAF DBTF DVTB') < 1 then do
call logg 'DSN.CHECKRTS.LOG', 'checkrts to old' ssid type fun
call checkrt0 ssid type fun
exit
end
say "CheckRts Programmversion = 4.0"
say " DB2 Subsystem = "ssid
if type = '' then do
type = 'TS'
say " kein Type gewählt, also TS-Reorg getriggert"
end
say " Type = "type
call errReset 'h'
call mapIni
call sqlIni
call sqlConnect ssid
/*-------------- Hauptprogramm -----------------------------------*/
if fun = '' then
call doCheckRts type, '-ddIn1', '-ddIn2', dsn4allocated('ddOUt1')
else if fun = 'TEST' then
call testCheckRts type
else if fun = 'T0' then
call testRT0 ssid type
else
call err 'bad fun' fun 'in Argumenten' arg(1)
call sqlDisconnect
exit
testRT0: procedure expose m.
parse arg ssid type
MBR=QR04412
MBR=QR20801
call adrTso "alloc dd(ddIn1) shr" ,
"dsn('A540769.CHECKRTS.SYSPRINT("MBR")')"
call adrTso "alloc dd(ddIn2) shr" ,
"dsn('DBTF.DBAA.LISTDEF("MBR"1)')"
/* "dsn('A540769.CHECKRTS.LISTDEF("MBR"1)')" */
call adrTso "alloc dd(ddOut1) shr" ,
"dsn('A540769.CHECKRTS.OUTLIOLD("MBR")')"
call checkRt0 ssid type
say 'checkRt0 rc' rc
call adrTso 'free dd(ddIn1 ddIn2 ddOut1)'
return
endProcedure testRT0
testCheckRts: procedure expose m.
parse arg type
mbrs = 'QR04412 QR03202 QR20801'
mbrs = 'QR04412'
mbrs = QR30403
mbrs = QR06801
do mx=1 to words(mbrs)
mb = word(mbrs, mx)
say 'member' mb '**********'
call doCheckRts type, '~checkrts.sysprint('mb')',
, 'DBTF.DBAA.listDef('mb'1)',
, '~checkrts.output('mb')'
/* , '~checkrts.listDef('mb'1)' */
end
return
endProcedure testCheckRts
/*--- main function
analyse utility preview sysprint
analyse utitlity listdef input
check rts
generate new utility ctrl cards ----------------------------*/
doCheckRts: procedure expose m.
parse arg type, ddIn1, ddIn2, ddOut
call mapReset lst, 'K'
call analyzeSysprint lst, ddIn1
call debugLst lst, 'lists in sysprint'
call mapReset ctl, 'K'
call analyzeListdef ctl, ddIn2
call debugListdef ctl
call mapReset rl, 'K'
kk = mapKeys(ctl)
typ1 = left(type, 1)
do kx=1 to m.kk.0
listName = m.kk.kx
if ^ mapHasKey(lst, listName) then do
say '??? list' listName 'in ListDef aber nicht im SysPrint',
'wahrscheinlich leer???'
end
else if word(m.lst.listName, 1) ^== typ1 then do
call debug 'list' listName '->' m.lst.listName ,
'nicht type' type 'wird ignoriert'
end
else do
call mapPut rl, listName
call mapReset rl'.'listName, 'K'
call selectRts rl'.'listName, lst'.'listName, type
lstKeys = mapKeys(lst'.'listName)
rtsKeys = mapKeys(rl'.'listName)
if m.lstKeys.0 <> m.rtsKeys.0 then
call err 'Liste' listName 'Anzahl Objekte:',
'sysPrint' m.lstKeys.0 '<> rts' m.rtsKeys.0
end
end
call debugLst rl, 'lists rts selection'
call genCtrl ddOut, rl, type, ctl
return
endProcedure doCheckRts
/*--- generate utiltity ctrl cards for run
ddOut: output dd spec to write ctrl to
all: map of partitions to reorg
type: TS or IX
ctl: input ctrl cards ------------------------------------*/
genCtrl: procedure expose m.
parse arg ddOut, all, type, ctl
if type = 'TS' then
ldType = 'TABLESPACE'
else if type = 'IX' then
ldType = 'INDEXSPACE'
else
call err 'bad type' type
m.o.1 = ' -- checkRts' date('s') time()
m.o.0 = 1
kk = mapKeys(all)
do kx = 1 to m.kk.0
lst = m.kk.kx
call mAdd o, m.lstCount.lst
oStart = m.o.0
lstKeys = mapKeys(all'.'lst)
do lx=1 to m.lstKeys.0
ob = m.lstKeys.lx
rng = mapGet(all'.'lst, ob)
do rx=1 to words(rng)
parse value word(rng, rx) with von '-' bis
if bis = '' then
bis = von
do pa=von to bis
if pa = 0 then
paLe = ''
else
paLe = 'PARTLEVEL('pa')'
call mAdd o, ' INCLUDE' ldType ob paLe
end /* do pa */
end /* do rx */
end /* do ob */
if m.o.0 = oStart then do
m.o.0 = oStart - 1
end
else do
st = ctl'.'lst
do s1=1 to m.st.0
call mAdd o, ' -- utility' s1 'for' lst
do s2=1 to m.st.s1.0
call mAdd o, strip(m.st.s1.s2, 't')
end
end
end
end /* do lst */
call writeDsn ddOut, 'M.'o'.', ,0
return
endProcedure genCtrl
/*--- debug a listDef ------------------------------------------------*/
debugListDef: procedure expose m.
parse arg lst, tit
if m.debug ^== 1 then
return
call debug tit
kk = mapKeys(lst)
do kx=1 to m.kk.0
call debug 'list' m.kk.kx
st = lst'.'m.kk.kx
do s1=1 to m.st.0
do s2=1 to m.st.s1.0
call debug ' ' st'.'s1'.'s2 strip(m.st.s1.s2, t)
end
end
end
return
endProcedure debugListDef
/*--- debug a list ---------------------------------------------------*/
debugLst: procedure expose m.
parse arg lst, tit
if m.debug ^== 1 then
return
call debug tit
k1 = mapKeys(lst)
do kx=1 to m.k1.0
call debug 'list' m.k1.kx '-->' mapGet(lst, m.k1.kx)
call debugMap lst'.'m.k1.kx, ' '
end
return
endProcedure debugLst
/*--- debug a map ----------------------------------------------------*/
debugMap: procedure expose m.
parse arg mp, pr
if m.debug ^== 1 then
return
kk = mapKeys(mp)
do kx=1 to m.kk.0
k2 =
call debug pr m.kk.kx '->' mapGet(mp, m.kk.kx)
end
return
endProcedure debugMap
/*--- select the rts views and
put the partitions to reorg in the map slt -----------------*/
selectRts: procedure expose m.
parse arg slt, lst, type
if type = 'IX' then
sql = 'select db, indexSpace, creator, ix, part, reason,',
'real(totalEntries) rows,',
'real(nActive)*4*1024 act,',
'real(space)*1024 space' ,
'from S100447.vRtsReoIX' ,
'where' genWhere(word(m.lst, 1), lst)
else if type = 'TS' then
sql = 'select db, ts, db cr, ts nm, part, reason,',
'real(totalRows) rows,',
'real(nActive)*pgSize*1024 act,',
'real(space)*1024 space' ,
'from S100447.vRtsReoTS' ,
'where' genWhere(word(m.lst, 1), lst)
else
call err 'selectRts type' type
call debug 'sql1' sql
gr = "case when left(reason, 3) = 'no' then 'NO'" ,
"when left(reason, 10) = 'reorgDays' then 'DAY'" ,
"else 'REO' end"
sql = "with s as ("sql")",
"select * from s" ,
"union all (select ' db', ' ts', 'cr', 'nm', -9," gr ",",
"sum(rows), sum(act), sum(space)",
"from s group by" gr ")",
"order by 1, 2, 5"
call debug 'sql2' sql
ty = oFldONly('DB TS CR NM PART REASON ROWS ACT SPACE', 'n')
call sql2Cursor 1, sql, ty
call sqlOpen 1
act.day = 0
act.no = 0
act.reo = 0
reoMax = .25 /* if we have to reorg more than this part
of the total size */
dayMin = .15 /* than reduce reorg of year old partititons
to that part of size */
dayCum = 0
reoCum = 0
actCalc = 1
drop sql
do while sqlFetch(1, o)
call debug oFldCat(sqlType(1), o, m.sql.1.fmt)
if left(m.o.db, 1) = ' ' then do
if ^ actCalc then
call err 'act space must be in beginning'
g = m.o.reason
if m.o.act ^== m.sql.null then
act.g = m.o.act
else
act.g = 1e7
iterate
end
if actCalc then do
actCalc = 0
act.sum = act.day + act.no + act.reo
/* compute the limit for old partitions */
act.dLi = max(act.sum * reoMax - act.reo, dayMin * act.day)
end
key = m.o.db'.'m.o.ts
pa = m.o.part + 0
if ^rangeIsIn(mapGet(lst, key), pa) then
call debug 'part' pa 'not in' key
else do
if left(m.o.reason, 3) == 'no ' then
f = 'ingoriere '
else if left(m.o.reason, 10) ^== 'reorgDays ' then do
if m.o.act ^== m.sql.null then
reoCum = reoCum + m.o.act
f = 'reorganisiere'
end
else if dayCum < act.dLi then do
if m.o.act ^== m.sql.null then
dayCum = dayCum + m.o.act
f = 'reorganisiere'
end
else /* over limit for old partitions */
f = 'spaeter '
if ^mapHasKey(slt, key) then
call mapPut slt, key, ''
if abbrev(f, 'r') then
call mapPut slt, key, rangeAdd(mapGet(slt, key), pa)
say f m.o.cr'.'m.o.nm ||right(pa, 4) m.o.reason
end
end
say statsline('')
say statsLine('Space dieser Objekte')
say statsline(' nicht zu reorganisieren' , act.no)
say statsline(' zu reorganisieren wegen Schwellwerten' , act.reo)
say statsline(' zu reorganisieren da aelter als x Tage' , act.day)
say statsline('' , '=')
say statsLine(' Total' , act.sum)
say statsline('')
say statsLine('Space der generierten Reorgs')
say statsline(' generierte Reorgs wegen Schwellwerten' , reoCum)
say statsline(' generierte Reorgs da aelter als x Tage' , dayCum)
say statsline('' , '=')
say statsLine(' Total generierte Reorgs' , reoCum + dayCum)
say statsline('')
say statsline(' auf spaeter verschobene Reorgs aelter als x Tage,',
, act.reo+act.day - reoCum - dayCum)
say statsline(' da ueber berechneter Limite von')
say statsline(' ' asMB(act.dLi) 'MB =',
'max('asMB(act.sum) '*' reoMax '-' asMB(act.reo)',' ,
asMB(act.day) '*' dayMin')')
/* act.dLi = max(act.sum * reoMax - act.reo, dayMin * act.day) */
/* say statsline(' generiert nicht Reorg', act.sum - dayCum- reoCum)
say lst 'dayLim set to' act.dLi 'min' dayMin 'max ' reoMax
say 'reorganisiere' (reoCum + dayCum) 'bytes davon' ,
dayCum 'fuer TagesLimite'
*/ call sqlClose 1
return
endProcedure selectRts
statsLine: procedure expose m.
parse arg m1, by
r = left(m1, 60)
if by == '=' then
r = r || left('', 11, by)
else if by ^== '' then
r = r || right(asMB(by), 8) 'MB'
return r
endProcedure statsLine
asMB: procedure expose m.
parse arg by
return trunc(by/1024/1024 + .5, 0)
/*--- analyze sysprint of utility preview
put listelements in map lst -----------------------------*/
analyzeSysprint: procedure expose m.
parse arg lst, inp
call mapReset lst, 'K'
call readDsn inp, i1.
rx = 1
listName = ''
do while rx <= i1.0
if word(i1.rx, 1) == 'DSNU1020I' then do
ex = wordPos('EXPANDING', i1.rx)
listName = word(i1.rx, ex + 2)
if listName = '' | word(i1.rx, ex + 1) ^== 'LISTDEF' then
call err 'bad expanding line' i1.rx
call mapAdd lst, listName
call mapReset lst.listName, 'K'
rx = rx + 1
end
else if word(i1.rx, 1) == 'LISTDEF' then do
if listname ^== word(i1.rx,2) then
call err 'mismatch in list' listName 'line' i1.rx
m.lstCount.listName = strip(i1.rx)
types = ''
dbs = ''
do rx=rx+1 TO I1.0 while word(i1.rx, 1) = 'INCLUDE'
parse var i1.rx . obj db'.'ts prt
if wordPos(obj, 'TABLESPACE INDEXSPACE') < 1 then
call err 'bad obj type' obj 'in' i1.rx
ty = left(obj, 1)
if types == '' then
types = ty
else if types ^== ty then
call err 'Liste' lst 'mit verschiedene Types' i1.rx
if wordPos(db, dbs) < 1 then
dbs = dbs db
parse var prt 'PARTLEVEL(' part ')'
if part = '' then
part = 0
else
part = part + 0
ky = db'.'ts
if mapHasKey(lst'.'listName, ky) then
call mapPut lst'.'listName, ky,
, rangeAdd(mapGet(lst'.'listName, ky), part)
else
call mapPut lst'.'listName, ky, part
/* say ky '+' part '->' mapGet(lst'.'listName, ky)
*/ end
say 'sysprint list' listName types dbs
call mapPut lst, listName, types dbs
listName = ''
end
else do
rx = rx+1
end
end
return
endProcedure analyzeSysprint
/*--- return the sql where condition
from the partition list in map lst ------------------*/
genWhere: procedure expose m.
parse arg ty, lst
if ty = 'I' then
spFi = 'indexSpace'
else if ty = 'T' then
spFi = 'ts'
else
call err 'bad type in genWhere('ty',' lst')'
tyDbs = m.lst
keys = mapKeys(lst)
call debug 'genWhere' lst '-->' m.lst '-->' mapKeys(lst)
wh = ''
do dx=2 to words(tyDbs)
db = word(tyDbs, dx)
fo = 0
do kx=1 to m.keys.0
if ^ abbrev(m.keys.kx, db'.') then
iterate
parse var m.keys.kx pDb '.' pTs
fo = fo + 1
if fo = 1 then
wh = wh "or (db = '"db"' and" spFi "in("
wh = wh "'"pTs"',"
end
if fo > 0 then
wh = left(wh, length(wh)-1)'))'
end
if wh = '' then
return ''
else
return substr(wh, 4)
endProcedure genWhere
rangeTest:
call rt1 '', 1
call rt1 '5', 1
call rt1 '5', 4
call rt1 '5', 5
call rt1 '5', 6
call rt1 '5', 9
call rt1 '4-6', 1
call rt1 '4-6', 3
call rt1 '4-6', 4
call rt1 '4-6', 5
call rt1 '4-6', 6
call rt1 '4-6', 7
call rt1 '4-6', 9
call rt1 '0 4-6', 1
call rt1 '0 4-6', 3
call rt1 '0 4-6', 4
call rt1 '0 4-6', 5
call rt1 '0 4-6', 6
call rt1 '0 4-6', 7
call rt1 '0 4-6', 9
call rt1 '0 4-6 11-12 15', 1
call rt1 '0 4-6 11-12 15', 3
call rt1 '* 4-6 11-12 15', 4
call rt1 '* 4-6 11-12 15', 5
call rt1 '* 4-6 11-12 15', 6
call rt1 '* 4-6 11-12 15', 7
call rt1 '* 4-6 11-12 15', 9
return
endProcedure rangeTest
rt1:procedure
parse arg ra, nn
res = rangeAdd(ra, nn)
say 'rangeAdd' ra',' nn '->' res
return res
endProcedure rt1
/*--- add a member to a range
a range is a string of the form '7 6-9 11' ---------------------*/
rangeAdd: procedure expose m.
parse arg ra, nn
do wx=1 to words(ra)
parse value word(ra, wx) with von '-' bis
if bis = '' then
bis = von
if nn-1 > bis then
iterate
else if nn-1 = bis then
bis = nn
else if nn >= von then
return ra
else if nn+1 = von then
von = nn
else
return strip(subWord(ra, 1, wx-1) nn subWord(ra, wx))
return strip(subWord(ra, 1, wx-1) von'-'bis subWord(ra, wx+1))
end
return strip(ra nn)
endProcedure rangeAdd
/*--- return true/false whether nn is in range ra --------------------*/
rangeIsIn: procedure expose m.
parse arg ra, nn
do wx=1 to words(ra)
parse value word(ra, wx) with von '-' bis
if bis = '' then
bis = von
if nn < von then
return 0
if nn <= bis then
return 1
end
return 0
endProcedure rangeIsIn
/*--- analyse a listdef in dsn spec inp
put the different parts into map ctl -----------------------*/
analyzeListdef: procedure expose m.
parse arg ctl, inp
call readDsn inp, i2.
st = ''
do rx=1 to i2.0
w = word(i2.rx, 1)
if w = '' then do
end
else if wordPos(w, 'REORG COPY REBUILD CHECK QUIESCE UNLOAD' ,
'LOAD MERGECOPY MODIFY RECOVER RUNSTATS DIAGNOSE') ,
> 0 then do
lx = wordPos('LIST', i2.rx)
listName = word(i2.rx, lx+1)
if lx < 1 | lstName = '' then do
say 'no list in' i2.rx
/* could be reorg option unload continue,
thus, ignore it | */
end
else do
if ^ mapHasKey(ctl, listName) then do
call mapAdd ctl, listName
m.ctl.listName.0 = 0
end
st = ctl'.'listName'.'mInc(ctl'.'listName'.0')
m.st.0 = 0
call debug w 'list' listName '->' st
end
end
if st ^== '' then
call mAdd st, i2.rx
end
return
endProcedure analyzeListdef
/*--- search the ds Name alloctade to dd dd --------------------------*/
dsn4Allocated: procedure expose m.
parse upper arg dd
/* it would be much easier with listDsi,
unfortuenatly listDsi returns pds name without member*/
dd = ' 'dd' '
oldOut = outtrap(l.)
call adrTso "listAlc st"
xx = outtrap(off)
do i=2 to l.0 while ^abbrev(l.i, dd)
end
if i > l.0 then
return '' /* dd not found */
j = i-1
dsn = word(l.j, 1)
if abbrev(l.j, ' ') | dsn = '' then
call err 'bad dd lines line\n'i l.i'\n'j l.j
return dsn
endProcedure dsn4Allocated
/*--- append a message to a seq DSif available
otherwise isssue a message ----------------------------*/
logg: procedure expose m.
parse arg dsn
o.1 = ''
do x=1 to arg()-1
o.x = ' ' strip(arg(x+1), t)
end
o.1 = date(s) time() strip(o.1)
x = max(1, arg() - 1)
address tso "alloc dd(logg) mod dsn('"dsn"') MGMTCLAS(COM#A092)"
if rc <> 0 then do
say 'cannot alloc logg' dsn
return
end
address tso 'execio' x 'diskw logg (stem o. finis)'
if rc <> 0 then
say 'execio logg rc' rc dsn
address tso 'free dd(logg)'
if rc <> 0 then
say 'execio free rc' rc
return
endProcedure logg
/* copy sql begin ***************************************************
sql interface
sqlIni --> nur sql ohne o und j Anbindung
sqlOini --> sql mit o und j Anbindung
***********************************************************************/
sqlIni: procedure expose m.
if m.sql.ini == 1 then
return
m.sql.ini = 1
call oFldIni
m.sql.null = '---'
return
endProcedure sqlIni
sql2St: procedure expose m.
parse arg st, src, ty, fmt
cx = 49
call sql2Cursor cx, src, ty, fmt
call sqlOpen cx
do ix=1 by 1 while sqlFetch(cx, st'.'ix)
end
m.st.0 = ix-1
call sqlClose cx
return ix-1
endProcedure sql2St
sqlPrepare: procedure expose m.
parse arg cx, src, desc
call sqlExec 'prepare s'cx 'from :src'
if desc == 1 | (desc == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
sqlExecute: procedure expose m.
parse arg cx
do ix=1 to arg()-1
val = arg(ix+1)
if val ^== m.sql.null then do
m.sql.cx.i.ix.sqlInd = 0
m.sql.cx.i.ix.sqlData = val
end
else do
m.sql.cx.i.ix.sqlInd = -1
end
end
if ^ m.noInsert then /* ??? wk test */
call sqlExec 'execute s'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure
sqlExeImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure exeImm
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
call sqlExec 'prepare s'cx 'into :M.SQL.'cx'.D from :src'
call sqlExec 'declare c'cx 'cursor for s'cx
if ty == '*' | ty = '' then do
flds = 'SQL.'cx'.FLD'
ff = ''
do ix=1 to m.sql.cx.d.sqlD
f1 = word(m.sql.cx.d.ix.sqlName, 1)
if f1 == '' then
f1 = 'COL'ix
ff = ff f1
end
ty = oFldOnly(ff, 'e')
end
call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
flds = oFlds(ty)
m.Sql.cx.FMT.0 = 0
m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
ff = m.Sql.cx.FMT
call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
return
endProcedure sql2Cursor
sqlType: procedure expose m.
parse arg cx
return oGetTypePara('SQL.TY.'cx)
sqlOpen: procedure expose m.
parse arg cx
return sqlExec('open c'cx)
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
sqlFetchInto:
parse arg ggCx, ggVars
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
sqlFetch: procedure expose m.
parse arg cx, dst
if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
return 0
if dst == '' then
return 1
fi = oFlds(sqlType(cx))
fo = m.sql.cx.fmt
do ix=1 to m.sql.cx.d.SQLD
f = m.fi.ix
if m.sql.cx.d.ix.sqlInd = 0 then
m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
else
m.dst.f = fmtS(m.sql.null, m.fo.ix)
end
return 1
endProcedure sqlFetch
sqlFetchLn: procedure expose m.
parse arg cx, var
st = 'SQL.'cx'.FET'
if ^ sqlFetch(cx, st) then
return 0
m.var = oFldCat(sqlType(cx), st, m.sql.cx.fmt)
return 1
endProcedure sqlFetchLn
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
if abbrev(sp, '=') then
return substr(sp, 2)
if sp = '' then
sp = '*st'
m.ff.0 = m.sql.cx.d.sqlD
m.ff.flds = oFlds(sqlType(cx))
if abbrev(sp, '*') then do
do ix=1 to m.ff.0
m.ff.ix = substr(sp, 2)
end
return ff
end
if abbrev(fmts, '=') then
m.Sql.cx.FMT = substr(fmts, 2)
defs = 'ir7 fr9 sl12 Tl26' sp
do wx = 1 to words(defs)
parse value word(defs, wx) with ty 2 fo
select
when ty = 'd' then t.384 = fo
when ty = 'f' then t.480 = fo'/f'
when ty = 'i' then t.496 = fo'/i'
when ty = 'n' then t.484 = fo'/n'
when ty = 's' then t.448 = fo
when ty = 't' then t.388 = fo
when ty = 'T' then t.392 = fo
otherwise call err 'bad type' ty 'for format' fo
end
end
if symbol('t.496') == 'VAR' then
t.500 = t.496
if symbol('t.448') == 'VAR' then do
t.452 = t.448
t.456 = t.448
t.464 = t.448
end
do wx = 1 to m.ff.0
ty = m.sql.cx.d.wx.sqlType
le = m.sql.cx.d.wx.sqlLen
withNulls = ty // 2
ty = ty - withNulls
if symbol('t.ty') <> 'VAR' then
call err 'sqlType' ty 'not supported'
parse var t.ty fo 2 fl '/' op
if op = 'i' then
if le = 2 then le = 6
else le = 12
else if op <> '' then
call err 'length for sqlType' ty 'op' op 'not implemented'
if fl = '=' then
fl = le
else if abbrev(fl, '<') then
fl = min(le, substr(fl, 2))
m.ff.wx = fo || fl
end
return ff
endProcedure sqlGenFmt
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
sqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call sqlExec "connect" ggSys, ggRetCon ,1
return
endProcedure sqlConnect
sqlDisconnect: procedure
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggRes = 'sqlCode' sqlCodeText(sqlCode, sqlErrMc),
'\nstate' sqlState 'warn'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
ggRes = ggRes'\nstmt = ' ggSqlStmt
ggPref = '\nwith\n '
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
sqlCodeText: procedure expose m.
parse arg co, mc
expEq = 0
if symbol('m.sql.code.0') <> 'VAR' then do
dsn = "'A540769.wk.texv(sql)'"
dsn = "'ORG.U0009.B0106.KIUT23.TEXV(SQLCODES)'"
m.sql.code.0 = 0
if sysDsn(dsn) <> 'OK' then
say 'sqlCode dsn' dsn':' sysDsn(dsn)
else
call readDsn dsn, 'M.SQL.CODE.'
end
co = co + 0
if length(co) < 3 then
co = left(co, 3, 0)
if co > 0 then
co = '+'co
co = co' '
do cx=1 to m.sql.code.0 until abbrev(m.sql.code.cx, co)
end
if cx > m.sql.code.0 then
li = "<<text for sqlCode" co "not found>>"
else
li = m.sql.code.cx
cx = 1
px = 1
res = ''
do forever
nx = pos('${', li, cx)
if nx < 1 then
leave
ex = pos('}', li, nx)
if ex < cx then
call err 'closing } missing in' li
res = res || substr(li, cx, nx - cx)
if expEq then
res = res || '<<' || substr(li, nx+2, ex-nx-2) || ' = '
cx = ex+1
if px > length(mc) then do
res = res || '<<missing>>'
end
else do
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res || substr(mc, px, qx-px)
if expEq then
res = res'>>'
px = qx + 1
end
end
res = res || substr(li, cx)
do while px <= length(mc)
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res '<<extraMsgArg =' substr(mc, px, qx-px)'>>'
px = qx + 1
end
return res
endProcedure sqlCodeText
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure sqlDsn
/*--- sql o interface ------------------------------------------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
if ty = '' then
ty = '*'
if src == '' then
src = envCatStr(' ', 'sb')
call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
call oMutate 'SQL.TY.'cx, 'SqlType'
return 'SQL.TY.'cx
endProcedure sql2obj
sql: procedure expose m.
parse arg cx, src, ty, fo
call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
return
endProcedure sql
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
if fo = '' then
fo = '~'
squash = abbrev(fo, '~')
if ^ abbrev(fo, '=') then
fo = left(fo, squash) 'sl=' substr(fo, squash+1)
t = sql2Obj(cx, src, ty, fo)
if squash then do
call fmtFldSquashRw t, 'opCl'
return
end
m = 'SQL.LN.'cx
call oMutate m, 'SqlLn'
call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
call jWriteAll m.j.jOut, "r£", m
return
endProcedure sqlLn
sqlOini: procedure expose m.
if m.sqlO.ini == 1 then
return
m.sqlO.ini = 1
call sqlIni
call envIni
call oDecMethods oNewClass("SqlType"),
, "jOpen call sqlOpen substr(m, 8)",
, "jClose call sqlClose substr(m, 8)",
, "jRead return sqlFetch(substr(m, 8), var)"
call oDecMethods oNewClass("SqlLn", "SqlType"),
, "jRead return sqlFetchLn(substr(m, 8), var)"
return
endProcedure sqlOini
/* copy sql end **************************************************/
/* copy fmt begin **************************************************/
fmt: procedure
parse arg v, f 2 l
if abbrev('-', f) then
return v
else if f = 'l' then
return left(v, l)
else if f = 'r' then
return right(v, l)
else if f = 's' then
if l = '' then
return strip(v, 't')
else
return strip(v, l)
else if f = 'w' then do
parse var l st ',' le
return substr(v, st, le)
end
else
call err 'bad format' f l 'for' v
endProcedure fmt
/*--- format special (title, null Value also for numbers) ------------*/
fmtS: procedure expose m.
parse arg v, f
return fmt(v, f)
endProcedure fmtS $
/* copy fmt end **************************************************/
/* copy oFld begin ****************************************************/
oFldIni: procedure expose m.
if m.oFld.ini = 1 then
return
m.oFld.ini = 1
call mIni
m.o.cla.0 = 0
call oFldNew 'Class', '=', , ,
'INST = MET .<>= FLD .<>=Class STEM =Class'
return
endProcedure oFldIni
oFldNew: procedure expose m.
parse arg name, va, st, flds, dup
if pos('*', name) > 0 then
name = oPut('O.CLA', name, , '*')
else
call oPut 'O.CLA', name, , 'n'
m.o.cla.name.inst = 0
m.o.cla.name.val = va
m.o.cla.name.stem = st
m.o.cla.name.FLD.0 = 0
m.o.cla.name.MET.0 = 0
return oFldAdd(name, flds, dup)
endProcedure oFldNew
oFldOnly: procedure expose m.
parse arg fs, dup
kk = space(fs, 1) dup
if symbol('m.o.fldOnly.kk') = 'VAR' then
return m.o.fldOnly.kk
nn = oFldNew('FldType*')
st = 'O.CLA.'nn'.FLD'
ll = ''
do wx=1 to words(fs)
ll = ll oPut(st, word(fs, wx), '=', dup)
end
if symbol('m.o.fldOnly.ll') = 'VAR' then
nn = m.o.fldOnly.ll
m.o.fldOnly.kk = nn
m.o.fldOnly.ll = nn
return nn
endProcedure oFldOnly
oFlds: procedure expose m.
parse arg type
return 'O.CLA.'type'.FLD'
oFldCat: procedure expose m.
parse arg ty, st, fmt
flds = oFlds(ty)
res = ''
do ix=1 to m.flds.0
f = m.flds.ix
if fmt == '' then
res = res m.st.f
else
res = res fmt(m.st.f, m.fmt.ix)
end
return substr(res, 2)
endProcedure oFldCat
oFldAdd: procedure expose m.
parse arg cla, fs, dup
st = 'O.CLA.'cla'.FLD'
do ix=1 by 2 to words(fs)
call oPut st, word(fs, ix), word(fs, ix+1), dup
end
return cla
endProcedure oFldAdd
oPut: procedure expose m.
parse arg st, k, v, dup
if dup = '*' then do
cx = pos('*', k)
if cx < 1 then
call err 'no * in key' k
k = oPutDupResolve(st, left(k, cx-1), 1)
end
else if symbol('m.st.k') = 'VAR' then do
if dup = '' | dup = 'o' then do
m.st.k = v
return k
end
if dup = '=' then do
if v <> m.st.k | ^ (v = '' & datatype(m.st.k, 'n')) then
call err 'not =: m.'st'.'k '=>' m.st.k '<>' v
return k
end
if dup = 'e' then
k = oPutDupResolve(st, k, 2)
else
call err 'key' k 'exists in' st 'but dup' dup
end
else if dup = 'o' then
call err 'old key' k 'does not exist in' st
if datatype(k, 'n') | words(k) <> 1 | pos('.', k) > 0 then
call err 'illegal name' name
x = m.st.0 + 1
m.st.0 = x
m.st.x = k
if v == '' then
m.st.k = x
else
m.st.k = v
return k
endProcedure oPut
oPutDupResolve: procedure expose m.
parse arg st, k, b
do ix=b
a = k || ix
if symbol('m.st.a') <> 'VAR' then
return a
end
endProcedure oPutDupResolve
/*--- parameterized types --------------------------------------------*/
oGetTypePara: procedure expose m.
parse arg m
if symbol('m.o.tyPa.m') == 'VAR' then
return m.o.tyPa.m
else
return '='
endProcedure oGetTypePara
oSetTypePara: procedure expose m.
parse arg m, type, noCall
if type = '' then
type = '='
if oGetTypePara(m) == type then
return
if noCall ^== 'noCall' then
interpret oObjMethod(m, 'oSetTypePara')
m.o.tyPa.m = type
return
endProcedure oSetTypePara
/* copy oFld end ***************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = ''
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
return a
endProcedure
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
mapAdd: procedure expose m.
parse arg a, ky, val
if symbol('m.a.ky') == 'VAR' then
call err 'duplicate key in mAdd('a',' ky',' val')'
m.a.ky = val
if m.map.keys.a ^== '' then
return mAdd(m.map.keys.a, ky)
return
endProcedure mapAdd
mapPut: procedure expose m.
parse arg a, ky, val
if m.map.keys.a ^== '' then
if symbol('m.a.ky') ^== 'VAR' then
call mAdd m.map.keys.a, ky
m.a.ky = val
return val
endProcedure mapPut
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
drop m.a.ky
return val
endProcedure mapRemove
mapHasKey: procedure expose m.
parse arg a, ky
return symbol('m.a.ky') == 'VAR'
endProcedure mapHasKey
mapGet: procedure expose m.
parse arg a, ky
if symbol('m.a.ky') ^== 'VAR' then
call err 'missing key in mapGet('a',' ky')'
return m.a.ky
endProcedure mapGet
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy m begin ********************************************************
stem handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* 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 = '' & ^ abbrev(disp, 'SYSO') then
return 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 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(COM#A092) 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
debug: procedure expose m.
parse arg msg
if m.debug == 1 then
say 'debug' msg
return
endProcedure debug
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CHECKRT0) cre=2008-01-29 mod=2008-11-24-17.34.15 F540769 ---
/* REXX */
/******************************************************************/
/* CHECKRTS */
/* -------- */
/* */
/* 1 function: db2 real time statistics für reorg anwenden: */
/* 1. listdef einlesen */
/* 2. schwellwerte lesen (S100447.texceptions) */
/* 3. rts abfragen */
/* 4. neue listdef erstellen */
/* */
/* 2 history: */
/* 25.10.2004 v1.0 grundversion (m.streit,A234579) */
/* 16.09.2005 v1.1 inkl.reorg index ohne rts (A234579) */
/* 20.09.2005 v1.2 erweiterte abfrage auf noload repl */
/* 23.09.2005 v2.0 index mit rts-abfrage (A234579) */
/* 10.11.2005 v2.1 schwellwerte erweitert (A234579) */
/* 10.04.2006 v2.2 pgm läuft auch ohne ispf (A234579) */
/* Diagnose Statement erlaubt (A234579) */
/* 20.11.2006 v2.21 RSU0610 bewirkt Meldung: */
/* 'insuff. operands for keyword listdef'*/
/* Neu wird leeres Member erstellt falls */
/* keine Objekte die Schwellwerte erreich*/
/* 04.12.2006 v2.3 Optimierung mit Gruppenbruch-Logik */
/* */
/* 3 usage checkrts programm(rexx) */
/* S100447.texceptions_ts db2 tb ausnahmen ts */
/* S100447.vexceptions_ts db2 tb ausnahmen ts view */
/* S100447.texceptions_ix db2 tb ausnahmen ix */
/* S100447.vexceptions_ix db2 tb ausnahmen ix view */
/* */
/* 4 parms checkrts <parm1> <parm2> */
/* parm1 = db2 subsystem */
/* parm2 = type ts or ix */
/* */
/* 5 location tso.rzx.p0.user.exec */
/* */
/******************************************************************/
debug = 1
/*----------------------------------------------------------------*/
/*-------------- Standard Schwellwerte bestimmen -----------------*/
/*----------------------------------------------------------------*/
default_reorg_th = 'THRESHOLD'
default_unclust_th = 10
default_farindref_th = 5
default_nearindref_th = 5
default_extents_th = 100
default_inserts_th = 999999
default_updates_th = 999999
default_deletes_th = 999999
default_pagesplits_th = 10
default_ixinserts_th = 999999
default_ixdeletes_th = 999999
default_pseudodel_th = 999999
default_reorgdays_th = 365 /* max anz. tage ohne reorg ts+ix */
/*----------------------------------------------------------------*/
/*-------------- Variablen initialisieren ------------------------*/
/*----------------------------------------------------------------*/
r=1
listobj. = ''
t=0
title_written=0
ts_flag = 1 /* Steuerung der Gruppenlogik */
db_flag = 1 /* Steuerung der Gruppenlogik */
reorg_th = default_reorg_th
unclust_th = default_unclust_th
farindref_th = default_farindref_th
nearindref_th = default_nearindref_th
extents_th = default_extents_th
inserts_th = default_inserts_th
updates_th = default_updates_th
deletes_th = default_deletes_th
pagesplits_th = default_pagesplits_th
ixinserts_th = default_ixinserts_th
ixdeletes_th = default_ixdeletes_th
pseudodel_th = default_pseudodel_th
reorgdays_th = default_reorgdays_th
ssid = ''
type = ''
member = ''
dsn = ''
/*----------------------------------------------------------------*/
/*-------------- Programm-Parameter verarbeiten ------------------*/
/*----------------------------------------------------------------*/
argument = arg(1)
parse upper var argument ssid type
say "Programmversion = 2.3"
say "DB2 Subsystem = "ssid
if type = '' then do
type = 'TS'
say "kein Type gewählt, nur TS-Reorg getriggert"
end
select
when type = 'TS' then
do
say "Typ = "type
say "----------------------------------------------------------------"
say "Default Schwellwerte Tablespace:"
say "reorg = "default_reorg_th
say "unclust = "default_unclust_th
say "farindref = "default_farindref_th
say "nearindref = "default_nearindref_th
say "extents = "default_extents_th
say "inserts = "default_inserts_th
say "updates = "default_updates_th
say "deletes = "default_deletes_th
say "reorgdays = "default_reorgdays_th
say "----------------------------------------------------------------"
end
when type = 'IX' then
do
say "Typ = "type
say "----------------------------------------------------------------"
say "Default Schwellwerte Index:"
say "reorg = "default_reorg_th
say "pagesplits = "default_pagesplits_th
say "ixinserts = "default_ixinserts_th
say "ixdeletes = "default_ixdeletes_th
say "pseudodel = "default_pseudodel_th
say "reorgdays = "default_reorgdays_th
say "----------------------------------------------------------------"
end
otherwise do
say "falscher Parameter (Typ) an zweiter Stelle"
say "Programm wird beendet"
exit
end
end /* select */
/*----------------------------------------------------------------*/
/*-------------- Hauptprogramm -----------------------------------*/
/*----------------------------------------------------------------*/
call read_dsn /* input-ds aus jcl einlesen */
call prepare_dsnrexx /* sql-schnittstelle aufbauen */
call connect_subsys /* db2 subsystem verbinden */
if type='TS' then do
call read_exceptions_ts /* lesen exceptions in s100447.texeptions_ts */
end
if type='IX' then do
call read_exceptions_ix /* lesen exceptions in s100447.texeptions_ix */
end
"NEWSTACK"
do until r=anz_in1
in1.r=strip(in1.r,l)
if substr(in1.r,1,7) = 'LISTDEF' then do /* sysprint filtern */
cnt=0
listname=word(in1.r,2)
listtitle=in1.r /* 1.zeile zwischenspeichern */
s=r+1
in1.s=strip(in1.s,l)
do while substr(in1.s,1,7) = 'INCLUDE'
db_o=db /*Vorgänger speichern für Gruppenbruch Logik */
sn_o=sn /*Vorgänger speichern für Gruppenbruch Logik */
db=''
sn=''
part=''
partstm=''
parse var in1.s tmp1 obj dbsn prt
db = substr(dbsn,1,pos('.',dbsn)-1)
sn = substr(dbsn,pos('.',dbsn)+1)
parse var prt tmp1 '(' part ')' tmp2
if datatype(part,w)
then partstm="AND PARTITION="||""right(part,4)""
else partstm=' '
/* Gruppenbruch Logik */
if db <> db_o then
db_flag=1 /* es wird eine neue DB verarbeitet */
else db_flag=0
if (db <> db_o) | (sn <> sn_o) then
sn_flag=1 /* es wird ein neuer TS/IS verarbeitet */
else sn_flag=0
if (obj='TABLESPACE' & type='TS') then do
/* checken ob spezielle schwellwert für ts vorhanden */
/* objekte in interner tabelle suchen */
if sn_flag then do
do q=1 to anztsobject
if (tsobject.q.1=db & tsobject.q.2=sn) then do
reorg_th = tsobject.q.3
unclust_th = tsobject.q.4
farindref_th = tsobject.q.5
nearindref_th = tsobject.q.6
extents_th = tsobject.q.7
inserts_th = tsobject.q.8
updates_th = tsobject.q.9
deletes_th = tsobject.q.10
reorgdays_th = tsobject.q.11
if debug then do
say" Db "db
say" Ts "sn
say" reorg_th "reorg_th
say" unclust_th "unclust_th
say" farindref_th "farindref_th
say" nearindref_th "nearindref_th
say" extents_th "extents_th
say" inserts_th "inserts_th
say" updates_th "updates_th
say" deletes_th "deletes_th
say" reorgdays_th "reorgdays_th
end
leave
end
else do
reorg_th = default_reorg_th
unclust_th = default_unclust_th
farindref_th = default_farindref_th
nearindref_th = default_nearindref_th
extents_th = default_extents_th
inserts_th = default_inserts_th
updates_th = default_updates_th
deletes_th = default_deletes_th
reorgdays_th = default_reorgdays_th
end
end /* do anztsobject */
end /* sn_flag */
if debug then say "call reorg_check_ts..."
call reorg_check_ts
if debug then say "reorg_check_ts ended. result= "ts_reorg
if ts_reorg = y then do
if title_written = 0 then do
queue listtitle
title_written = 1
end
queue ' '||in1.s /* zeile in stack schreiben */
cnt=cnt+1
end
end /* if obj='tablespace' */
if (obj='INDEXSPACE' & type='IX') then do
/* checken ob spezielle schwellwert für ix vorhanden */
/* objekte in interner tabelle suchen */
if sn_flag then do
do q=1 to anzixobject
if (ixobject.q.1=db & ixobject.q.2=sn) then do
reorg_th = ixobject.q.5
pagesplits_th = ixobject.q.6
ixinserts_th = ixobject.q.7
ixdeletes_th = ixobject.q.8
pseudodel_th = ixobject.q.9
reorgdays_th = ixobject.q.10
leave
end
else do
reorg_th = default_reorg_th
pagesplits_th = default_pagesplits_th
ixinserts_th = default_ixinserts_th
ixdeletes_th = default_ixdeletes_th
pseudodel_th = default_pseudodel_th
reorgdays_th = default_reorgdays_th
end
end /* do anzixobject */
end /* sn_flag */
if debug then say "call reorg_check_ix..."
call reorg_check_ix
if debug then say "reorg_check_ix ended. result= "ix_reorg
if ix_reorg = y then do
if title_written = 0 then do
queue listtitle
title_written = 1
end
if debug then say "y" y "queue" left(in1.s, 40)'...'
queue ' '||in1.s /* zeile in stack schreiben */
cnt=cnt+1
end
end /* if obj='indexspace' */
s=s+1
in1.s=strip(in1.s,l)
end /* do while include */
queue '--'
if cnt=0 then do /* falls listdef leer, merke listname */
t=t+1
listobj.t=listname
end
title_written=0
end /* if = listdef */
r=r+1
end /* do until r=anz_in1 */
v=0
write=n
do while v < in2.0 /* anzahl input-linien */
v=v+1
line=strip(in2.v,l)
select
when substr(line,1,12) = 'REORG INDEX ' then write=y
when substr(line,1,6) = 'REORG ' then write=y
when substr(line,1,5) = 'COPY ' then write=y
when substr(line,1,8) = 'REBUILD ' then write=y
when substr(line,1,6) = 'CHECK ' then write=y
when substr(line,1,8) = 'QUIESCE ' then write=y
when substr(line,1,7) = 'UNLOAD ' then write=y
when substr(line,1,5) = 'LOAD ' then write=y
when substr(line,1,10) = 'MERGECOPY ' then write=y
when substr(line,1,7) = 'MODIFY ' then write=y
when substr(line,1,8) = 'RECOVER ' then write=y
/* when substr(line,1,7) = 'REPORT ' then write=y */
when substr(line,1,9) = 'RUNSTATS ' then write=y
when substr(line,1,9) = 'DIAGNOSE ' then write=y
otherwise nop
end
if in2.v = '' then do
write=n /* kein statement vorhanden */
queue ' ' /* leere zeile schreiben */
end
if write=y then do
do e=1 to t
/* wenn liste leer, schreiben verhindern */
if wordpos(listobj.e,in2.v) > 0 then write=n
end
if write=y then queue in2.v /* statement schreiben */
end
end /* do while v < in2.0 */
queue /* nullstring fuer stack ende */
if debug then say "outds="outds
if member = '' then call write_seq
else call write_mem
exit /* Ende Hauptprogramm */
/*----------------------------------------------------------------*/
/*-------------- Output in seq. File schreiben -------------------*/
/*----------------------------------------------------------------*/
write_seq:
if debug then say "enter procedure write_seq..."
call alocds outds
outddn = result
address tso
"EXECIO "queued() " DISKW "outddn" (FINIS)";
if debug then say "ddout1 schreiben rc="rc
if rc > 8 then say "Output konnte nicht geschrieben werden rc="rc
say '??? written to' outDs
address tso
"DELSTACK"
if debug then say "leave procedure write_seq..."
return
/*----------------------------------------------------------------*/
/*-------------- Output in Member schreiben ----------------------*/
/*----------------------------------------------------------------*/
write_mem: /* walter test: use write_seq */
oldDsn = dsn
outDs = dsn'('member')'
call write_seq
oudDs = oldDsn
return
if debug then say "enter procedure write_mem..."
if debug then say "DSN ="dsn
if debug then say "Member="member
anz_queue_el = queued()
dsn = "'"||dsn||"'"
address ispexec
"LMINIT DATAID(ID1) DATASET("dsn") ENQ(SHRW)"
if rc <> 0 then call fehler(lminit)
"LMOPEN DATAID("id1") OPTION(OUTPUT)"
if rc <> 0 then call fehler(lmopen)
do rec=1 to anz_queue_el
parse pull text
address ispexec
"LMPUT DATAID("id1") MODE(INVAR) DATALOC(TEXT) DATALEN(80)"
if rc <> 0 then call fehler(lmput)
end
"LMMREP DATAID("id1") MEMBER("member")"
if rc > 8 then call fehler(lmopen)
"LMCLOSE DATAID("id1")"
"LMFREE DATAID("id1")"
address tso
"DELSTACK"
if debug then say "leave procedure write_mem..."
return
/*----------------------------------------------------------------*/
/*-------------- Datasets einlesen, DDname zuordnen --------------*/
/*----------------------------------------------------------------*/
read_dsn:
if debug then say "enter procedure read_dsn..."
/* sysprint einlesen */
"EXECIO * DISKR DDIN1 (STEM IN1. FINIS"
anz_in1 = in1.0 /* anzahl input-linien */
/* listdef einlesen */
"EXECIO * DISKR DDIN2 (STEM IN2. FINIS"
/* lese dataset-info zu ddname */
tmp= outtrap(lista.)
address tso
"LISTA ST H"
do icnt=2 to lista.0
if wordpos('DDOUT1',lista.icnt) > 0 then do
iold = icnt-1
parse value lista.iold with dsn '(' member ')' .
/* dsn = pfad, member = membername */
end
end
outds = dsn
if debug then say "leave procedure read_dsn..."
return
/* ------------------------------------------------------------------ */
/* Prozedur zum erstellen eines neuen Files */
/* ------------------------------------------------------------------ */
alocds:
if debug then say "enter procedure alocjclds..."
arg dsn
aaa=dsn; /* DDname generieren */
dda=time();
ddb=translate('124578',dda,'12345678');
ddn='D'ddb;
x = sysdsn("'"dsn"'")
if x <> "OK" & x <> 'MEMBER NOT FOUND' then do
/* this file does not exist */
say 'trying to create' x dsn
address tso
"ALLOC DDNAME("ddn") DA('"dsn"')" ,
" NEW CATALOG MGMTCLAS(COM#E005) SPACE (1,5) CYL RELEASE " ,
" BLKSIZE(3120) LRECL(80) RECFM(F , B) DSORG(PS) "
if rc>0 then do
/* dsn = jclds */
address ISPEXEC
'SETMSG MSG(DBSU006) ' /* can't alloc new file */
say "can't alloc new file"
exit('-1')
end
end
else do
address TSO
"ALLOC DDNAME("ddn") DSNAME('"dsn"') SHR REUSE "
if rc>0 then do
address ISPEXEC
'SETMSG MSG(DBSU001) '
say "tmpds konnte nicht alloziert werden"
end
end
if debug then say "leave procedure alocjclds..."
return (ddn)
/*----------------------------------------------------------------*/
/*--------------- zum db2 subsystem verbinden --------------------*/
/*----------------------------------------------------------------*/
prepare_dsnrexx:
if debug then say "enter procedure prepare_dsnrexx..."
address tso 'SUBCOM DSNREXX' /*host cmd env available*/
if rc=1 then /*no, let's make one*/
s_rc = rxsubcom('ADD','DSNREXX','DSNREXX') /*add host cmd env*/
if rc <> 0 & rc<> 1 then call sqlca(prepare dsnrexx)
if debug then say "leave procedure prepare_dsnrexx..."
return
/*----------------------------------------------------------------*/
/*--------------- zum db2 subsystem verbinden --------------------*/
/*----------------------------------------------------------------*/
connect_subsys:
if debug then say "enter procedure connect_subsys..."
address dsnrexx
"CONNECT "ssid
if sqlcode <> 0 then call sqlca(connect subsys)
if debug then say "leave procedure connect_subsys..."
return
/*----------------------------------------------------------------*/
/*--------------- pruefen ob reorg ts noetig ist -----------------*/
/*----------------------------------------------------------------*/
reorg_check_ts: /* x22 */
if debug then say "enter procedure reorg_check_ts..."
ts_reorg = n
address dsnrexx
if debug then say "REORG_TH = "reorg_th
select
when reorg_th = 'ALWAYS' then do
ts_reorg = y
say "TABLESPACE "db"."sn" "partstm||,
" DUE TO REORG = "reorg_th" EXCEPTION"
return
end
when reorg_th = 'NEVER' then do
ts_reorg = n
return
end
when reorg_th = 'THRESHOLD' then nop
when reorg_th = 'DEFAULT' then do
unclust_th = default_unclust_th
farindref_th = default_farindref_th
nearindref_th = default_nearindref_th
extents_th = default_extents_th
inserts_th = default_inserts_th
updates_th = default_updates_th
deletes_th = default_deletes_th
reorgdays_th = default_reorgdays_th
end
otherwise say "Wert ("reorg_th") fuer Feld Reorg ist nicht bekannt"
end /* select */
if debug then do
say "Datenbank = "db
say "Tablespace = "sn
say "Partition = "partstm
outsqlda.1.sqldata = 'dummy' /* schwellwert typ */
outsqlda.2.sqldata = 'dummy' /* schwellwert aktuell */
outsqlda.3.sqldata = 'dummy' /* unbenutzt */
outsqlda.4.sqldata = 'dummy' /* unbenutzt */
outsqlda.5.sqldata = 'dummy' /* unbenutzt */
outsqlda.6.sqldata = 'dummy' /* unbenutzt */
outsqlda.7.sqldata = 'dummy' /* unbenutzt */
end
/* sql statement -----------------------------------------------*/
sql_s1="SELECT 'UNCLUST' ",
",MAX((CAST(REORGUNCLUSTINS AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGUNCLUSTINS AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"unclust_th,
"UNION ",
"SELECT 'FARINDREF' ",
",MAX((CAST(REORGFARINDREF AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGFARINDREF AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"farindref_th,
"UNION ",
"SELECT 'NEARINDREF' ",
",MAX((CAST(REORGNEARINDREF AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGNEARINDREF AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"nearindref_th,
"UNION ",
"SELECT 'EXTENTS' ",
",MAX(EXTENTS) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
"HAVING MAX(EXTENTS)>"extents_th,
"UNION ",
"SELECT 'INSERTS' ",
",MAX((CAST(REORGINSERTS AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGINSERTS AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"inserts_th,
"UNION ",
"SELECT 'UPDATES' ",
",MAX((CAST(REORGUPDATES AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGUPDATES AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"updates_th,
"UNION ",
"SELECT 'DELETES' ",
",MAX((CAST(REORGDELETES AS REAL)/ ",
"CAST(TOTALROWS AS REAL))*100) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX((CAST(REORGDELETES AS REAL) ",
" /CAST(TOTALROWS AS REAL))*100)>"deletes_th,
"UNION ",
"SELECT 'REORGDAYS' ",
",MAX(DAYS(CURRENT TIMESTAMP)-DAYS(REORGLASTTIME)) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND T.TOTALROWS > 0 ",
"HAVING MAX(DAYS(CURRENT TIMESTAMP)- ",
" DAYS(REORGLASTTIME)) > "reorgdays_th,
"UNION ",
"SELECT 'NO RTS DATA', COUNT(*) ",
" FROM SYSIBM.TABLESPACESTATS T JOIN ",
" SYSIBM.SYSTABLESPACE S ",
" ON T.DBID = S.DBID ",
" AND T.PSID = S.PSID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.NAME = S.NAME ",
" WHERE S.DBNAME = '"db"' ",
" AND S.NAME = '"sn"' ",
partstm,
" AND REORGLASTTIME IS NULL ",
" AND LOADRLASTTIME IS NULL ",
"HAVING COUNT(*) > 0 ",
"WITH UR "
/*--------------------------------------------------------------*/
address dsnrexx
"execsql declare c1 cursor for s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ts_declare)
address dsnrexx
"execsql prepare s1 into :outsqlda from :sql_s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ts_prepare)
"execsql open c1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ts_open)
do until (sqlcode<>0)
address dsnrexx
"execsql fetch c1 using descriptor :outsqlda"
if debug then do
say "ts schwellwert sqlcode = "sqlcode
say "outsqlda.1.sqldata= "outsqlda.1.sqldata
say "outsqlda.2.sqldata= "outsqlda.2.sqldata
say "outsqlda.3.sqldata= "outsqlda.3.sqldata
say "outsqlda.4.sqldata= "outsqlda.4.sqldata
say "outsqlda.5.sqldata= "outsqlda.5.sqldata
say "outsqlda.6.sqldata= "outsqlda.6.sqldata
say "outsqlda.7.sqldata= "outsqlda.7.sqldata
end
if sqlcode = 0 then do
if outsqlda.1.sqldata = 'NO RTS DATA' then do
say "TABLESPACE "db"."sn" "partstm ||" DUE TO NO RTS DATA"
end
if outsqlda.1.sqldata = 'REORGDAYS' then do
parse value outsqlda.2.sqldata with akt_rd '.'
if reorgdays_th <> default_reorgdays_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO REORGDAYS > "reorgdays_th" ("akt_rd") "ex
end
if outsqlda.1.sqldata = 'UNCLUST' then do
parse value outsqlda.2.sqldata with akt_uc '.'
if unclust_th <> default_unclust_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO UNCLUST > "unclust_th" ("akt_uc") "ex
end
if outsqlda.1.sqldata = 'FARINDREF' then do
parse value outsqlda.2.sqldata with akt_fi '.'
if farindref_th <> default_farindref_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO FARINDREF > "farindref_th" ("akt_fi") "ex
end
if outsqlda.1.sqldata = 'NEARINDREF' then do
parse value outsqlda.2.sqldata with akt_ni '.'
if nearindref_th <> default_nearindref_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO NEARINDREF > "nearindref_th" ("akt_ni") "ex
end
if outsqlda.1.sqldata = 'EXTENTS' then do
parse value outsqlda.2.sqldata with akt_ex '.'
if extents_th <> default_extents_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO EXTENTS > "extents_th" ("akt_ex") "ex
end
if outsqlda.1.sqldata = 'INSERTS' then do
parse value outsqlda.2.sqldata with akt_in '.'
if inserts_th <> default_inserts_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO INSERTS > "inserts_th" ("akt_in") "ex
end
if outsqlda.1.sqldata = 'UPDATES' then do
parse value outsqlda.2.sqldata with akt_up '.'
if updates_th <> default_updates_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO UPDATES > "updates_th" ("akt_up") "ex
end
if outsqlda.1.sqldata = 'DELETES' then do
parse value outsqlda.2.sqldata with akt_de '.'
if deletes_th <> default_deletes_th
then ex='EXCEPTION'
else ex=''
say "TABLESPACE "db"."sn" "partstm ||,
" DUE TO DELETES > "deletes_th" ("akt_de") "ex
end
ts_reorg = y
end
end /* do until (sqlcode<>0) */
"execsql close c1"
if (sqlcode <> 0 ) then call sqlca(reorg_check_ts_close)
if debug then say "leave procedure reorg_check_ts..."
return
/*----------------------------------------------------------------*/
/*--------------- pruefen ob reorg ix noetig ist -----------------*/
/*----------------------------------------------------------------*/
reorg_check_ix: /* x33 */
if debug then say "enter procedure reorg_check_ix..."
ix_reorg = n
address dsnrexx
if debug then say "REORG_TH = "reorg_th
select
when reorg_th = 'ALWAYS' then do
ix_reorg = y
say "indexspace "db"."sn" "partstm||,
" DUE TO REORG = "reorg_th" EXCEPTION"
return
end
when reorg_th = 'NEVER' then do
ix_reorg = n
return
end
when reorg_th = 'THRESHOLD' then nop
when reorg_th = 'DEFAULT' then do
pagesplits_th = default_pagesplits_th
ixinserts_th = default_ixinserts_th
ixdeletes_th = default_ixdeletes_th
pseudodel_th = default_pseudodel_th
reorgdays_th = default_reorgdays_th
end
otherwise say "Wert ("reorg_th") fuer Feld Reorg ist nicht bekannt"
end /* select */
if debug then do
say "Datenbank = "db
say "Indexspace = "sn
say "Partition = "partstm
outsqlda.1.sqldata = 'dummy' /* schwellwert typ */
outsqlda.2.sqldata = 'dummy' /* schwellwert aktuell */
outsqlda.3.sqldata = 'dummy' /* unbenutzt */
outsqlda.4.sqldata = 'dummy' /* unbenutzt */
outsqlda.5.sqldata = 'dummy' /* unbenutzt */
outsqlda.6.sqldata = 'dummy' /* unbenutzt */
outsqlda.7.sqldata = 'dummy' /* unbenutzt */
end
/* sql statement -----------------------------------------------*/
sql_s1="SELECT 'PAGESPLITS', ",
" MAX((CAST(REORGLEAFFAR AS REAL)/ ",
" CAST(NACTIVE AS REAL))*100) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND T.NACTIVE > 0 ",
"HAVING MAX((CAST(REORGLEAFFAR AS REAL)/ ",
" CAST(NACTIVE AS REAL))*100)>"pagesplits_th,
"UNION ",
"SELECT 'INSERTS', ",
" MAX( CAST(REORGINSERTS AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND T.TOTALENTRIES > 0 ",
"HAVING MAX( CAST(REORGINSERTS AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) > "ixinserts_th,
"UNION ",
"SELECT 'DELETES', ",
" MAX( CAST(REORGDELETES AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND T.TOTALENTRIES > 0 ",
"HAVING MAX( CAST(REORGDELETES AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) > "ixdeletes_th,
"UNION ",
"SELECT 'PSEUDODEL', ",
" MAX( CAST(REORGPSEUDODELETES AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND T.TOTALENTRIES > 0 ",
"HAVING MAX( CAST(REORGPSEUDODELETES AS REAL)/ ",
" CAST(TOTALENTRIES AS REAL)*100) > "pseudodel_th,
"UNION ",
"SELECT 'REORGDAYS',COUNT(*) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" HAVING ",
" MAX( DAYS(CURRENT TIMESTAMP) ",
" -DAYS(REBUILDLASTTIME)) > "reorgdays_th,
" AND ",
" MAX( DAYS(CURRENT TIMESTAMP) ",
" -DAYS(REORGLASTTIME)) > "reorgdays_th,
" AND ",
" MAX( DAYS(CURRENT TIMESTAMP) ",
" -DAYS(LOADRLASTTIME)) > "reorgdays_th,
" AND COUNT(*) > 0 ",
"UNION ",
"SELECT 'NO RTS DATA',COUNT(*) ",
" FROM SYSIBM.INDEXSPACESTATS T JOIN ",
" SYSIBM.SYSINDEXES S ",
" ON T.DBID = S.DBID ",
" AND T.ISOBID = S.ISOBID ",
" AND T.DBNAME = S.DBNAME ",
" AND T.INDEXSPACE = S.INDEXSPACE ",
" WHERE S.DBNAME = '"db"' ",
" AND S.INDEXSPACE = '"sn"' ",
partstm,
" AND REORGLASTTIME IS NULL ",
" AND LOADRLASTTIME IS NULL ",
" AND REBUILDLASTTIME IS NULL ",
" HAVING COUNT(*) > 0 ",
"WITH UR "
/*--------------------------------------------------------------*/
address dsnrexx
"execsql declare c1 cursor for s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ix_declare)
address dsnrexx
"execsql prepare s1 into :outsqlda from :sql_s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ix_prepare)
"execsql open c1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(reorg_check_ix_open)
do until (sqlcode<>0)
address dsnrexx
"execsql fetch c1 using descriptor :outsqlda"
if debug then say "ix schwellwert sqlcode = "sqlcode
if sqlcode = 0 then do
if outsqlda.1.sqldata = 'NO RTS DATA' then do
say "INDEXSPACE "db"."sn" "partstm ||" DUE TO NO RTS DATA"
end
if outsqlda.1.sqldata = 'REORGDAYS' then do
if reorgdays_th <> default_reorgdays_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO NO REORG SINCE "reorgdays_th" DAYS "ex
end
if outsqlda.1.sqldata = 'PAGESPLITS' then do
parse value outsqlda.2.sqldata with akt_ps '.'
if pagesplits_th <> default_pagesplits_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO PAGESPLITS > "pagesplits_th" ("akt_ps")"ex
end
if outsqlda.1.sqldata = 'INSERTS' then do
parse value outsqlda.2.sqldata with akt_in '.'
if ixinserts_th <> default_ixinserts_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO INSERTS > "ixinserts_th" ("akt_in")"ex
end
if outsqlda.1.sqldata = 'DELETES' then do
parse value outsqlda.2.sqldata with akt_de '.'
if ixdeletes_th <> default_ixdeletes_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO DELETES > "ixdeletes_th" ("akt_de")"ex
end
if outsqlda.1.sqldata = 'PSEUDODEL' then do
parse value outsqlda.2.sqldata with akt_de '.'
if pseudodel_th <> default_pseudodel_th
then ex='EXCEPTION'
else ex=''
say "INDEXSPACE "db"."sn" "partstm ||,
" DUE TO PSEUDODEL > "pseudodel_th" ("akt_de")"ex
end
ix_reorg = y
end
end
"execsql close c1"
if (sqlcode <> 0 ) then call sqlca(reorg_check_ix_close)
if debug then say "leave procedure reorg_check_ix..."
return
/*----------------------------------------------------------------*/
/*------pruefen ob für ts ausnahme definiert ist -----------------*/
/*----------------------------------------------------------------*/
read_exceptions_ts: /* x44 */
if debug then say "enter procedure read_exceptions_ts..."
y=0
address dsnrexx
/* sql statement -----------------------------------------------*/
sql_s1="SELECT DBNAME ",
" ,TSNAME ",
" ,REORG ",
" ,UNCLUST ",
" ,FARINDREF ",
" ,NEARINDREF ",
" ,EXTENTS ",
" ,INSERTS ",
" ,UPDATES ",
" ,DELETES ",
" ,REORGDAYS ",
" FROM S100447.TEXCEPTIONS_TS ",
" FOR FETCH ONLY ",
"WITH UR "
/*--------------------------------------------------------------*/
/* host variablen zuweisung ------------------------------------*/
hvs_s1=" :HVDBNAME ",
" ,:HVTSNAME ",
" ,:HVREORG :INDREORG ",
" ,:HVUNCLUST :INDUNCLUST ",
" ,:HVFARINDREF :INDFARINDREF ",
" ,:HVNEARINDREF :INDNEARINDREF ",
" ,:HVEXTENTS :INDEXTENTS ",
" ,:HVINSERTS :INDINSERTS ",
" ,:HVUPDATES :INDUPDATES ",
" ,:HVDELETES :INDDELETES ",
" ,:HVREORGDAYS :INDREORGDAYS "
/*--------------------------------------------------------------*/
address dsnrexx
"execsql declare c1 cursor for s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_declare)
address dsnrexx
"execsql prepare s1 from :sql_s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_prepare)
"execsql open c1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_open)
"execsql fetch c1 into "hvs_s1
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_fetch1)
do while (sqlcode = 0)
if debug then do
say "ts ausnahme sqlcode = "sqlcode
say "dbname = " translate(hvdbname)
say "tsname = " translate(hvtsname)
say "reorg = " hvreorg "ind = "indreorg
say "unclust = " hvunclust "ind = "indunclust
say "farindref = " hvfarindref "ind = "indfarindref
say "nearindref= " hvnearindref"ind = "indnearindref
say "extents = " hvextents "ind = "indextents
say "inserts = " hvinserts "ind = "indinserts
say "updates = " hvupdates "ind = "indupdates
say "deletes = " hvdeletes "ind = "inddeletes
say "reorgdays = " hvreorgdays "ind = "indreorgdays
end
/* wenn hostvariable=null, dann default, sonst wert aus hv */
y=y+1
tsobject.y.1 = translate(hvdbname)
tsobject.y.2 = translate(hvtsname)
if indreorg = '-1' then tsobject.y.3 = default_reorg_th
else tsobject.y.3 = hvreorg
if indunclust = '-1' then tsobject.y.4 = default_unclust_th
else tsobject.y.4 = hvunclust
if indfarindref = '-1' then tsobject.y.5 = default_farindref_th
else tsobject.y.5 = hvfarindref
if indnearindref= '-1' then tsobject.y.6 = default_nearindref_th
else tsobject.y.6 = hvnearindref
if indextents = '-1' then tsobject.y.7 = default_extents_th
else tsobject.y.7 = hvextents
if indinserts = '-1' then tsobject.y.8 = default_inserts_th
else tsobject.y.8 = hvinserts
if indupdates = '-1' then tsobject.y.9 = default_updates_th
else tsobject.y.9 = hvupdates
if inddeletes = '-1' then tsobject.y.10 = default_deletes_th
else tsobject.y.10 = hvdeletes
if indreorgdays = '-1' then tsobject.y.11 = default_reorgdays_th
else tsobject.y.11 = hvreorgdays
address dsnrexx
"execsql fetch c1 into "hvs_s1
end /* do while */
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ts_fetch)
anztsobject = y
"execsql close c1"
if (sqlcode <> 0 & sqlcode <> 100)
then call sqlca(read_exceptions_ts_close)
if debug then say "leave procedure read_exceptions_ts..."
return
/*----------------------------------------------------------------*/
/*------pruefen ob für ix ausnahme definiert ist -----------------*/
/*----------------------------------------------------------------*/
read_exceptions_ix: /* x66 */
if debug then say "enter procedure read_exceptions_ix..."
/* init local vars */
y=0
hvdbname = 'dummy'
hvisname = 'dummy'
hvreorg = 'dummy'
hvpagesplits = 'dummy'
hvixinserts = 'dummy'
hvixdeletes = 'dummy'
hvpseudodel = 'dummy'
hvreorgdays = 'dummy'
indreorg = 'dummy'
indpagesplits = 'dummy'
indixinserts = 'dummy'
indixdeletes = 'dummy'
indpseudodel = 'dummy'
indreorgdays = 'dummy'
address dsnrexx
/* sql statement -----------------------------------------------*/
sql_s1="SELECT IX.DBNAME ",
" ,IX.INDEXSPACE ",
" ,IX.CREATOR ",
" ,IX.NAME ",
" ,EXC.REORG ",
" ,EXC.PAGESPLITS ",
" ,EXC.INSERTS ",
" ,EXC.DELETES ",
" ,EXC.PSEUDODEL ",
" ,EXC.REORGDAYS ",
" FROM S100447.TEXCEPTIONS_IX EXC ",
" JOIN SYSIBM.SYSINDEXES IX ",
" ON EXC.INDEXNAME = IX.NAME ",
" AND EXC.CREATOR = IX.CREATOR ",
"WITH UR "
/*--------------------------------------------------------------*/
/* host variablen zuweisung ------------------------------------*/
hvs_s1=" :HVDBNAME ",
" ,:HVISNAME ",
" ,:HVIXCREATOR ",
" ,:HVIXNAME ",
" ,:HVREORG :INDREORG ",
" ,:HVPAGESPLITS :INDPAGESPLITS ",
" ,:HVIXINSERTS :INDIXINSERTS ",
" ,:HVIXDELETES :INDIXDELETES ",
" ,:HVPSEUDODEL :INDPSEUDODEL ",
" ,:HVREORGDAYS :INDREORGDAYS "
/*--------------------------------------------------------------*/
address dsnrexx
"execsql declare c1 cursor for s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ix_declare)
address dsnrexx
"execsql prepare s1 from :sql_s1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ix_prepare)
"execsql open c1"
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ix_open)
do while (sqlcode = 0)
if debug then do
say "ix ausnahme sqlcode = "sqlcode
say "dbname = " translate(hvdbname)
say "indexspace = " translate(hvisname)
say "creator = " translate(hvixcreator)
say "indexname = " translate(hvixname)
say "reorg = " hvreorg "ind = "indreorg
say "pagesplits = " hvpagesplits "ind = "indpagesplits
say "inserts = " hvixinserts "ind = "indixinserts
say "deletes = " hvixdeletes "ind = "indixdeletes
say "pseudodel = " hvpseudodel "ind = "indpseudodel
say "reorgdays = " hvreorgdays "ind = "indreorgdays
end
/* wenn hostvariable=null, dann default, sonst wert aus hv */
y=y+1
ixobject.y.1 = translate(hvdbname)
ixobject.y.2 = translate(hvisname)
ixobject.y.3 = translate(hvixname)
ixobject.y.4 = translate(hvixcreator)
if indreorg = '-1' then ixobject.y.5 = default_reorg_th
else ixobject.y.5 = hvreorg
if indpagesplits = '-1' then ixobject.y.6 = default_pagesplits_th
else ixobject.y.6 = hvpagesplits
if indixinserts = '-1' then ixobject.y.7 = default_ixinserts_th
else ixobject.y.7 = hvixinserts
if indixdeletes = '-1' then ixobject.y.8 = default_ixdeletes_th
else ixobject.y.8 = hvixdeletes
if indpseudodel = '-1' then ixobject.y.9 = default_pseudodel_th
else ixobject.y.9 = hvpseudodel
if indreorgdays = '-1' then ixobject.y.10 = default_reorgdays_th
else ixobject.y.10 = hvreorgdays
address dsnrexx
"execsql fetch c1 into "hvs_s1
end /* do while */
if (sqlcode <> 0 & sqlcode <> 100) then
call sqlca(read_exceptions_ix_fetch)
anzixobject = y
"execsql close c1"
if (sqlcode <> 0 & sqlcode <> 100)
then call sqlca(read_exceptions_ix_close)
if debug then say "leave procedure read_exceptions_ix..."
return
/*----------------------------------------------------------------*/
/*--------- ausgeben von sql-fehlerbeschreibung sqlca ------------*/
/*----------------------------------------------------------------*/
sqlca:
if debug then say "enter procedure sqlca..."
arg sqlca_description
say ""
say " -------------------------------------------"
say "¦ sqlca for... = "sqlca_description
say "¦ sqlcode = "sqlcode
say "¦ sqlerrmc = "sqlerrmc
say "¦ sqlerrp = "sqlerrp
say "¦ sqlerrd.3 = "sqlerrd.3
say "¦ sqlerrd.4 = "sqlerrd.4
say "¦ sqlerrd.5 = "sqlerrd.5
say "¦ sqlerrd.6 = "sqlerrd.6
say " -------------------------------------------"
say ""
if debug then say "leave procedure sqlca..."
return
/*----------------------------------------------------------------*/
/*--------- ausgeben von fehlermeldungen -------------------------*/
/*----------------------------------------------------------------*/
fehler:
if debug then say "enter procedure fehler..."
arg fehlerquelle
say "rc= "rc||" bei "fehlerquelle
if debug then say "leave procedure fehler..."
exit
return
}¢--- A540769.WK.REXX.O08(CHGALLXX) cre=2008-03-17 mod=2008-03-17-11.36.25 F540769 ---
/* rexx ****************************************************************
wsh
***********************************************************************/
call adrIsp 'control errors return'
dsn = 'DSN.DBOF.DDL.SYN.TK'
x = lmmBegin(dsn)
do forever
m = lmmNext(x)
if m = '' then
return
s = "edit dataset('"dsn"("m")') macro("dbaCheMM")"
say s
call adrIsp s, 4
end
exit
editIM: procedure expose m.
parse arg dsn, mac
call adrIsp "edit dataset('"dsn"') macro("chgAllXX") parm(dbaCheMM"
return
}¢--- A540769.WK.REXX.O08(CMP) cre=2007-05-10 mod=2007-05-10-18.22.42 F540769 ---
m.jTest.act = ''
if 1 then do
call jInit
call envInit
call dConst
call jTestTotal
exit
end
call jTestCat
call jTestEnv
call jTestBar
call jTestEnv
call jTestBar
call jTestCat
call jTestJ
call jTestJTest
call jTestDsn
call jTestJ 0
call jTestJTest
call jTestScan
call jTestScanWin
call jTestDsn
call jTestTotal
call jTestJ 0
call jTestJTest
call jTestScan
call jTestScanWin
call jTestTotal
exit
****************************************
dConst: procedure expose m.
t = jNew()
call jTest t, 'dConst',
, "--- compile data: 3 lines: data line eins mit text",
, "--- run without input", "data line eins mit text",
, " und zwei ",
, "das genügt doch wohl| ",
, "--- run with 3 inputs",
, "data line eins mit text",
, " und zwei ", "das genügt doch wohl| ",
, "--- compile data: 7 lines: a",
, "--- run without input",
, "a",
, "b",
, "",
, "d",
, "",
, " ",
, "g."
call jTestAdd t, ,
, "--- run with 3 inputs",
, "a",
, "b",
, "",
, "d",
, "",
, " ",
, "g.
, ",
, "--- --- test end dConst readIx -1"
call ctData jBuf("data line eins mit text",
, " und zwei ", "das genügt doch wohl| ")
call ctData jBuf("a", "b", "", "d", "", " ", "g.")
call jTestEnd t
return
endProcedure dConst
ctData: procedure expose m.
parse arg src
code = cmpData(cmp(), src)
say 'compiled: ' code
interpret code
say 'interpreted ' code
return
endProcedure ctData
cmp: procedure expose m.
m = jNew()
m.cmp.scan.m = jNew
call scanOptions m.cmp.scan.m
return m
endProcedure cmp
cmpData: procedure expose m.
parse arg m, src
call jOpen src, 'r'
call scanReader m.cmp.scan.m, src
if scanName(m.cmp.scan.m) then
say 'scan first name' m.tok
else
call scanErr m.cmp.scan.m, 'first name'
return 'doBeDo'
endProcedure cmpData
/* ************************************************************* */
jTestJ: procedure expose m.
parse arg fail
say 'jTestJ test J and implicitely M without jTest with fail' fail
call envInit
call jOut 'out eins'
do lx=1 by 1 while jIn(var)
call jOut lx 'jIn()' m.var
end
call jOut 'jIn()' (lx-1) 'reads'
b = jOpen(jBuf(), 'w')
call jWrite b, 'buf line one'
call mAdd jBufStem(b), 'buf line two', 'buf line three'
call jWrite b, 'buf line four'
call jOpen b, 'r'
do while (jRead(b, line))
call jOut 'line' m.line
end
call jClose b
c = jBuf()
call envPush env('<£', b, '>£', c)
call jOut 'before readWrite 1 b --> c'
call utReadWrite
call jOut 'nach readWrite 1 b --> c'
call envPop
if fail = 1 then
call jWrite c, 'write nach pop'
call mAdd jBufStem(c), 'add nach pop'
call envPush env('<£', c)
call jOut 'before readWrite 2 c --> std'
call utReadWrite
call jOut 'nach readWrite 2 c --> std'
call envPop
if fail = 2 then
call jClose m.j.jOut
return
endProcedure jTestJ
jTestJTest: procedure expose m.
call jInit
jt = jNew()
c = jBuf()
call jTest jt, 'jTestJ',
, "jOut: out eins",
, "jIn 1: jTest in line 1 eins ,",
, "jOut: 1 jIn() jTest in line 1 eins ,",
, "jIn 2: jTest in line 2 zwei ; ",
, "jOut: 2 jIn() jTest in line 2 zwei ; ",
, "jIn 3: jTest in line 3 drei |",
, "jOut: 3 jIn() jTest in line 3 drei |",
, "jIn eof 4",
, "jOut: jIn() 3 reads",
, "jOut: line buf line one",
, "jOut: line buf line two",
, "jOut: line buf line three",
, "jOut: line buf line four",
, "jErr: write("c") when closed"
stdOut = m.env.env.1
stdOut = m.env.stdOut.out
call jTestAdd jT, ,
, "jOut: before readWrite 2 c --> std",
, "jOut: before readWrite 1 b --> c",
, "jOut: buf line one",
, "jOut: buf line two",
, "jOut: buf line three",
, "jOut: buf line four",
, "jOut: nach readWrite 1 b --> c",
, "jOut: add nach pop",
, "jOut: nach readWrite 2 c --> std",
, "jErr: do not jCLOSE("stdOut", ) base stdIn/stdOut"
call jOut 'out eins'
do lx=1 by 1 while jIn(var)
call jOut lx 'jIn()' m.var
end
call jOut 'jIn()' (lx-1) 'reads'
b = jOpen(jBuf(), 'w')
call jWrite b, 'buf line one'
call mAdd jBufStem(b), 'buf line two', 'buf line three'
call jWrite b, 'buf line four'
call jOpen b, 'r'
do while (jRead(b, line))
call jOut 'line' m.line
end
call jClose b
call envPush env('<£', b, '>£', c)
call jOut 'before readWrite 1 b --> c'
call utReadWrite
call jOut 'nach readWrite 1 b --> c'
call envPop
say 'jWrite' c
call jWrite c, 'write nach pop'
call mAdd jBufStem(c), 'add nach pop'
call envPush env('<£', c)
call jOut 'before readWrite 2 c --> std'
call utReadWrite
call jOut 'nach readWrite 2 c --> std'
call envPop
call jClose stdOut
call jTestEnd jt
return
endProcedure jTestJTest
jTestScan: procedure expose m.
call jInit
t = jNew()
call jTest t, 'jTestScan.1',
, "jOut: scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo'",
|| "'s' ",
, "jOut: scan name tok a034 key val ",
, "jOut: scan char tok , key val ",
, "jOut: scan name tok Und key val ",
, "jOut: scan space 1 tok key val ",
, "jOut: scan name tok hr123sdfER key val ",
, "jOut: scan string quo tok ""st1"" key val st1",
, "jOut: scan space 1 tok key val ",
, "jOut: scan string apo tok 'str2''mit''apo''s' key val str",
|| "2'mit'apo's",
, "jOut: scan space 4 tok key val "
call jSc1 ,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call jTestEnd t
call jTest t, 'jTestScan.2',
, "jOut: scan src litEinsefr 23 sdfER'str1'litZwei ""str2""""",
|| "mit quo""s ",
, "jOut: scan literal tok litEins key val ",
, "jOut: scan name tok efr key val ",
, "jOut: scan space 1 tok key val ",
, "jOut: scan number tok 23 key val ",
, "jOut: scan space 1 tok key val ",
, "jOut: scan name tok sdfER key val ",
, "jOut: scan string apo tok 'str1' key val str1",
, "jOut: scan literal tok litZwei key val str1",
, "jOut: scan space 1 tok key val ",
, "jOut: scan string quo tok ""str2""""mit quo"" key val str",
|| "2""mit quo",
, "jOut: scan name tok s key val str2""mit quo",
, "jOut: scan space 1 tok key val "
call jSc1 ,"litEinsefr 23 sdfER'str1'litZwei ""str2""""mit quo""s "
call jTestEnd t
call jTest t, 'jTestScan.3',
, "jOut: scan src aha;+-=f ab=cdEf eF='strIng' ",
, "jOut: scan keyValue tok no= key aha val def",
, "jOut: scan char tok ; key aha val ",
, "jOut: scan char tok + key aha val ",
, "jOut: scan char tok - key aha val ",
, "jOut: scan char tok = key aha val ",
, "jOut: scan keyValue tok no= key f val def",
, "jOut: scan keyValue tok cdEf key ab val cdEf",
, "jOut: scan keyValue tok 'strIng' key eF val strIng"
call jSc1 'kv def'," aha;+-=f ab=cdEf eF='strIng' "
call jTestEnd t
call jTest t, 'jTestScanReader',
, "jOut: name erste",
, "jOut: space",
, "jOut: name Zeile",
, "jOut: space",
, "jOut: nextLine",
, "jOut: nextLine",
, "jOut: space",
, "jOut: name dritte",
, "jOut: space",
, "jOut: name Zeile",
, "jOut: space",
, "jOut: name schluss",
, "jOut: space"
b = jBuf('erste Zeile ',,' dritte Zeile schluss ')
call jOpen b, 'r'
call scanReader s, b
do while ^scanAtEnd(s)
if scanName(s) then call jOut 'name' m.tok
else if scanVerify(s, ' ') then call jOut 'space'
else if scanNL(s) then call jOut 'nextLine'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
end
call jTestEnd t
call jTest t, 'jTestScanReader mit spaceLn',
, "jOut: name erste",
, "jOut: spaceLn",
, "jOut: name Zeile",
, "jOut: spaceLn",
, "jOut: name dritte",
, "jOut: spaceLn",
, "jOut: name Zeile",
, "jOut: spaceLn",
, "jOut: name schluss",
, "jOut: spaceLn"
call jOpen b, 'r'
call scanReader s, b
do forever
if scanName(s) then call jOut 'name' m.tok
else if scanSpaceNL(s) then call jOut 'spaceLn'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
else leave
end
call jTestEnd t
return
endProcedure jTestScan
/*--- one single test scan with lines to scan in stem ln -------------*/
jSc1:
parse arg fun def, ln
call jOut 'scan src' ln
call scanLine s, ln
do while ^scanAtEnd(s)
o = ''
if fun == 'kv' then do
if scanKeyValue(scanSkip(s), def) then o = 'keyValue '
else if scanAtEnd(s) then leave
end
else do
if scanLit(s, 'litEins') then o = 'literal '
else if scanLit(s, 'litZwei') then o = 'literal '
else if scanName(s) then o = 'name '
end
if o ^== '' then nop
else if scanString(s) then o = 'string apo'
else if scanString(s, '"') then o = 'string quo'
else if scanNat(s) then o = 'number '
else if scanVerify(s, ' ') then o = 'space' length(m.tok)
else if scanChar(s,1) then o = 'char '
else call scanErr s, 'not scanned'
call jOut 'scan' o 'tok' m.tok 'key' m.key ,
'val' m.val
end
return
endProcedure jSc1
jTestScanWin: procedure expose m.
call jInit
t = jNew()
call mAdd t'.'comp, 'eins', 'zwei', 'dreiVierFuenfSechsn',
, 'sieben', 'acht'
call jTest t, 'jTestScanWin',
, "jOut: scanWindwow cut 1 lines 41",
, "jOut: scanWindwow cut 2 lines 22",
, "jOut: scanWindwow cut 3 lines 15",
, "jOut: scanWindwow cut 4 lines 12",
, "jOut: scanWindwow cut 5 lines 10",
, "jOut: scanWindwow cut 6 lines 8",
, "jOut: scanWindwow cut 7 lines 8",
, "jOut: scanWindwow cut 8 lines 7",
, "jOut: scanWindwow cut 9 lines 7",
, "jOut: scanWindwow cut 10 lines 6",
, "jOut: scanWindwow cut 11 lines 5",
, "jOut: scanWindwow cut 12 lines 5"
do cc=1 to 12
call jScWi t, cc, "eins zwei dreiVierFuenfSechsn",
, ,"sieben acht"
end
call jTestEnd t
call jTest t, 'jTestScanWinCom' ,
, "jOut: scanWindwow cut 15 lines 5"
call jScWi t, 15,"eins %% 012345zwei dreiVierFuenfSechsn%%234",
"sieben %% 789 acht %% 234"
call jTestEnd t
return
endProcedure jTestScanWin
jScWi: procedure expose m.
parse arg t, cc
b = jOpen(jBuf(), 'r')
do ax=3 to arg()
aa = arg(ax)
if aa == '' then
aa = ' '
do cx=1 by cc to length(aa)
call mAdd jBufStem(b), substr(aa, cx, cc)
end
end
call scanWindow s, b, cc, (20%cc)+1
call scanOptions s, , , '%%'
call jOut 'scanWindwow cut' cc 'lines' mSize(jBufStem(b))
qx = 0
do forever
call scanSpaceNl s
if scanName(s) then do
qx = qx + 1
if m.tok ^== m.t.comp.qx then
call jOut 'scanned' m.tok 'but expected' m.t.comp.qx
end
else do
if ^ scanAtEnd(s) then
call scanErr s, 'could not scan'
if qx <> m.t.comp.0 then
call jOut 'scanned' qx 'name, but expected' m.t.comp.0
leave
end
end
call scanInit s
return
endProcedure jScWi
jTestDsn: procedure expose m.
call jInit
t = jNew()
call jTest t, 'jTestDsn',
, "jOut: ok write read 1 lines",
, "jOut: ok write read 2 lines",
, "jOut: ok write read 0 lines",
, "jOut: ok write read 55 lines",
, "jOut: ok write read 99 lines",
, "jOut: ok write read 100 lines",
, "jOut: ok write read 101 lines",
, "jOut: ok write read 201 lines",
, "jOut: ok write read 399 lines",
, "jOut: ok write read 300 lines",
, "jOut: ok write read 2000 lines",
, "jOut: ok write read 999 lines",
, "jOut: ok write read 3001 lines",
, "jOut: ok write read 0 lines"
d = jDsn('~TMP.TEXT(TTTEINS)')
call jTestWriteRead d, 1
call jTestWriteRead d, 2
call jTestWriteRead d, 0
call jTestWriteRead d, 55
call jTestWriteRead d, 99
call jTestWriteRead d, 100
call jTestWriteRead d, 101
call jTestWriteRead d, 201
call jTestWriteRead d, 399
call jTestWriteRead d, 300
call jTestWriteRead d,2000
call jTestWriteRead d, 999
call jTestWriteRead d,3001
call jTestWriteRead d, 0
call jTestEnd t
return
endProcedure jTestDsn
jTestWriteRead: procedure expose m.
parse arg f, cnt
call jOpen f, 'w'
pre = 'jTEstReadWrite' date() time(l) 'line'
do x=1 to cnt
call jWrite f, pre x
end
call jOpen f, 'r'
do y=1 while jRead(f, var)
if m.var <> pre y then
call jOut 'read mismatch line' y':' m.var
end
call jClose f
y = y - 1
if cnt = y then
call jOut 'ok write read' cnt 'lines'
else
call jOut 'mismatch written' cnt 'but read' y 'lines'
return
endProcedure jTestWriteRead
jTestBar: procedure expose m.
call envInit
t = jNew()
call jTest t, 'jTestBar',
, "jOut: +0 vor envBarBegin",
, "jIn 1: jTest in line 1 eins ,",
, "jIn 2: jTest in line 2 zwei ; ",
, "jIn 3: jTest in line 3 drei |",
, "jIn eof 4",
, "jOut: +7 nach envBarLast",
, "jOut: ¢7 +6 nach envBar 7!",
, "jOut: ¢7 +2 nach envBar 7!",
, "jOut: ¢7 +4 nach nested envBarLast 7!",
, "jOut: ¢7 (4 +3 nach nested envBarBegin 4) 7!",
, "jOut: ¢7 (4 (3 +1 nach envBarBegin 3) 4) 7!",
, "jOut: ¢7 (4 (3 jTest in line 1 eins , 3) 4) 7!",
, "jOut: ¢7 (4 (3 jTest in line 2 zwei ; 3) 4) 7!",
, "jOut: ¢7 (4 (3 jTest in line 3 drei | 3) 4) 7!",
, "jOut: ¢7 (4 (3 +1 nach readWrite vor envBar 3) 4) 7!",
, "jOut: ¢7 (4 +3 nach preSuf vor nested envBarLast 4) 7!",
, "jOut: ¢7 +4 nach preSuf vor nested envBarEnd 7!"
call jTestAdd t, ,
, "jOut: ¢7 +5 nach nested envBarEnd vor envBar 7!",
, "jOut: ¢7 +6 nach readWrite vor envBarLast 7!",
, "jOut: +7 nach readWrite vor envBarEnd",
, "jOut: +8 nach envBarEnd"
call jOut '+0 vor envBarBegin'
call envBarBegin
call jOut '+1 nach envBarBegin'
call utReadWrite
call jOut '+1 nach readWrite vor envBar'
call envBar
call jOut '+2 nach envBar'
call envBarBegin
call jOut '+3 nach nested envBarBegin'
call utPreSuf '(3 ', ' 3)'
call jOut '+3 nach preSuf vor nested envBarLast'
call envBarLast
call jOut '+4 nach nested envBarLast'
call utPreSuf '(4 ', ' 4)'
call jOut '+4 nach preSuf vor nested envBarEnd'
call envBarEnd
call jOut '+5 nach nested envBarEnd vor envBar'
call envBar
call jOut '+6 nach envBar'
call utReadWrite
call jOut '+6 nach readWrite vor envBarLast'
call envBarLast
call jOut '+7 nach envBarLast'
call utPreSuf '¢7 ', ' 7!'
call jOut '+7 nach readWrite vor envBarEnd'
call envBarEnd
call jOut '+8 nach envBarEnd'
call jTestEnd t
return
endProcedure jTestBar
jTestEnv: procedure
call envInit
t = jNew()
call jTest t, 'jTestEnv',
, "jOut: 1. test out",
, "jOut: 2. test write",
, "jIn 1: input einsA",
, "jOut: test read r1 1 : input einsA",
, "jIn eof 2",
, "jOut: test read r2 0 : M.R2",
, "jOut: envIsDefined(v1) false",
, "jOut: envIsDefined(v1) value of variable ""v1""",
, "jOut: 3. normaler Schluss"
call jTestAdd t, 'i0', "input einsA"
call jTestWrite t, "1. test out"
call jOut "2. test write"
call jOut "test read r1 " jIn(r1) ":" m.r1
call jOut "test read r2 " jIn(r2) ":" m.r2
if envIsDefined('v1') then
call jOut "envIsDefined(v1)" envGet('v1')
else
call jOut "envIsDefined(v1) false"
call envPut 'v1', 'value of variable "v1"'
if envIsDefined('v1') then
call jOut "envIsDefined(v1)" envGet('v1')
else
call jOut "envIsDefined(v1) false"
call jTestWrite t, "3. normaler Schluss"
call jTestEnd t
return
endProcedure jTestEnv
jTestCat: procedure
call envInit
tst = date('o') time()
t = jNew()
fn = '~test.shell'
call jTest t, 'jTestCat',
, "jOut: read aa 1 <zeile eins" tst " ",
|| " >",
, "jOut: read aa 2 <zeile zwei" tst " ",
|| " >",
, "jOut: read #buf 0 M.BLI",
, "jOut: read #buf b 1 <#buf eins" tst">",
, "jOut: read #buf b 2 <#buf zwei" tst">",
, "jOut: read bb 1 <zeile eins" tst " ",
|| " >",
, "jOut: read bb 2 <zeile zwei" tst " ",
|| " >",
, "jOut: read bb 3 <buffer 1. Zeile>",
, "jOut: read bb 4 <buffer 2.>",
, "jOut: read bb 5 <zeile eins" tst " ",
|| " >",
, "jOut: read bb 6 <zeile zwei" tst " ",
|| " >",
, "jOut: read bb 7 <#buf eins" tst">",
, "jOut: read bb 8 <#buf zwei" tst">",
, "jOut: read bb 8 lines"
c1 = cat(fn'(eins)')
call jOpen c1, 'w'
call jWrite c1, 'zeile eins' tst
call jWrite c1, 'zeile zwei' tst
call jClose c1, 'zeile drei' tst 'schluss'
call jOpen c1, 'r'
do lx=1 while jRead(c1, li)
call jOut 'read aa' lx '<'m.li'>'
end
call jClose c1
c2 = cat('#buf')
call jOpen c2, 'r'
call jOut 'read #buf' jRead(c2, bli) m.bli
call jOpen c2, 'w'
call jWrite c2, '#buf eins' tst
call jWrite c2, '#buf zwei' tst
call jOpen c2, 'r'
do lx=1 while jRead(c2, li)
call jOut 'read #buf b' lx '<'m.li'>'
end
call catReset c2, fn'(eins)'
call catAdd c2, "-£", jBuf("buffer 1. Zeile", "buffer 2.")
call catAdd c2, "-£", c1, "-", "#buf"
call jOpen c2, 'r'
do lx=1 while jRead(c2, li)
call jOut 'read bb' lx '<'m.li'>'
end
call jClose c2
call jOut 'read bb' (lx-1) 'lines'
call jTestEnd t
return
endProcedure jTestCat
err:
if m.jTest.act == '' then
call errA arg(1), 1
else
call jTestOut m.jTest.act, 'jErr:' arg(1)
return
endSubroutine err
/* copy ut begin ****************************************************
***********************************************************************/
utReadWrite: procedure expose m.
parse arg i, o
if i == '' then
i = m.j.jIn
if o == '' then
o = m.j.jOut
do while (jRead(i, line))
call jWrite o, m.line
end
return
endProcedure utReadWrite
utPreSuf: procedure expose m.
parse arg pre, suf
do while (jIn(line))
call jOut pre || m.line || suf
end
return
endProcedure utReadWrite
/* copy ut end ****************************************************/
/* copy cat begin ****************************************************
***********************************************************************/
catMakeOpen: procedure expose m.
parse arg opt, spec, defDsn
if right(opt, 1) = "£" then do
rw = spec
opt = left(opt, length(opt)-1)
end
else if left(spec, 1) == '#' then do
if envIsDefined(spec) then
rw = envGet(spec)
else
rw = envPut(spec, jBuf())
end
else if defDsn == '' then do
rw = jDsn(spec)
end
else do
rw = jReset(defDsn, spec)
end
if pos('-', opt) < 1 then
call jOpen rw, opt
return rw
endProcedure catMakeOpen
cat: procedure expose m.
m = jNew()
call catClose m
call jDefine m, "cat"
m.cat.m.defDsn = jDsn()
do ax=1 to arg()
m.cat.m.ax = arg(ax)
end
m.cat.m.0 = ax-1
return m
endProcedure cat
catReset: procedure expose m.
parse arg m
call catClose m
do ax=2 to arg()
bx=ax-1
m.cat.m.bx = arg(ax)
end
m.cat.m.0 = bx
return m
endProcedure catReset
catAdd: procedure expose m.
parse arg m
if m.cat.m.rdr ^== '' | m.cat.m.wrtr ^== '' then
call err 'catAdd but opened'
bx = m.cat.m.0
do ax=2 to arg()
bx=bx+1
m.cat.m.bx = arg(ax)
end
m.cat.m.0 = bx
return
endProcedure catAdd
catClose: procedure expose m.
parse arg m
if m.cat.m.rdr ^== '' & pos('-', m.cat.m.opt) < 1 then
if symbol('m.cat.m.rdr') == 'VAR' then
call jClose m.cat.m.rdr
m.cat.m.rdr = ''
m.cat.m.rdrIx = 'closed'
m.cat.m.opt = ''
if m.cat.m.wrtr ^== '' & pos('-', m.cat.m.opt) < 1 then
if symbol('m.cat.m.wrtr') == 'VAR' then
call jClose m.cat.m.wrtr
m.cat.m.wrtr = ''
return
endProcedure catClose
catOpen: procedure expose m.
parse arg m, oo
call catClose m
m.cat.m.opt = oo
m.cat.m.rdrIx = 0
if oo = 'r' then do
m.cat.m.rdr = catNextRW(m)
call jDefRead m, "res = catRead(m , arg)"
end
else if oo ^== 'w' & oo ^== 'a' then do
call err 'catOpen bad opt' opt
end
else do
m.cat.m.wrtr = catNextRW(m)
if m.cat.m.wrtr == '' then
call err 'catOpen no writer found'
m.cat.m.rdrIx = 'writing'
call jDefWrite m, "call catWrite m , arg"
end
return
endProcedure catOpen
catNextRW: procedure expose m.
parse arg m
cx = m.cat.m.rdrIx
oo = m.cat.m.opt
do cx=cx+1 to m.cat.m.0
if jOpt(m.cat.m.cx, 'rwa-£') then do
if pos(left(m.j.oOpt, 1), 'rwa') > 0 then
oo = left(oo, 1)substr(m.j.oOpt, 2)
else
oo = left(oo, 1)m.j.oOpt
end
else do
m.cat.m.rdrIx = cx
m.cat.m.opt = oo
return catMakeOpen(oo, m.cat.m.cx, m.cat.m.defDsn)
end
end
m.cat.m.rdrIx = cx
return ''
endProcedure catNextRw
catRead: procedure expose m.
parse arg m, arg
do while m.cat.m.rdr ^== ''
if jRead(m.cat.m.rdr, arg) then
return 1
call jClose m.cat.m.rdr
m.cat.m.rdr = catNextRW(m)
end
if ^ dataType(m.cat.m.rdrIx, 'n') then
call err 'catRead but' m.cat.m.rdrIx
return 0
endProcedure catRead
catWrite: procedure expose m.
parse arg m, arg
if m.cat.m.wrtr == '' then
call err 'catWrite without open for write'
call jWrite m.cat.m.wrtr, arg
return
endProcedure catWrite
/* copy cat end ****************************************************/
/* copy env begin ******************************************************
***********************************************************************/
env: procedure expose m.
nn = envReset(jNew())
do ax=1 by 2 to arg()-1
call envAddIo nn, arg(ax), arg(ax+1)
end
return nn
endProcedure env
envReset: procedure expose m.
parse arg m
call envClose m
m.env.m.in = ''
m.env.m.out = ''
m.env.m.doClose = ''
do ax=2 by 2 to arg()-1
call envAddIo m, arg(ax), arg(ax+1)
end
return m
endProcedure envReset
envClose: procedure expose m.
parse arg m
if symbol('m.env.m.doClose') == 'VAR' then
interpret m.env.m.doClose
m.env.m.doClose = ''
m.env.m.lastCat = ''
m.env.m.lastExt = ''
return m
endProcedure envClose
envAddIO: procedure expose m.
parse arg m, opt, spec
contX = pos("+", opt)
if contX > 0 then do
opt = left(opt, contX-1)substr(opt,contX+1)
contX = 1
end
if left(opt, 1) == '&' then do
if m.env.m.lastCat ^== '' then
call err 'envAddIO('opt',' spec') external within cat'
if m.env.m.lastExt ^== '' then
call err 'envAddIO('opt',' spec') external within ext'
m.env.m.lastExt = opt || spec
end
else if (contX | m.env.m.lastCat ^== '') then do
if left(opt, 1) ^== '<' then
call err 'envAddIO('opt',' spec') concat but not input'
if m.env.m.lastCat == '' then
m.env.m.lastCat = catNew(mNew())
call catAdd m.env.m.lastCat m, opt, spec
end
if ^ contX then do
if m.env.m.lastCat ^== '' then do
v = 'ro'
spec = m.env.m.lastCat
m.env.m.lastCat = ''
end
else do
v = env2opt(opt)
end
if m.env.m.lastExt ^== '' then do
nn = extFdNew(jNew(), m.env.m.lastExt, v, spec)
m.env.m.lastExt = ''
end
else do
nn = catMakeOpen(v, spec)
if left(v, 1) == 'r' then do
if m.env.m.in ^== '' then
call err 'addIo('opt',' spec') duplicate stdIn'
m.env.m.in = nn
end
else do
if m.env.m.out ^== '' then
call err 'addIo('opt',' spec') duplicate stdOut'
m.env.m.out = nn
end
end
m.env.m.doClose = m.env.m.doClose '; call jClose "'nn'"'
end
return m
endProcedure envAddIO
envLink: procedure expose m.
parse arg m, old
if m.env.m.lastCat ^== '' then
call err 'envLink with open cat'
if m.env.m.in == '' then
m.env.m.in = m.env.old.in
if m.env.m.out == '' then
m.env.m.out = m.env.old.out
return m
endProcedure envLink
envPut: procedure expose m.
parse arg na, va
m.env.var.na = va
return va
endProcedure envPut
envIsDefined: procedure expose m.
parse arg na
return symbol('m.env.var.na') == 'VAR'
endProcedure envIsDefined
envGet: procedure expose m.
parse arg na
if symbol('m.env.var.na') ^== 'VAR' then
call err 'envGet('na') undefined name'
return m.env.var.na
endProcedure envGet
envRemove: procedure expose m.
parse arg na
drop m.env.var.na
return
endProcedure envRemove
env2opt: procedure
parse arg o1 2 oR
if o1 == '<' then
return 'r' || oR
else if o1 ^== '>' then
return o1 || oR
else if left(oR, 1) == '>' then
return 'a' || substr(oR, 2)
else
return 'w' || oR
endProcedure env2opt
envInit: procedure expose m.
call jInit
m.env.env.0 = 1
ex = env()
m.env.env.1 = ex
m.env.ex.in = m.j.jIn
m.env.ex.out = m.j.jOut
m.env.val.0 = 0
return
endProcedure
envPush: procedure expose m.
parse arg e
ex = m.env.env.0
call envLink e, m.env.env.ex
ex = ex + 1
m.env.env.0 = ex
m.env.env.ex = e
m.j.jIn = m.env.e.in
m.j.jOut = m.env.e.out
return e
endProcedure envPush
envPop: procedure expose m.
ox = m.env.env.0
if ox <= 1 then
call err 'envPop on empty stack' ox
call envClose m.env.env.ox
ex = ox - 1
m.env.env.0 = ex
e = m.env.env.ex
m.j.jIn = m.env.e.in
m.j.jOut = m.env.e.out
return m.env.env.ox
endProcedure envPop
envBarBegin: procedure expose m.
call envPush env('>£', jBuf())
return
endProcedure envBarBegin
envBar: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.env.oldEnv.out, '>£', jBuf())
return
endProcedure envBar
envBarLast: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.env.oldEnv.out)
return
endProcedure envBarLast
envBarEnd: procedure expose m.
oldEnv = envPop()
return
endProcedure envBarEnd
/* copy env end *******************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanReader(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
m.scan.m.pos = 1
if symbol('m.scan.m.name') ^== 'VAR' then
call scanInit m
return m
endProcedure scanLine
/*--- switch to next line if atEnd of line or unCond=1 ---------------*/
scanNL: procedure expose m.
parse arg m, unCond
if m.scan.m.reading then do
interpret m.scan.m.scanNl
end
else do
np = 1 + length(m.scan.m.src)
if np <= m.scan.m.pos then
return 0
if unCond == 1 then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' ,
& abbrev(m.scan.m.src, m.scan.m.comment) then nop
else
return 0
m.scan.m.pos = np
return 1
end
endProcedure scanNL
scanAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.reading then
interpret m.scan.m.scanAtEnd
else
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEnd
/*--- initialize scanner for m --------------------------------------*/
scanInit: procedure expose m.
parse arg m, rdng
m.scan.m.reading = rdng == 1
m.tok = ''
m.val = ''
m.key = ''
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
return
endProcedure scanInit
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, m.scan.m.comment
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanInit m
if nameOne ^== '' then do
m.scan.m.Name1 = nameOne
m.scan.m.name = m.scan.m.name1 || '0123456789'
end
if namePlus ^== '' then
m.scan.m.name = m.scan.m.name1 || namePlus
return
endProcedure scanOptions
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
return substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
m.tok = scanLook(m, len)
m.scan.m.pos = m.scan.m.pos + length(m.tok)
return length(m.tok) > 0
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
ScanNat: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok 'scanPosition' ,
strip(left(substr(m.scan.m.src, m.scan.m.pos), 40), 't')
if m.scan.m.reading then
interpret 'say " "' m.scan.m.scanLinePos
else
say ' pos' m.scan.m.Pos 'in string' strip(m.scan.m.src, 't')
call err 'scanErr' txt
return
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
res = 0
do forever
if scanVerify(m, ' ') then nop
else if ^ scanNL(m) then leave
res = 1
end
m.tok = lastTok
return res
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- begin scanning the lines of a reader ---------------------------*/
scanReader: procedure expose m.
parse arg m, m.scan.m.rdr
call scanInit m, 1
m.scan.m.atEnd = 0
m.scan.m.lineX = 0
m.scan.m.scanNl = 'return scanReaderNl(m, unCond)'
m.scan.m.scanAtEnd = 'return scanReaderAtEnd(m, what)'
m.scan.m.scanLinePos = "scanReaderLinePos(m)"
call scanReaderNl m, 1
return m
endProcedure scanReader
/*--- return true/false whether we are at the end of line / reader ---*/
scanReaderAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if what == 'l' then
return 1
return m.scan.m.atEnd
endProcedure scanReaderAtEnd
scanReaderNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then nop
else if unCond ^= 2 & m.scan.m.pos > length(m.scan.m.src) then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' ,
& abbrev(m.scan.m.src, m.scan.m.comment) then nop
else
return 0
if m.scan.m.atEnd then
return 0
m.scan.m.atEnd = ^ jRead(m.scan.m.rdr, 'SCAN.'m'.SRC')
if m.scan.m.atEnd then do
m.scan.m.pos = 1 + length(m.scan.m.src)
end
else do
m.scan.m.pos = 1
m.scan.m.lineX = m.scan.m.lineX + 1
end
return ^ m.scan.m.atEnd
endProcedure scanReaderNL
scanReaderLinePos: procedure expose m.
parse arg m
if m.scan.m.atEnd then
qq = 'atEnd after'
else
qq = 'pos' m.scan.m.pos 'in'
return qq 'line' m.scan.m.lineX':' strip(m.scan.m.src, 't')
endProcedure scanReaderLinePos
/* copy scan end ****************************************************/
/* copy scanWin begin *************************************************
scan the the concatenation of the lines of a reader
any token my be split over several line
except the end-of-line-comment-token
***********************************************************************/
/*--- begin scanning the lines of a reader
by concatenating them together in window -----------------------*/
scanWindow: procedure expose m.
parse arg m, m.scan.m.rdr, m.scan.m.winCut, m.scan.m.winSz
call scanInit m, 1
m.scan.m.winML = (2 * m.scan.m.winSz + 1) * m.scan.m.winCut
m.scan.m.atEnd = 0
m.scan.m.lineX = 0
m.scan.m.scanNl = 'return scanWinNl(m, unCond)'
m.scan.m.scanAtEnd = 'return scanWinAtEnd(m, what)'
m.scan.m.scanLinePos = "scanWinLinePos(m)"
call scanLine m, ''
call scanWinNl m, 1
return m
endProcedure scanReader
/*--- return true/false whether we are at the end of line / reader ---*/
scanWinAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.pos > length(m.scan.m.src) then do
if m.scan.m.atEnd then
return 1
else
call scanErr m, 'out of window'
end
return 0
endProcedure scanReaderAtEnd
scanWinNL: procedure expose m.
parse arg m, unCond
ps = m.scan.m.pos
cut = m.scan.m.winCut
res = 0
if ps > length(m.scan.m.src) then do
if m.scan.m.atEnd then
return 0
if m.scan.m.src ^== '' then
call scanErr m, 'out of window'
end
else do
nl = ps + cut - ((ps-1) // cut)
if unCond == 1 then
res = 1
else if unCond ^= 0 & m.scan.m.comment ^== '' ,
& length(m.scan.m.comment) <= nl - ps then
res = abbrev(substr(m.scan.m.src, ps), m.scan.m.comment)
if res then
ps = nl
end
if m.scan.m.atEnd then do
m.scan.m.pos = ps
return res
end
if ps > cut * m.scan.m.winSz then do
ll = (ps-1) % cut
m.scan.m.src = substr(m.scan.m.src, 1 + ll * cut)
ps = ps - (ll * cut)
m.scan.m.lineX = m.scan.m.lineX + ll
end
do while length(m.scan.m.src) < m.scan.m.winML
m.scan.m.atEnd = ^ jRead(m.scan.m.rdr, r1)
if m.scan.m.atEnd then
leave
m.scan.m.src = m.scan.m.src || left(m.r1, cut)
end
m.scan.m.pos = ps
return res
endProcedure scanWinNL
scanWinLinePos: procedure expose m.
parse arg m
ps = m.scan.m.pos
cut = m.scan.m.winCut
if ps > length(m.scan.m.src) then do
lx = (length(m.scan.m.src) - 1) % cut
msg = 'after'
if m.scan.m.atEnd then
msg = 'atEnd' msg
end
else do
lx = (ps - 1) % cut
msg = 'pos' (ps - (lx*cut)) 'at'
end
return msg 'line' (m.scan.m.lineX+lx+1)':' ,
strip(substr(m.scan.m.src, lx*cut+1, cut), 't')
endProcedure scanWinLinePos
/* copy scanWin end *************************************************/
/* copy jTest begin ****************************************************
test infrastructure
***********************************************************************/
/*--- return stems ---------------------------------------------------*/
jTestAdd: procedure expose m.
parse arg m, wh
st = 'JTEST.'m
if pos('i', wh) > 0 then
st = st'.IN'
if pos('0', wh) > 0 then
sx = 0
else
sx = m.st.0
do ax=3 to arg()
sx = sx+1
m.st.sx = arg(ax)
end
m.st.0 = sx
return st
endProcedure jTestAdd
/*--- make writerDescriptor m a testWriter
--- and use remaining lines as compare values -----------------*/
jTest: procedure expose m.
parse arg m, name
m.jTest.m = name
m.jTest.act = m
ox = 1
m.jTest.m.ox = left('****** start jTest' name '', 79, '*')
do ax=3 to arg()
ox = ox + 1
m.jTest.m.ox = arg(ax)
end
m.jTest.m.0 = ox
m.jTest.m.in.0 = 0
call mAdd jTest'.'m'.IN', 'jTest in line 1 eins ,' ,
, 'jTest in line 2 zwei ; ',
, 'jTest in line 3 drei |'
call jDefine m, 'jTest'
call jDefine m'jIn', 'jTest'
if m.env.env.0 <> 1 then
call jTestErr m, 'm.env.env.0' m.env.env.0 '<> 1'
call envPush env( '<£', m'jIn', '>£', m)
call jTestOut m, m.jTest.m.1
return 'JTEST.'m
endProcedure jTest
jTestOpen: procedure expose m.
parse arg m, opt
if opt = 'r' then do
if right(m, 3) ^== 'jIn' then
call err 'jTestOpen' m',' opt
mw = left(m, length(m)-3)
call jDefRead m, 'res = jTestRead("'mw'", arg)'
m.jTest.mw.inIx = 0
end
else if opt = 'w' then do
call jDefWrite m, 'call jTestWrite m, arg'
m.jTest.m.out.0 = 0
m.jTest.m.err = 0
if symbol("m.jTest.err") ^= 'VAR' then
m.jTest.err = 0
end
else
call err 'bad opt jTestOpen('m',' opt')'
return m
endProcedure jTestOpen
jTestClose:
return arg(1)
endProcedure jTestClose
jTestEnd: procedure expose m.
parse arg m, opt
call envPop
m.jTest.act = ''
if m.env.env.0 <> 1 then
call jTestErr m, 'm.env.env.0' m.env.env.0 '<> 1'
if m.jTest.m.out.0 ^= m.jTest.m.0 then do
call jTestErr m, 'old' m.jTest.m.0 'lines ^= new' ,
m.jTest.m.out.0
do nx = m.jTest.m.out.0 + 1 to ,
min(m.jTest.m.out.0+10, m.jTest.m.0)
say 'old - ' m.jTest.m.nx
end
end
if m.jTest.m.err > 0 then do
say 'new lines:' m.jTest.m.out.0
len = 60
do nx=2 to m.jTest.m.out.0
str = quote(m.jTest.m.out.nx, '"')
pr = ' , '
do while length(str) > len
l=len
if substr(str, l-1, 1) = '"' then
if posCount('"', left(str, l-1)) // 2 = 0 then
l = l-1
say pr left(str, l-1)'",'
str = '"'substr(str, l)
pr = ' ||'
end
say pr str || left(',', nx < m.jTest.m.out.0)
end
end
say left('******' m.jTest.m 'end with' m.jTest.m.err 'errors ', 79,
, '*')
return
endProcedure jTestClose
/*--- write to test: say lines and compare them ----------------------*/
jTestWrite: procedure expose m.
parse arg m, arg
call jTestOut m, 'jOut:' arg
return
endProcedure jTestWrite
jTestOut: procedure expose m.
parse arg m, arg
nx = m.jTest.m.out.0 + 1
m.jTest.m.out.0 = nx
m.jTest.m.out.nx = arg
if nx > m.jTest.m.0 then do
if nx = m.jTest.m.0+1 then
call jTestErr m, 'more new Lines' nx
end
else if m.jTest.m.nx ^== arg then do
call jTestErr m, 'next line old' nx '^^^ new overnext'
say m.jTest.m.nx
end
say arg
return
endProcedure jTestOut
jTestRead: procedure expose m.
parse arg m, arg
ix = m.jTest.m.inIx + 1
m.jTest.m.inIx = ix
if ix <= m.jTest.m.in.0 then do
m.arg = m.jTest.m.in.ix
call jTestOut m, 'jIn' ix':' m.arg
return 1
end
call jTestOut m, 'jIn eof' ix
return 0
endProcedure jTestRead
/*--- say total errors and fail if not zero --------------------------*/
jTestTotal: procedure expose m.
if m.jTest.err = 0 then
say m.jTest.err 'errors total'
else
call err m.jTest.err 'errors total'
return
endProcedure jTestTotal
/*--- test err: message, count it and continue -----------------------*/
jTestErr: procedure expose m.
parse arg m, msg
say '*** error' msg
m.jTest.m.err = m.jTest.m.err + 1
m.jTest.err = m.jTest.err + 1
return
endProcedure jTestErr
/*--- return the count of occurrences of needle in heyStack ----------*/
posCount: procedure
parse arg needle, hayStack, start, fin
if start = '' then
start = 1
if fin = '' then
fin = length(hayStack) + 1 - length(needle)
do cnt = 0 by 1
start = pos(needle, haystack, start)
if start < 1 | start > fin then
return cnt
start = start + length(needle)
end
endProcedure posCount
/* copy jTest end **************************************************/
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jNew: procedure expose m.
return 'J.'mIncD(j.0)
endProcedure jNew
jFree: procedure expose m.
parse arg m
return
endProcedure jFree
jRead: procedure expose m.
parse arg m, arg
res = '?'
interpret m.j.m.read
return res
endProcedure jRead
jWrite: procedure expose m.
parse arg m, arg
interpret m.j.m.write
return
endProcedure jWrite
jReset: procedure expose m.
parse arg m, arg
interpret 'call' m.j.m.pref'Reset m, arg'
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret 'call' m.j.m.pref'Open m, arg'
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
interpret 'call' m.j.m.pref'Close m'
m.j.m.read = 'call err "read('m') when closed"'
m.j.m.write = 'call err "write('m') when closed"'
return m
endProcedure jClose
jDefine: procedure expose m.
parse arg m, m.j.m.pref
m.j.m.read = 'call err "read('m') when closed"'
m.j.m.write = 'call err "write('m') when closed"'
return m
endProcedure jDefine
jDefRead: procedure expose m.
parse arg m, m.j.m.read
m.j.m.write = 'call err "write('m') when reading"'
return m
endProcedure jDeRead
jDefWrite: procedure expose m.
parse arg m, m.j.m.write
m.j.m.read = 'call err "read('m') when writing"'
return m
endProcedure jDeWrite
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jInit: procedure expose m.
m.j.jIn = jNew()
m.j.jOut = jNew()
call jDefine m.j.jIn, "jStdIOError "
call jDefRead m.j.jIn, "res = 0"
call jDefine m.j.jOut, "jStdIOError "
call jDefWrite m.j.jOut, "say arg"
return
endProcedure jInit
jStdIOError: procedure expose m.
parse arg fun m, arg
call err 'do not j'fun'('m',' arg') base stdIn/stdOut'
return
endSubroutine
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
jBuf: procedure expose m.
m = jNew()
call jDefine m, "jBuf"
do ax=1 to arg()
m.j.m.buf.ax = arg(ax)
end
m.j.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
do ax=1 to arg() - 1
m.j.m.buf.ax = arg(ax+1)
end
m.j.m.buf.0 = ax-1
return m
endProcedure jBufReset
jBufOpen: procedure expose m.
parse arg m, opt
if opt == 'r' then do
call jDefRead m, "res = jBufRead(m , arg)"
m.j.m.bufIx = 0
return m
end
if opt == 'w' then
m.j.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
call jDefWrite m, "call mAdd 'J.'m'.BUF', arg"
return m
endProcedure jBufOpen
jBufClose:
return arg(1)
endProcedure jBufClose
jBufStem: procedure expose m.
parse arg m
return 'J.'m'.BUF'
endProcedure jBufStem
jBufRead: procedure expose m.
parse arg m, var
ix = m.j.m.bufIx + 1
if ix > m.j.m.buf.0 then
return 0
m.j.m.bufIx = ix
m.var = m.j.m.buf.ix
return 1
endProcedure jBufRead
jDsn: procedure expose m.
parse arg spec
m = jNew()
m.j.m.state = ''
call jDefine m, "jDsn"
m.j.m.defDD = 'J'mIncD('J.DEFDD')
call jDsnReset m, spec
return m
endProcedure jDsn
jDsnReset: procedure expose m.
parse arg m, spec
call jClose m
m.j.m.dsnSpec = spec
return m
endProcedure jDsnReset
jDsnOpen: procedure expose m.
parse arg m, opt
call jDsnClose m
if opt == 'r' then do
aa = dsnAlloc(m.j.m.dsnSpec, 'SHR', m.j.m.defDD)
call readDDBegin word(aa, 1)
call jDefRead m, "res = jDsnRead(m , arg)"
end
else do
if opt == 'w' then
aa = dsnAlloc(m.j.m.dsnSpec, 'OLD', m.j.m.defDD)
else if opt == 'a' then
aa = dsnAlloc(m.j.m.dsnSpec, 'MOD', m.j.m.defDD)
else
call err 'jBufOpen('m',' opt') with bad opt'
call writeDDbegin word(aa, 1)
call jDefWrite m, "call jDsnWrite m , arg"
end
m.j.m.state = opt
m.j.m.dd = word(aa, 1)
m.j.m.free = subword(aa, 2)
return m
endProcedure jBufOpen
jDsnClose:
parse arg m
if m.j.m.state ^== '' then do
if m.j.m.state == 'r' then do
call readDDend m.j.m.dd
end
else do
if m.j.m.buf.0 > 0 then
call writeDD m.j.m.dd, 'M.J.'m'.BUF.'
call writeDDend m.j.m.dd
end
interpret m.j.m.free
end
m.j.m.buf.0 = 0
m.j.m.bufIx = 0
m.j.m.state = ''
m.j.m.free = ''
m.j.m.dd = ''
return m
endProcedure jDsnClose
jDsnRead: procedure expose m.
parse arg m, var
ix = m.j.m.bufIx + 1
if ix > m.j.m.buf.0 then do
res = readDD(m.j.m.dd, 'M.J.'m'.BUF.')
if ^ res then
return 0
ix = 1
end
m.j.m.bufIx = ix
m.var = m.j.m.buf.ix
return 1
endProcedure jDsnRead
jDsnWrite: procedure expose m.
parse arg m, var
ix = m.j.m.buf.0 + 1
m.j.m.buf.0 = ix
m.j.m.buf.ix = var
if ix > 99 then do
call writeDD m.j.m.dd, 'M.J.'m'.BUF.'
m.j.m.buf.0 = 0
end
return
endProcedure jDsnWrite
/* copy j end *********************************************************/
/* copy m begin ********************************************************
stem and tree handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a, delta
if delta = '' then
m.a = m.a + 1
else
m.a = m.a + delta
return m.a
endProcedure mInc
/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
parse arg a, delta
if symbol('m.a') <> 'VAR' then
m.a = 0
return mInc(a)
endProcedure mIncD
/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
parse arg a
return m.m.key.a
endProcedure mKy
/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
parse arg a
if symbol('m.a.0') == 'VAR' then
return m.a.0
else
return 0
endProcedure mSize
/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg a
dx = lastPos('.', a)
if dx <= 1 then
return ''
else
return left(a, dx - 1)
endProcedure mPar
/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg a, Ky, val
if a == '' then
a = 'm.root.' || mIncD('m.root.0')
m.a = val
m.m.key.a = Ky
m.a.0 = 0
return a
endProcedure mRoot
/*--- add one or several values to stem m.a --------------------------*/
mAdd: procedure expose m.
parse arg a
ix = mSize(a)
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSeq: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
dx = mSize(dst)
do sx = begX to endX
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return dst
endProcedure mAddSeq
/*--- add one value to the stem m.m ----------------------------------*/
mAddNd: procedure expose m.
parse arg a
ix = mSize(a)
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
m.a.ix.0 = 0
end
m.a.0 = ix
return a'.'ix
endProcedure mAddNd
/*--- add one Ky value pair to stem m.a -----------------------------*/
mAddKy: procedure expose m.
parse arg a, Ky, val
nn = mAddNd(a, val)
m.m.key.nn = Ky
return nn
endProcedure mAddKy
/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
parse arg a, ky, val
if symbol('m.m.index.a.key.ky') == 'VAR' then
call err 'duplicate Ky' ky 'for node' m
nn = mAddNd(m, val)
m.m.key.nn = ky
m.m.index.a.key.ky = nn
return nn
endProcedure mAddK1
/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg a, Ky, val
if symbol('m.m.index.a.key.Ky') == 'VAR' then do
ch = m.m.index.a.key.Ky
m.ch = val
return ch
end
else do
return mAddK1(a, Ky, val)
end
return
endProcedure mPut
/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg a, ky
if symbol('m.m.index.a.key.ky') == 'VAR' then
return m.m.index.a.key.ky
else
return ''
endProcedure mAtK1
/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg a, Ky
if symbol('m.m.index.a.key.Ky') ^== 'VAR' then
call err 'no Ky' Ky 'at node' a
ch = m.m.index.a.key.Ky
return m.ch
endProcedure mVaAtK1
/*--- return the value of the first defined ky in the list of nodes
def if ky isn't defined ---------------------------------------*/
mFirst: procedure expose m.
parse arg Ky, def
do ax=3 to arg()
a = arg(ax)
if symbol('m.m.index.a.key.Ky') == 'VAR' then do
ch = m.m.index.a.key.Ky
return m.ch
end
end
return def
endProcedure mFirst
/*--- return the child at sequenceNo seq of node m -------------------*/
mAtSq: procedure expose m.
parse arg a, seq
if symbol('m.a.seq') ^== 'VAR' then
return ''
else
return m'.'seq
endProcedure mAtSq
/*--- remove all or all after nwSz children --------------------------*/
mRemCh: procedure expose m.
parse arg pa, nwSz
if nwSz = '' then
nwSz = 0
do cx=nwSz+1 to mSize(pa)
ch = pa'.'cx
call mRemCh ch
ky = m.m.key.ch
drop m.m.index.pa.key.ky m.key.ch m.ch m.ch.0
end
m.pa.0 = nwSz
return pa
endProcedure mRemCh
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mAddTree: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
do sx=begX to endX
sCh = src'.'sx
if symbol('m.m.key.sCh') ^= 'VAR' then do
dCh = mAddNd(dst, m.sCh)
end
else do
ky = m.m.key.sCh
if symbol('m.m.index.src.key.ky') ^= 'VAR' then
dCh = mAddKy(dst, ky, m.sCh)
else
dCh = mAddK1(dst, ky, m.sCh)
end
call mAddTree dCh, sCh
end
return dst
endProcedure mAddTree
/*--- show from one node everything that is defined ------------------*/
mShowNd: procedure expose m.
parse arg a
pa = mPar(a)
t = 'node' a 'pa='pa
if symbol('m.a') == 'VAR' then
t = t 'va='m.a
if symbol('m.a.0') == 'VAR' then
t = t 'size='m.a.0
if symbol('m.m.key.a') == 'VAR' then do
ky = m.m.key.a
t = t 'ky='ky
if symbol('m.m.index.pa.key.ky') == 'VAR' then
t = t 'index='m.m.index.pa.key.ky
end
say t
return
endProcedure mShowNd
/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg a, lv
if lv = '' then
lv = 0
t = left('', lv)a
if symbol('m.m.key.m') == 'VAR' then do
ky = m.m.key.m
pa = mPar(m)
if symbol('m.m.index.pa.key.ky') == 'VAR' then
t= t ky '>'
else
t= t ky '='
end
say t strip(m.a, 't')
do cx=1 to mSize(a)
call mShow mAtSq(a, cx), lv+1
end
return
endProcedure treeShow
/* copy m 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 -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
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 ds = '' then
ds = dsn2jcl(w)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
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)'
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(COMP) cre=2007-12-27 mod=2008-09-05-09.01.45 F540769 ---
/* copy comp begin *****************************************************
the shell compiler
syntax and semantics of the shell language see javaDoc
***********************************************************************/
/*--- module initialisation ------------------------------------------*/
compIni: procedure expose m.
if m.compIni = 1 then
return
m.compIni = 1
call envIni
call scanReadIni
cc = oNewClass('Compiler')
return
endProcedure compIni
/*--- constructor of Compiler ----------------------------------------*/
comp: procedure expose m.
parse arg src
nn = oNew('Compiler')
m.nn.scan = scanRead(src)
return compReset(nn, src)
endProcedure comp
compReset: procedure expose m.
parse arg m, src
call scanReadReset m.m.scan, src, , ,'$*'
m.m.chDol = '$'
m.m.chSpa = ' '
m.m.chNotWord = '${}=£:' || m.m.chSpa
m.m.stack = 0
return m
endProceduere compReset
/*--- push an empty stem on the stack --------------------------------*/
compPushStem: procedure expose m.
parse arg m
m.m.stack = m.m.stack + 1
pp = m'.STACK'm.m.stack
m.pp.0 = 0
return pp
endProcedure compPushStem
/*--- push a stem from the stack -------------------------------------*/
compPop: procedure expose m.
parse arg m, pp
if pp ^== m'.STACK'm.m.stack then
call err 'compPop pp' pp 'mismatch to' m'.STACK'm.m.stack
m.m.stack = m.m.stack - 1
return m
endProcedure compPop
/*--- compile the source and return an oRunner with the code ---------*/
compile: procedure expose m.
parse arg m, type
if type == 's' then do
what = "shell"
expec = "pipe or $;";
call compSpNlComment m
src = compShell(m)
end
else if type == 'd' then do
what = "data";
expec = "sExpression or block";
src = compData(m, 0)
end
else do
call err "bad type " type
end
if ^ scanAtEnd(m.m.scan) then
call scanErr m.m.scan, expec "expected: compile" what ,
" stopped before end of input"
call scanClose m.m.scan
r = oRunner(src)
return r
endProcedure compile
/*--- compile data lines return stmts or expr ------------------------*/
compData: procedure expose m.
parse arg m, makeExpr
s = m.m.scan
exprs = compPushStem(m)
do forever
aftEol = 0
do forever
text = "";
do forever
if scanVerify(s, m.m.chDol, 'm') then
text = text || m.s.tok
if ^ compComment(m) then
leave
end
nd = compExpr(m, 'd')
befEol = scanReadNL(s)
if nd <> '' | (aftEol & befEol) ,
| verify(text, m.m.chSpa) > 0 then do
if text ^== '' then
text = quote(text)
if text ^== '' & nd ^= '' then
text = text '|| '
call mAdd exprs, 'e' compNull2EE(text || nd)
end
if ^ befEol then
leave
aftEol = 1
end
one = compStmt(m)
if one == '' then
one = compRedirIO(m, 0)
if one == '' then
leave
call mAdd exprs, 's' one
end
if m.exprs.0 < 1 then do
if makeExpr then
res = '""'
else
res = ';'
end
else do
do x=1 to m.exprs.0 while left(m.exprs.x, 1) = 'e'
end
res = ''
if makeExpr & x > m.exprs.0 then do
res = substr(m.exprs.1, 3)
do x=2 to m.exprs.0
res = res substr(m.exprs.x, 3)
end
end
else do
do x=1 to m.exprs.0
if left(m.exprs.x, 1) = 'e' then
res = res 'call jOut'
res = res substr(m.exprs.x, 3)';'
end
if makeExpr then
res = "mCat("compStmts2ExprBuf(res)"'.BUF', ' ')"
end
end
call compPop m, exprs
return res
endProcedure compData
/*--- compile shell and return code ----------------------------------*/
compShell: procedure expose m.
parse arg m
res = ''
do forever
one = compPipe(m)
if one ^== '' then
res = res one
if ^ scanLit(m.m.scan, '$;') then
return strip(res)
call compSpNlComment m
end
endProcedure compShell
/*--- compile an expression, type d=data, w=word, s=strip ------------*/
compExpr: procedure expose m.
parse arg m, type
res = ''
if type == 'w' then
charsNot = m.m.chNotWord
else
charsNot = m.m.chDol
s = m.m.scan
if pos(type, 'sw') > 0 then
call compSpComment m
do forever
txt = ''
do forever
if scanVerify(s, charsNot, 'm') then
txt = txt || m.s.tok
if ^ compComment(m) then
leave
end
pr = compPrimary(m)
if pr = '' & pos(type, 'sw') > 0 then
txt = strip(txt, 't')
if txt ^== '' then
res = res '||' quote(txt)
if pr = '' then do
if pos(type, 'sw') > 0 then
call compSpComment m
if res == '' then
return ''
return substr(res, 5)
end
res = res '||' pr
end
return ''
endProcedure compExpr
/*--- push an empty stem on the stack --------------------------------*/
compPushStem: procedure expose m.
parse arg m
m.m.stack = m.m.stack + 1
pp = m'.STACK'm.m.stack
m.pp.0 = 0
return pp
endProcedure compPushStem
/*--- push a stem from the stack -------------------------------------*/
compPop: procedure expose m.
parse arg m, pp
if pp ^== m'.STACK'm.m.stack then
call err 'compPop pp' pp 'mismatch to' m'.STACK'm.m.stack
m.m.stack = m.m.stack - 1
return m
endProcedure compPop
/*--- compile a primary and return code ------------------------------*/
compPrimary: procedure expose m.
parse arg m
s = m.m.scan
if ^ scanLit(s, '$') then
return ''
if scanString(s) then
return m.s.tok
if scanLit(s, '(') then do
one = compCheckNN(m, compLang(m, 0), 'rexx expexted after $(')
if ^ scanLit(s, '$)') then
call scanErr s, 'closing $) missing after $(...'
return '('one')'
end
if scanLit(s, '-¢') then do
res = compData(m, 1)
if ^scanLit(s, '$!') then
call scanErr s, 'closing $! missing after $-¢ data'
return res
end
if scanLit(s, '-{') then do
res = compShell(m)
if ^scanLit(s, '$}') then
call scanErr s, 'closing $} missing after $-{ shell'
return "mCat("compStmts2ExprBuf(res)"'.BUF', ' ')"
end
if scanLit(s, '-cmpShell', '-cmpData') then do
return 'compile(comp(envRead2Buf()),' ,
'"'substr('ds', 1+(m.s.tok == '-cmpShell'), 1)'")'
end
if scanLit(s, '{') then do
if scanLit(s, '?') then
f = 'envIsDefined'
else if scanLit(s, '>') then
f = 'envRead'
else
f = 'envGet'
nm = compExpr(m, 'w')
if ^scanLit(s, '}') then
call scanErr s, 'closing } missing after ${'
return f'('nm')'
end
if scanName(s) then
return 'envGet('quote(m.s.tok)')'
call scanBack s, '$'
return ''
endProcedure compPrimary
/*--- compile a pipe and return code ---------------------------------*/
compPipe: procedure expose m.
parse arg m
s = m.m.scan
ios = ''
stmts = ''
stmtLast = ''
do forever
io1 = compRedirIO(m, 1)
if io1 ^== '' then do
ios = ios',' io1
call compSpNlComment m
end
else do
if stmtLast ^== '' then do
if ^ scanLit(s, '$¨') then
leave
call compSpNlComment m
end
one = compStmts(m)
if one == '' then do
if stmtLast ^== '' then
call scanErr s, 'stmts expected afte $¨'
if ios == '' then
return ''
leave
end
if stmtLast ^== '' then
stmts = stmts 'call envBar;' stmtLast
stmtLast = one
end
end
if stmts ^== '' then
stmtLast = insert('Begin', stmts, pos('envBar;', stmts)+5) ,
'call envBarLast;' stmtLast 'call envBarEnd;'
if ios ^== '' then do
if stmtLast == '' then
stmtLast = 'call envReadWrite;'
stmtLast = 'call envPush env('substr(ios, 3)');' stmtLast ,
'call envPop;'
end
return stmtLast
endProcedure compPipe
/*--- compile an io redirection, return
if makeExpr then "option", expr
else code write inut to standard out -------------*/
compRedirIO: procedure expose m.
parse arg m, makeExpr
s = m.m.scan
if ^ scanLit(s, '$&', '$<<', '$<', '$>>', '$>') then
return ''
opt = substr(m.s.tok, 2)
call scanVerify s, '+-£#¢{'
opt = opt || m.s.tok
/* ???? call compSpComment m */
if left(opt, 2) ^== '<<' then do
if verify(opt, '¢{', 'm') > 0 ,
| (left(opt, 1) == '&' & pos('£', opt) > 0) then
call scanErr s, 'inconsistent io redirection option' opt
ex = compCheckNN(m, compExpr(m, 's'),
, 'expression expected after $'opt)
end
else do
if verify(opt, '-£#', 'm') > 0 then
call scanErr s, 'inconsistent io redirection option' opt
if ^ scanName(s) then
call scanErr s, 'stopper expected in heredata after $'opt
stopper = m.s.tok
call scanVerify s, m.m.chSpa
if ^ scanReadNl(s) then
call scanErr s,
, 'space nl expected in heredata after $'opt||stopper
buf = jOpen(jBuf(), 'w')
do while ^ scanLit(s, stopper)
call jWrite buf, m.s.src
if ^ scanReadNl(s, 1) then
call scanErr s, 'eof in heredata after $'opt||stopper
end
call jClose buf
if verify(opt, '¢{', 'm') > 0 then do
if pos('¢', opt) > 0 then
ex = compile(comp(buf), 'd')
else
ex = compile(comp(buf), 's')
if makeExpr then
return "'<£', envRun("quote(ex)")"
else
return "call oRun" quote(ex)";"
end
opt = '<£'
ex = quote(buf)
end
if makeExpr then
return "'"opt"'," ex
else if left(opt, 1) = '>' then
call scanErr s, 'cannot write ioRedir $'opt
else
return "call envReadWrite '"opt"'," ex
endProcedure compRedirIO
/*--- compile stmts (stmt or java) -----------------------------------*/
compStmts: procedure expose m.
parse arg m
res = ''
do forever
one = compStmt(m)
if one == '' then
one = compLang(m, 1)
if one == '' then
return res
res = res strip(one)
call compSpNlComment m
end
endProcedure compStmts
/*--- compile a single statement -------------------------------------*/
compStmt: procedure expose m.
parse arg m
s = m.m.scan
if scanLit(s, "$=") then do
nm = compCheckNN(m, compExpr(m, 'w'), "variable name")
if scanLit(s, "=") then
vl = compExpr(m, 's')
else if scanLit(s, "£") then
vl = compCheckNN(m, compLang(m, 0),
, 'java expression after $= .. £')
else
call scanErr s, '= or £ expected after $= name'
return 'call envPut' nm',' vl';'
end
else if scanLit(s, '$@{') then do
call compSpNlComment m
one = compShell(m)
if ^ scanLit(s, "$}") then
call scanErr s, "closing $} missing for $@{ shell"
return "do;" one "end;"
end
else if scanLit(s, '$@¢') then do
call compSpNlComment m
one = compData(m, 0)
if ^ scanLit(s, "$!") then
call scanErr s, "closing $! missing for $@! data"
return "do;" one "end;"
end
else if scanLit(s, '$$') then do
return 'call jOut' compExpr(m, 's')';'
end
else if scanLit(s, '$£') then do
return 'call jOut' compCheckNN(m, compLang(m, 0),
, 'language expression after $£')';'
end
else if scanLit(s, '$@for') then do
v = compCheckNN(m, compExpr(m, 'w') ,
, "variable name after $@for")
call compSpNlComment m
return 'do while envRead('v');',
compCheckNN(m, compStmt(m),
, "statement after $@for variable") 'end;'
end
else if scanLit(s, '$@run') then do
return 'call oRun' compCheckNN(m, compExpr(m, 's'),
, 'expression after $@run') ';'
end
return ''
endProcedure compStmt
/*--- compile a language clause
multi=0 a single line for a rexx expression
multi=1 mulitple lines for rexx statements
(with rexx line contiunation) -----------------------*/
compLang: procedure expose m.
parse arg m, multi
s = m.m.scan
res = ''
do forever
if scanVerify(s, m.m.chDol, 'm') then do
res = res || m.s.tok
end
else do
one = compPrimary(m)
if one ^== '' then
res = res || one
else if compComment(m) then
res = res || ' '
else if ^multi then
return res
else if ^ scanReadNl(s) then do
if res == '' then
return res
else
return strip(res)';'
end
else do
res = strip(res)
if right(res, 1) = ',' then
res = strip(left(res, length(res)-1))
else
res = res';'
end
end
end
endProcedure compLang
/*--- convert stmts to an expression yielding the output ------------*/
compStmts2ExprBuf: procedure expose m.
parse arg stmts
rr = oRunner(stmts)
return "envRun('"rr"')"
endProcedure compStmts2ExprBuf
/*--- convert '' to an empty expression ------------------------------*/
compNull2EE: procedure
parse arg e
if e = '' then
return '""'
return e
endProcedure compNull2EE
/*--- if va == '' then issue an error with msg -----------------------*/
compCheckNN: procedure expose m.
parse arg m, va, msg
if va == '' then
call scanErr m.m.scan, msg 'expected'
return va
endProcedure compCheckNN
/*--- skip a comment. return 0 if there is none ----------------------*/
compComment: procedure expose m.
parse arg m
s = m.m.scan
if scanLit(s, '$**') then
m.s.pos = 1 + length(m.s.src) /* before next nl */
else if scanLit(s, '$*+') then
call scanReadNl s, 1
else if scanLit(s, '$*(') then do
do forever
if scanVerify(s, m.m.chDol, 'm') then iterate
if scanReadNl(s) then iterate
if compComment(m) then iterate
if ^ scanLit(s, '$') then
call scanErr s, 'source end in comment'
if scanLit(s, '*)') then
return 1
if scanLit(s, '$') then iterate
if scanString(s) then iterate
end
end
else
return 0
return 1
endProcedure compComment
/*--- skip spaces and comments ---------------------------------------*/
compSpComment: procedure expose m.
parse arg m
found = 0
do forever
if scanVerify(m.m.scan, m.m.chSpa) then
found = 1
else if compComment(m) then
found = 1
else
return found
end
endProcedure compSpComment
/*--- skip spaces, NLs and comments ----------------------------------*/
compSpNlComment: procedure expose m.
parse arg m
found = 0
do forever
if compSpComment(m) then
found = 1
else if scanReadNl(m.m.scan) then
found = 1
else
return found
end
endProcedure compSpComment
/* copy comp end ******************************************************/
}¢--- A540769.WK.REXX.O08(CONNDIR) cre=2007-11-08 mod=2007-11-08-09.37.50 F540769 ---
/* rexx *************************************************************
POV Monats Statistik Kollektor
Ueberblick
Alloziert die Monats Files
lässt TS5240 laufen (Die Tagesfile müssen im JCL alloziert werden)
falls TS5240 einen Returncode 0 zurückgibt
wird das alte Monatsfile gesavt und durch das neue ersetzt
sonst
wird das neue Monatsfile auf .....ER<Datum> umbenannt
die (fehlerfreien) neuen Monatsfiles werden auf RZ1 transferiert
Parameter: 4 space getrennte Worte ('*' oder '' für Default)
1. Wort: MonatVon (yyMM), default letzter Monat
2. Wort: MonatBis (yyMM), default aktueller Monat
3. Wort: dsnPrefix für MonatsFiles, default 'OMS.DIV.P0.STAT.'rz
4. Wort: 'SV': erstelle jeden Tag einen Save vom InputMonatsfile
mit suffix .SVjjmmtt, kein Save falls 4. Wort leer
FileNamen
mit jj zweistelliges Jahr, mm Monat , tt Tag
zzz RZ Name (RZ1, RZ2, RZ4)
OMS.DIV.P0.STAT.zzz.YjjMoo (altes) Monatsfile
OMS.DIV.P0.STAT.zzz.YjjMoo.NEW (neues) Monatsfile
OMS.DIV.P0.STAT.zzz.YjjMoo.SVjjoott Save des alten Monatsfile
OMS.DIV.P0.STAT.zzz.YjjMoo.ERjjoott Fehlerhaftes neues Monatsfile
History
12.11.04 Walter Keller, KPCO4 neu
10.12.04 Walter Keller, Parameter eingebaut
*********************************************************************/
DSN = 'A540769.TMP.LISTDEF'
call connectDirect dsn, 'RZ2', dsn
exit
/*********************************************************************
main code BEGIN
*********************************************************************/
parse arg monatVon monatBis dsnPref svSuf
say 'start POV Monats Statistik Kollektor'
say ' Version 0.2 OMS.DIV.P0.CLIST(POVMONKO)'
rz = sysvar('SYSNODE')
if dsnPref = '' | dsnPref = '*' then
dsnPref = 'OMS.DIV.P0.STAT.'rz
say ' in RZ' rz 'dsnPrefix' dsnPref
today = date('s')
if monatVon <> '' & monatVon <> '*' then
monatVon = checkMonat(monatVon)
else if substr(today, 5, 2) > '01' then
monatVon = substr(today, 3, 4) - 1
else
monatVon = substr(today, 3, 4) - 89
if monatBis = '' | monatBis = '*' then
monatBis = substr(today, 3, 4)
else
monatBis = checkMonat(monatBis)
say ' Monate' translate(format(monatVon, 4), '0' , ' ') ,
'-' translate(format(monatBis, 4), '0' , ' ')
erSuf = 'ER' || right(today, 6)
if svSuf = '' | svSuf = '*' then do
svSuf = ''
say ' ohne save errorSuffix' erSuf
end
else do
if length(svSuf) > 2 then
svSuf = left(svSuf, 2)
svSuf = svSuf || right(today, 6)
say ' save mit suffix' svSuf 'errorSuffix' erSuf
end
call allocateDsn
call adrTso "call *(ts5240) 't'"
call freeRename (adrTsoRc = 0)
exit
if rz ^= 'RZ1' then
call transferDsn /* transfer new datasets to rz1 */
return /* main */
/*********************************************************************
main code END
*********************************************************************/
checkMonat: procedure
parse arg ym
if verify(ym, '0123456789') <> 0 then
call err('monat nicht numerisch:' ym)
else if ym > 9999 then
call err('monat hat mehr als 4 Stellen (yymm):' ym)
if ym // 100 < 1 | ym // 100 > 12 then
call err('monat nicht zischen 1 und 12:' ym)
return ym /* checkMonat */
allocateDsn:
/*********************************************************************
generate Datasetnames
allocate month input and output DD's for current and previous month
*********************************************************************/
ym = monatVon
monatBis = translate(format(monatBis, 4), '0', ' ')
do i=1 by 1 /* compute fileNames */
yymm.i = translate(format(ym // 10000, 4), '0', ' ')
dsn.i = dsnPref'.Y'left(yymm.i, 2)'M'right(yymm.i, 2)
if yymm.i = monatBis then
leave
if ym // 100 >= 12 then
ym = ym + 89
else
ym = ym + 1
end
hix = i
say hix 'monate' yymm.1 '-' yymm.hix 'save' svSuf 'pref' dsnPref
like = ''
do i=1 to hix /* allocate mon in */
if sysDsn("'"dsn.i"'") = 'OK' then do
if like = '' then
like = "'"dsn.i"'"
call adrTso "alloc dd(MoIn"yymm.i") shr reuse",
"dsn('"dsn.i"')"
end
else
call adrTso "alloc dd(MoIn"yymm.i") reuse dummy"
end
if like = '' then
call err 'no existing dataset found from ' dsn.1 'to' dsn.hix
do i=1 to hix /* allocate mon out */
dsn = "'"dsn.i".NEW'"
if sysDsn(dsn) = 'OK' then
call adrTso "delete" dsn
call adrTso "alloc dd(MoOu"yymm.i") new catalog reuse",
" dsn("dsn") like("like") MGMTCLAS(S005N000)"
end
return; /* allocateDsn */
freeRename:
/*********************************************************************
free and rename the month Datasets depending on result
*********************************************************************/
parse arg ok
do i=1 to hix
call adrTso "free dd(MoIn"yymm.i")"
ff = listDsi('MoOu'yymm.i file)
if ff ^= 0 then
call err 'rc' ff 'from listDsi(MoOu'yymm.i 'file)',
'reason' sysReason
say 'listDsi(moOu'yymm.i') use' sysUsed 'alloc'sysAlloc sysUnits
if sysUsed = 0 then do
call adrTso "free dd(MoOu"yymm.i") delete"
end
else do
call adrTso "free dd(MoOu"yymm.i") catalog"
if ok then do
if sysDsn("'"dsn.i"'") = 'OK' then do
if svSuf = '' then
call adrTso "delete '"dsn.i"'"
else if sysDsn("'"dsn.i"."svSuf"'") = 'OK' then
call adrTso "delete '"dsn.i"'"
else
call adrTso "rename '"dsn.i"' '"dsn.i"."svSuf"'"
end
call adrTso "rename '"dsn.i".NEW' '"dsn.i"'"
transfer.i = 1
end
else do
if sysDsn("'"dsn.i"."erSuf"'") = 'OK' then
call adrTso "delete '"dsn.i"."erSuf"'"
call adrTso "rename '"dsn.i".NEW' '"dsn.i"."erSuf"'"
end
end
end
return /* freeRename */
transferDsn:
/*********************************************************************
transfer the newly created/modified month files to RZ1
*********************************************************************/
do i=1 to hix
say 'transfer.'i transfer.i
if transfer.i = 1 then
call connectDirect dsn.i, 'RZ1', dsn.i
end
return /* end transfer */
connectDirect: procedure
/*******************************************************************
send the file frDsn from the current not
to the node toNode as toDsn
using connect direct
********************************************************************/
trace ?R
parse upper arg frDsn, toNode, toDsn
say 'sending' frDsn 'to' toNode toDsn 'with connect direct'
call adrTso "alloc shr dd(sysut1) reuse dsn('"frDsn"')"
call adrTso "alloc new delete dd(DDIN) dsn("tempPref()".ddin)" ,
"recfm(f,b) lrecl(80)"
t.1 ="DSN='"toDsn"'"
t.2 ="DEST='"toNode"'"
t.3 ="MGMTCLAS='S005N000'"
t.4 ="DSNCOPY='YES'"
call adrTso 'EXECIO 4 DISKW DDIN (STEM t. FINIS)'
if 0 then do
call adrTso 'EXECIO * DISKr DDIN (STEM r. FINIS)'
say 'read' r.0
do i=1 to r.0
say i r.i
end
end
call adrTso "call *(OS2900)"
/* call adrTso 'free dd(sysut1)' a ghost freed it already */
call adrTso 'free dd(ddin) delete'
/* os2900 does not free it dd's, so we do it
otherwise the second run will fail... */
call adrTso 'free dd(ddPrint)'
call adrTso 'free dd(work01)'
call adrTso 'free dd(cmdout)'
call adrTso 'free dd(dmprint)'
say 'end connectDirect'
return /* end connectDirect */
tempPref: procedure
l = time(l);
d = 'tempFile.t'left(l,2)substr(l,4,2)substr(l,7,2)'.m'right(l,6)
return d /* end tempPref */
adrTso:
parse arg tsoCmd
/* say 'adrTso' tsoCmd */
address tso tsoCmd
adrTsoRc = rc
say 'adrTso rc' adrTsoRc 'for' tsoCmd
return
err:
parse arg errMsg
say 'fatal error:' errMsg
exit 12
}¢--- A540769.WK.REXX.O08(CONTSTCK) cre=2008-12-02 mod=2008-12-02-15.41.22 F540769 ---
/***********************************************************************
rexx control stack:
maximal 256 tief, enthält procedure calls
und jedes do..end, if usw.
wird ganz schlimm mit if else if else if else if .....
nachher stirbt's mit
IRX0011I Error running CONTSTCK, line 42: Control stack full
***********************************************************************/
call ifElse 1
do i=1 to 100000
call badGo i
end
call contStack 1
exit
badGo: procedure expose m.
parse arg i
if i // 2000 = 0 then
say 'badGotTo' i
do l1=1 to 1
do l2=1 to 1
do l3=1 to 1
do l4=1 to 1
do l5=1 to 1
return
end
end
end
end
end
endProcedure badGo
contStack: procedure expose m.
parse arg i
if i // 20 = 0 then
say 'contStack' i
do l1=1 to 1
do l2=1 to 1
do l3=1 to 1
do l4=1 to 1
do l5=1 to 1
call contStack i+1
end
end
end
end
end
endProcedure contStack
ifelse: procedure expose m.
parse arg i
say 'ifelse' i
if 0 then nop
else if 0 then nop
else if 0 then nop
else if 0 then nop
else if 0 then nop
else if 0 then nop
else if 0 then nop
else if 0 then nop
else if 0 then nop
else
call ifElse i+1
endProcedure ifElse
recursive: procedure expose m.
parse arg i
if i // 20 = 0 then
say 'recursive' i
call recursive i+1
endProcedure recursive
}¢--- A540769.WK.REXX.O08(CSI) cre=2008-01-18 mod=2008-05-20-12.25.45 F540769 ---
/* copy csi begin ***************************************************
csi interface: see dfs managing catalogs appendix c
returncode/reason see message IDC3009I
**********************************************************************/
/*--- specify dsn mask and fields to start a csi catalog search --------
arguments:
m objectPointer
dsnMask specifies the dsns with wildcards:
% 1 character
* 0 - n character in one level
** 0 - n levels
fields a (space separated) list of field names -------------*/
csiOpen: procedure expose m.
parse arg m, dsnMask, fields
m.m.fld.0 = words(fields)
ffix = d2c(m.m.fld.0, 2)
do x=1 to m.m.fld.0
m.m.fld.x = translate(word(fields, x))
ffix = ffix || left(m.m.fld.x, 8)
end
m.m.filt = left(dsnMask, 149) ,
|| left('Y', 3) , /* resume offset 149 */
|| ffix /* csiNumEn offset 152 */
WORKLEN = 1024 * 64
m.m.work = D2C(WORKLEN,4) || COPIES('00'X,WORKLEN-4)
m.m.pos = workLen + 1
return
endProcedure csiOpen
/*--- put the next dsn into m.o.dsn and m.o.* (for other fields)
return 1 if next dsn exists 0 otherwise ------------------------*/
csiNext: procedure expose m.
parse arg m, o
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET AMOUNT OF WORK AREA USED */
px = m.m.pos
do forever
if px > usedL then do
if substr(m.m.filt, 150, 1) ^== 'Y' then do
m.m.pos = px
m.o.dsn = ''
return 0
end
reason = left('', 4)
ADDRESS LINKPGM 'IGGCSI00 reason m.'m'.filt m.'m'.work'
if rc == 0 & substr(reason, 3, 2) == '0000'x then
nop
else if rc == 4 & substr(reason, 3, 2) == '0464'x then
say 'data set entry with error'
else
call err 'call csi returns' rc,
'rc' c2d(substr(reason, 4,1)),
'reason' c2d(substr(reason, 3,1)),
'module' substr(reason, 1,2)
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET WORK AREA USED */
numFD = C2D(SUBSTR(m.m.work,13,2)) /* no flds + 1 */
if numFd <> m.m.fld.0 + 1 then
call err 'csiNumFd' numFd 'not' m.m.fld.0 '+' 1
px = 15
iterate
end
eType = substr(m.m.work, px+1, 1)
m.o.dsn = substr(m.m.work, px+2, 44)
flag = substr(m.m.work, px, 1)
/* say 'eType' eType m.o.dsn 'flag' c2x(flag) */
if eType == '0' then do
if flag ^== '00'x & flag ^== '40'x then
call err 'flag' c2x(flag) 'for catalog' m.o.dsn
px = px + 50 /* length of catalog entry */
iterate
end
else do
if ^ abbrev(x2b(c2x(flag)), '101') then
call err 'call csi entry flag' x2b(c2x(flag)),
'rc' c2d(substr(m.m.work, px+49,1)),
'reason' c2d(substr(m.m.work, px+48,1)),
'module' substr(m.m.work, px+46, 2),
'for entry' m.o.dsn,
'see qw IDC3009I'
py = px + 46
tl = c2d(substr(m.m.work, py, 2))
pl = py + 4
pf = py + m.m.fld.0 * 2 + 4
do fx = 1 to m.m.fld.0
fi = m.m.fld.fx
fl = c2d(substr(m.m.work, pl, 2))
m.o.fi = substr(m.m.work, pf, fl)
if fi = 'MGMTCLAS' then
m.o.fi = substr(m.o.fi, 3, c2d(left(m.o.fi ,2)))
else if wordPos(fi, 'COMUDSIZ NOBYTTRK') > 0 then
m.o.fi = c2d(m.o.fi)
pf = pf + fl
pl = pl + 2
end
if py + tl <> pf then
call err 'length mismatch for entry' m.o.dsn
m.m.pos = pf
return 1
end
end
endProcedure csiNext
/*--- if dsn is arcived return 'arcive'
if dsn is tape return 'tape'
otherwise return managment class ------------------------------*/
csiArcTape: procedure expose m.
parse arg vo, cl, dt, dsn
if vo = '' then
say err '||| no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl <> '' then
res = cl
else if abbrev(vo, 'SHR') then
res = 'SHR'
else
res = 'tape'
if res = 'arcive' then
return res
/*if abbrev(res, 'ar') ^= abbrev(dt, '00'x) , */
if abbrev(res, 'ta') ^= abbrev(c2x(left(dt, 1)), '7') ,
| (left(res, 1) >= 'A') ^= abbrev(dt, '30'x) then
say '||| mismatch cl' cl 'vo' vo 'dt' c2x(dt) 'dsn' dsn
return res
endProcedure csiArcTape
/* copy csi end ******************************************************/
}¢--- A540769.WK.REXX.O08(CSIOLD) cre=2008-03-25 mod=2008-03-25-12.00.56 F540769 ---
/* copy csi begin ****************************************************/
/*===================================================================*/
csiCla: procedure expose m.
parse arg csiKey
/*===================================================================*/
/*********************************************************************/
/* */
/* PVS CATALOG SEARCHE INTERFACE */
/* */
/* DESCRIPTION: THIS REXX EXEC IS USED TO CALL THE CATALOG */
/* SEARCH INTERFACE IGGCSI00 */
/* (REPLACEMENT FOR THE IDCAMS LISTC) */
/* */
/* INPUT: CSIKEY DSLEVEL TO LOOK FOR */
/* */
/* OUTPUT: CSIDSN.0: NUMBER OF DSN'S RETURNED */
/* CSIDSN.: ARRAY WITH DSN'S */
/* */
/*********************************************************************/
/*********************************************************************/
/* */
/* INITIALIZE THE PARM LIST PASSED TO IGGCSI00 */
/* */
/*********************************************************************/
MODRSNRC = SUBSTR(' ',1,4) /* CLEAR MODULE/RETURN/REASON */
CSIFILTK = SUBSTR(CSIKEY,1,44) /* MOVE FILTER KEY INTO LIST */
CSICATNM = SUBSTR(' ',1,44) /* SET CATALOG NAME */
CSIRESNM = SUBSTR(' ',1,44) /* CLEAR RESUME NAME */
CSIDTYPS = SUBSTR(' ',1,16) /* CLEAR ENTRY TYPES */
CSICLDI = SUBSTR(' ',1,1) /* NO DATA AND INDEX */
CSIRESUM = SUBSTR(' ',1,1) /* CLEAR RESUME FLAG */
CSIS1CAT = SUBSTR(' ',1,1) /* SEARCH THIS CATALOG ONLY */
CSIRESRV = SUBSTR(' ',1,1) /* CLEAR RESERVE CHARACTER */
CSINUMEN = '0003'X /* INIT NUMBER OF FIELDS */
CSIFLD1 = 'DEVTYP ' /* INIT FIELD 1 FOR DEVTYPE */
CSIFLD2 = 'VOLSER ' /* INIT FIELD 2 FOR VOLSER */
CSIFLD3 = 'MGMTCLAS' /* INIT FIELD 2 FOR VOLSER */
/*********************************************************************/
/* */
/* BUILD THE SELECTION CRITERIA FIELDS PART OF PARAMETER LIST */
/* */
/*********************************************************************/
CSIOPTS = CSICLDI || CSIRESUM || CSIS1CAT || CSIRESRV
csi.fi.eld = CSIFILTK || CSICATNM || CSIRESNM || CSIDTYPS || CSIOPTS,
|| CSINUMEN || CSIFLD1 || CSIFLD2 || CSIFLD3
/*********************************************************************/
/* */
/* INITIALIZE AND BUILD WORK ARE OUTPUT PART OF PARAMETER LIST */
/* */
/*********************************************************************/
WORKLEN = 1024
dw.or.kokok = D2C(WORKLEN,4) || COPIES('00'X,WORKLEN-4)
/*********************************************************************/
/* */
/* INITIALIZE WORK VARIABLES */
/* */
/*********************************************************************/
RESUME = 'Y' /* SET RESUME FLAG */
CSIDSN.0 = 0 /* A COUNT OF DSNAMES FILLED */
/*********************************************************************/
/* */
/* SET UP LOOP FOR RESUME (IF A RESUME IS NECESSARY) */
/* */
/*********************************************************************/
DO WHILE RESUME = 'Y' /* UNTIL EOF OF CATALOG READ */
ADDRESS LINKPGM 'IGGCSI00 MODRSNRC csi.fi.eld dw.or.kokok'
RESUME = SUBSTR(csi.fi.eld,150,1) /* GET RESUME FLAG FOR NEXT LOOP */
USEDLEN = C2D(SUBSTR(dw.or.kokok,9,4)) /* GET AMOUNT OF WORK AREA USED */
POS1=15 /* STARTING POSITION */
/********************************************************************/
/* */
/* PROCESS DATA RETURNED IN WORK AREA */
/* */
/********************************************************************/
DO WHILE POS1 < USEDLEN /* UNTIL ALL DATA IS PROCESSED */
IF SUBSTR(dw.or.kokok,POS1+1,1) = '0' THEN /* IF ITS THE CATALOG */
DO
POS1 = POS1 + 50 /* SKIP TO THE END OF IT */
END
ELSE DO /* IF NOT CATALOG */
IF SUBSTR(dw.or.kokok,POS1+1,1) = 'A' THEN /* ONLY PROCESS NVSAM */
DO
CSIDSN.0 = CSIDSN.0 + 1 /* COUNT DSNAMES FILLED */
DSN = SUBSTR(dw.or.kokok,POS1+2,44) /* GET THE DSNAME */
if dsn <> csiKey then
call err 'dsn' dsn '<> csiKey' csiKey
pL = POS1 + 50
L1 = c2d(SUBSTR(dw.or.kokok,PL, 2))
L2 = c2d(SUBSTR(dw.or.kokok,PL+2, 2))
L3 = c2d(SUBSTR(dw.or.kokok,PL+4, 2))
dt = substr(dw.or.kokok, pL+6, l1)
vo = substr(dw.or.kokok, pL+6+l1, l2)
cl = substr(dw.or.kokok, pL+6+l1+l2, l3)
cl = substr(cl, 3, c2d(left(cl, 2)))
if vo = '' then
say err '||| no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl <> '' then
res = cl
else if abbrev(vo, 'SHR') then
res = 'SHR'
else
res = 'tape'
if abbrev(res, 'ar') ^= abbrev(dt, '00'x) ,
| abbrev(res, 'ta') ^= abbrev(c2x(left(dt, 1)), '7') ,
| (left(res, 1) >= 'A') ^= abbrev(dt, '30'x) then
say '||| mismatch cl' cl 'vo' vo 'dt' c2x(dt) 'dsn' dsn
return res
END
POS1 = POS1 + 46 /* SKIP TO RECORD END */
POS1 = POS1 + C2D(SUBSTR(dw.or.kokok,POS1,2)) /* ADD CSITOTLN */
END
END
END
RETURN 'notFound' /* RETURN TO INVOKER */
csiClaLi: procedure expose m. csiDsn.
parse arg csiKey
csiKey = csiKey'.**'
/*===================================================================*/
/*********************************************************************/
/* */
/* PVS CATALOG SEARCHE INTERFACE */
/* */
/* DESCRIPTION: THIS REXX EXEC IS USED TO CALL THE CATALOG */
/* SEARCH INTERFACE IGGCSI00 */
/* (REPLACEMENT FOR THE IDCAMS LISTC) */
/* */
/* INPUT: CSIKEY DSLEVEL TO LOOK FOR */
/* */
/* OUTPUT: CSIDSN.0: NUMBER OF DSN'S RETURNED */
/* CSIDSN.: ARRAY WITH DSN'S */
/* */
/*********************************************************************/
/*********************************************************************/
/* */
/* INITIALIZE THE PARM LIST PASSED TO IGGCSI00 */
/* */
/*********************************************************************/
MODRSNRC = SUBSTR(' ',1,4) /* CLEAR MODULE/RETURN/REASON */
CSIFILTK = SUBSTR(CSIKEY,1,44) /* MOVE FILTER KEY INTO LIST */
CSICATNM = SUBSTR(' ',1,44) /* SET CATALOG NAME */
CSIRESNM = SUBSTR(' ',1,44) /* CLEAR RESUME NAME */
CSIDTYPS = SUBSTR(' ',1,16) /* CLEAR ENTRY TYPES */
CSICLDI = SUBSTR(' ',1,1) /* NO DATA AND INDEX */
CSIRESUM = SUBSTR(' ',1,1) /* CLEAR RESUME FLAG */
CSIS1CAT = SUBSTR(' ',1,1) /* SEARCH THIS CATALOG ONLY */
CSIRESRV = SUBSTR(' ',1,1) /* CLEAR RESERVE CHARACTER */
CSINUMEN = '0003'X /* INIT NUMBER OF FIELDS */
CSIFLD1 = 'DEVTYP ' /* INIT FIELD 1 FOR DEVTYPE */
CSIFLD2 = 'VOLSER ' /* INIT FIELD 2 FOR VOLSER */
CSIFLD3 = 'MGMTCLAS' /* INIT FIELD 2 FOR VOLSER */
/*********************************************************************/
/* */
/* BUILD THE SELECTION CRITERIA FIELDS PART OF PARAMETER LIST */
/* */
/*********************************************************************/
CSIOPTS = CSICLDI || CSIRESUM || CSIS1CAT || CSIRESRV
csi.fi.eld = CSIFILTK || CSICATNM || CSIRESNM || CSIDTYPS || CSIOPTS,
|| CSINUMEN || CSIFLD1 || CSIFLD2 || CSIFLD3
/*********************************************************************/
/* */
/* INITIALIZE AND BUILD WORK ARE OUTPUT PART OF PARAMETER LIST */
/* */
/*********************************************************************/
WORKLEN = 100000
dw.or.kokok = D2C(WORKLEN,4) || COPIES('00'X,WORKLEN-4)
/*********************************************************************/
/* */
/* INITIALIZE WORK VARIABLES */
/* */
/*********************************************************************/
RESUME = 'Y' /* SET RESUME FLAG */
CSIDSN.0 = 0 /* A COUNT OF DSNAMES FILLED */
/*********************************************************************/
/* */
/* SET UP LOOP FOR RESUME (IF A RESUME IS NECESSARY) */
/* */
/*********************************************************************/
DO WHILE RESUME = 'Y' /* UNTIL EOF OF CATALOG READ */
ADDRESS LINKPGM 'IGGCSI00 MODRSNRC csi.fi.eld dw.or.kokok'
RESUME = SUBSTR(csi.fi.eld,150,1) /* GET RESUME FLAG FOR NEXT LOOP */
USEDLEN = C2D(SUBSTR(dw.or.kokok,9,4)) /* GET AMOUNT OF WORK AREA USED */
POS1=15 /* STARTING POSITION */
/********************************************************************/
/* */
/* PROCESS DATA RETURNED IN WORK AREA */
/* */
/********************************************************************/
DO WHILE POS1 < USEDLEN /* UNTIL ALL DATA IS PROCESSED */
IF SUBSTR(dw.or.kokok,POS1+1,1) = '0' THEN /* IF ITS THE CATALOG */
DO
POS1 = POS1 + 50 /* SKIP TO THE END OF IT */
END
ELSE DO /* IF NOT CATALOG */
IF SUBSTR(dw.or.kokok,POS1+1,1) = 'A' THEN /* ONLY PROCESS NVSAM */
DO
DSN = strip(SUBSTR(dw.or.kokok,POS1+2,44))/* GET THE DSNAME */
pL = POS1 + 50
L1 = c2d(SUBSTR(dw.or.kokok,PL, 2))
L2 = c2d(SUBSTR(dw.or.kokok,PL+2, 2))
L3 = c2d(SUBSTR(dw.or.kokok,PL+4, 2))
dt = substr(dw.or.kokok, pL+6, l1)
vo = substr(dw.or.kokok, pL+6+l1, l2)
cl = substr(dw.or.kokok, pL+6+l1+l2, l3)
cl = substr(cl, 3, c2d(left(cl, 2)))
if vo = '' then
say err '||| no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl <> '' then
res = cl
else if abbrev(vo, 'SHR') then
res = 'SHR'
else
res = 'tape'
if abbrev(res, 'ar') ^= abbrev(dt, '00'x) ,
| abbrev(res, 'ta') ^= abbrev(c2x(left(dt, 1)), '7') ,
| (left(res, 1) >= 'A') ^= abbrev(dt, '30'x) then
say '||| mismatch cl' cl 'vo' vo 'dt' c2x(dt) 'dsn' dsn
csiDsn.dsn = res
csiDsn.0 = csiDsn.0 + 1
END
POS1 = POS1 + 46 /* SKIP TO RECORD END */
POS1 = POS1 + C2D(SUBSTR(dw.or.kokok,POS1,2)) /* ADD CSITOTLN */
END
END
END
RETURN 'notFound' /* RETURN TO INVOKER */
/* copy csi end *******************************************************/
}¢--- A540769.WK.REXX.O08(CSM) cre=2008-05-09 mod=2008-09-05-08.57.03 F540769 ---
/* copy csm begin ******************************************************
interface to csm,
it is integrate with adrTso, eg. dsnAlloc , 'RZ3/..' uses csm
***********************************************************************/
adrCsm:
return adrTso('csmExec' arg(1), arg(2))
endProcedure adrCsm
csmCopy: procedure expose m.
parse arg csnFr, csnTo, ggRet
if dsnGetMbr(csnTo) ^= '' ,
& dsnGetMbr(csnFr) <> dsnGetMbr(csnTo) then
call err 'member rename' csnFr 'to' csnTo
parse value csmSysDsn(csnFr) with sysFr '/' dsnFr
parse value csmSysDsn(csnTo) with sysTo '/' dsnTo
if sysFr = '*' & sysTo <> '*' then do
pdsTo = dsnSetMbr(dsnTo)
al = "SYSTEM("sysTo") DDNAME(COPYTo)",
"DATASET('"pdsTo"') DISP(SHR)"
alRes = dsnAlloc(systo'/'pdsTo, ,'COPYTO', '*')
if datatype(alRes, 'n') then do
/* wir müssen es selbst allozieren csmxUtil
vergisst management class ||||| */
say 'could not allocate' al
say 'trying to create'
rc = listDsi("'"dsnSetMbr(dsnFr)"' SMSINFO")
if rc ^= 0 then
call err 'listDsi rc' rc 'reason' sysReason,
sysMsgLvl1 sysMsgLvl2
al = left(al, length(al)-4)'CAT)'
if right(sysDsSms, 7) == 'LIBRARY' ,
| abbrev(sysDsSms, 'PDS') then
al = al 'DSNTYPE(LIBRARY)'
if sysUnits = 'TRACK' then
sysUnits = 'TRACKS'
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")",
"RECFM("sysREcFM") LRECL("SYSLRECL")",
"blksize("sysBLkSIZE")",
"SPACE("sysPrimary"," sysSeconds")" sysUnits
call adrCsm "allocate" al
end
call adrTso 'free dd(copyTo)'
end
c = "'COPY" sysFr"/''"dsnFr"'' TO" ,
sysTo"/''"dsnSetMbr(dsnTo)"'' REPLACE'"
return adrTso("exec 'CSM.DIV.P0.EXEC(CSRXUTIL)'" c , ggRet)
return
endProcedure csmCopy
csmAlloc: procedure expose m.
parse upper arg dd, disp, dsn, rest, nn, retRc
sys = ''
a2 = ''
parse value csmSysDsn(dsn) with sys '/' dsn
if disp = '' then
disp = 'shr'
al = "SYSTEM("sys") DDNAME("dd")"
if dsn <> '' then do
a2 = "DATASET('"dsnSetMbr(dsn)"')"
mbr = dsnGetMbr(dsn)
if mbr <> '' then
a2 = a2 'MEMBER('mbr')'
end
if abbrev(disp, 'SYSOUT(') then
a2 = a2 disp
else
a2 = a2 "DISP("disp")"
if retRc <> '' | nn = '' then do
alRc = adrCsm('allocate' al a2 rest, retRc)
if alRc <> 0 then
return alRc
return dd 'call adrTso "free dd('dd')";'
end
do retry=0 by 1
alRc = adrCsm('allocate' al a2 rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 then
return err('cmsAlloc rc' alRc 'for' al rest)
say 'csmAlloc rc' alRc 'for' al a2 rest '...trying to create'
nn = al 'disp(cat)' dsnCreateAtts(dsn, nn, 1)
call adrCsm 'allocate' nn
call adrTso 'free dd('dd')'
end
endProcedure csmAlloc
csmSysDsn: procedure expose m.
parse upper arg dsn, withStar
if pos('/', dsn) < 1 then
sys = '*'
else
parse var dsn sys '/' dsn
if sys <> '' & sys <> '*' & sys <> sysvar(sysnode) then
return sys'/'dsn
else if withStar == 0 then
return dsn
else
return '*/'dsn
endProcedure csmSysDsn
/* copy csm end********************************************************/
}¢--- A540769.WK.REXX.O08(CSMSERE) cre=2008-03-05 mod=2008-03-05-16.17.21 F540769 ---
/* 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CSMSUB) cre=2008-03-05 mod=2008-04-03-11.30.46 F540769 ---
/* REXX */
parse arg mm vv
say csmSub mm vv
mark = 'csmExec'
if mm <> mark then do
c = "csmExec select cmd('csmSub" mark mm vv"')"
say c
call adrTso c
exit
end
I.1 = '//A540769Z JOB (CP00,KE50)'
I.2 = '//*MAIN CLASS=LOG ' time()
I.3 = '//S1 EXEC PGM=IEFBR14'
I.0 = 3
call writeDsn 'SYSOUT(T) .WRITER(INTRDR)', I.
exit
address tso CSMEXEC 'ALLOCATE FREECLOS SYSTEM(RZ2) ddName(JOB)' ,
'SYSOUT(T) WRITER(INTRDR)'
say rc 'dd' subsys_ddName 'system' subsys_system
I.2 = i.2 csm rz2
call writeDsn '-JOB', i.
EXIT
/* 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 = '' & ^ abbrev(disp, 'SYSO') then
return 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 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
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CSMV0) cre=2008-04-04 mod=2008-04-04-11.49.19 F540769 ---
/* rexx */ 00010000
parse arg fun rest 00050001
say 'csmV0' fun rest 00060001
call t1 0, "CSMEXEC ",
"SELECT tsoCmd('%CSRXUTIL COPY WK.REXX(CSMV0) ",
"TO RZ0/tmp.rexx REPLACE')"
call t1 0, "CSMAPPC START PGM(CSMEXEC) PARM('" ,
"SELECT tsoCmd(''%CSRXUTIL COPY WK.REXX(CSMV0) ",
"TO RZ0/tmp.rexx REPLACE'')')"
exit
t1: procedure
parse arg alib, c
if alib then do
call adrTso 'altlib act application(exec)',
"dataset('CSM.DIV.P0.EXEC')"
say 'altlib rc' rc
end
address tso c
say 'adr tso rc' rc c
if alib then do
call adrTso 'altlib deact application(exec)'
say 'deact rc' rc
end
return
endProcedure t1
if fun ^== 'CSMSTARTED' then do 00070001
if 0 then do 00080004
say 'executing copy' 00090004
address Tso "CSMAPPC Start Pgm(CSMEXEC) ", 00100004
"Parm(""Select tsocmd('", 00110004
"%CSRXUTIL COPY WK.REXX(CSMXUTIL) TO RZ2/WK.REZZZ')"")" 00120004
say 'copy rc' rc 00130004
end 00140004
say 'executing start csmexec' 00150004
call adrCsm "select tsoCmd('%csmV0 CSMSTARTED" fun rest"')" 00160004
say 'returned from start csmexec' 00190001
exit 00200001
call adrTso "CSMAPPC Start Pgm(CSMEXEC) ", 00160004
"Parm(""Select Tsocmd('EXEC ''"exec"(csmV0)'' ''CSMSTARTED" , 00170001
fun rest"''')"")" 00180001
say 'returned from start csmexec' 00190001
exit 00200001
end 00210001
say 'csm started' rest 00220001
if 0 then do 00230004
'%CSRXUTIL COPY WK.REXX(CSMXUTIL) TO RZ2/WK.REZZZ' 00240004
say 'rc csrxutil' rc 00250004
"csmexec DSLIST DSNMASK('A540769.WK.**') system(*)" 00260004
end 00270004
if 0 then do 00280004
say 'dslist rc' rc 00290004
say stemsize 00300004
say dsname.1 dsname.10 00310004
say recfm.0 recfm.1 00320004
say lrecl.0 lrecl.1 00330004
end 00340004
if 0 then do 00350004
address tso 'free dd(copyFr copyTo)' 00360004
dsnFr = 'A540769.wk.rexx' 00370004
dsnTo = 'A540769.tmp.aaa' 00380004
call adrTso "alloc dd(copyFr) shr dsn('"dsnFr"')" 00390004
rc = listDsi("copyFr FILE SMSINFO") 00400004
say 'listDsi rc' rc 'for' w sysdsname 00410004
if rc ^= 0 then 00420004
say varExp('sysReason sysMsgLvl1 sysMsgLvl2') 00430004
say varExp('sysLRecL sysBlkSize sysKeyLen') 00440004
say varExp('sysUnit sysTrksCyl sysBlksTrk sysUnits sysUsed') 00450004
say varExp('sysMgmtClass') 00460004
if right(sysDsSms, 7) == 'LIBRARY' | abbrev(sysDsSms, 'PDS') then 00470004
al = 'DSNTYPE(LIBRARY)' 00480004
else 00490004
al = '' 00500004
al = "SYSTEM(RZ2) DDNAME(COPYTo)", 00510004
"DATASET('"dsnTo"') DISP(CAT) DSORG("sysDSorg")", 00520004
"MGMTCLAS("sysMgmtClass")", 00530004
"RECFM("sysREcFM") LRECL("SYSLRECL") blksize("sysBLkSIZE")", 00540004
al "SPACE("sysPrimary"," sysSeconds")" sysUnits 00550004
say al 00560004
address tso "csmexec allocate" al 00570004
say 'alloc rc' rc 00580004
address tso "csmexec COPY inDD(copyFr) outDD(copyTo)" , 00590004
"member(csmV0)" 00600004
say 'copy rc' rc 00610004
address tso 'free dd(copyFr copyTo)' 00620004
end 00630004
if 0 then do 00640004
call csmCopyTo 'A540769.WK.REXX(csmV0)', rz2, 'A540769.tmp.aaa(ef)' 00650004
end 00660004
if 1 then do 00640004
call csmCopyTx 'A540769.WK.REXX(csmV0)', rz8,
, 'A540769.tmp.aaa(csmV0)'
end 00660004
if 1 then do 00640004
call csmCopyTx 'DSN.DBA.CK01008N.IFF', rz8, 'A540769.tmp.IFFck' 00650004
end 00660004
exit 00670001
00680004
adrCsm: 00690004
return adrTso('csmExec' arg(1), arg(2)) 00700004
endProcedure adrCsm 00710004
00720004
csmCopyTo: procedure expose m. 00730004
parse arg dsnFr, sysTo, dsnTo 00740004
mbrFr = dsnGetMbr(dsnFr) 00750004
dsnFr = dsnSetMbr(dsnFr) 00760004
mbrTo = dsnGetMbr(dsnTo) 00770004
dsnTo = dsnSetMbr(dsnTo) 00780004
say 'fr' dsnFr mbrFr 'to' sysTo dsnTo mbrTo 00790004
call adrTso "alloc dd(copyFr) shr dsn('"dsnFr"')" 00800004
al = "SYSTEM("sysTo") DDNAME(COPYTo)", 00810004
"DATASET('"dsnTo"') DISP(OLD)" 00820004
if adrCsm("allocate" al, '*') ^= 0 then do 00830004
say 'could not allocate' al 00840004
say 'trying to create' al 00850004
rc = listDsi("copyFr FILE SMSINFO") 00860004
if rc ^= 0 then 00870004
call err 'listDsi rc' rc 'reason' sysReason, 00880004
sysMsgLvl1 sysMsgLvl2 00890004
al = left(al, length(al)-4)'CAT)' 00900004
if right(sysDsSms, 7) == 'LIBRARY' , 00910004
| abbrev(sysDsSms, 'PDS') then 00920004
al = al 'DSNTYPE(LIBRARY)' 00930004
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")", 00940004
"RECFM("sysREcFM") LRECL("SYSLRECL") blksize("sysBLkSIZE")",00950004
"SPACE("sysPrimary"," sysSeconds")" sysUnits 00960004
say al 00970004
call adrCsm "allocate" al 00980004
end 00990004
cs = "COPY inDD(copyFr) outDD(copyTo)" 01000004
if mbrFr <> '' then 01010004
cs = cs 'MEMBER('mbrFr')' 01020004
if mbrTo <> '' then 01030004
cs = cs 'NEWNAME('mbrTo')' 01040004
call adrCsm cs 01050004
call adrTso 'free dd(copyFr copyTo)', '*' 01060004
return 01070004
endProcedure csmCopyTo 01080004
01090004
csmCopyTx: procedure expose m. 00730004
parse arg dsnFr, sysTo, dsnTo 00740004
pdsTo = dsnSetMbr(dsnTo) 00780004
if dsnGetMbr(dsnTo) ^= '' ,
& dsnGetMbr(dsnFr) <> dsnGetMbr(dsnTo) then
call err 'member rename' dsnFr 'to' sysTo'/'dsnTo
al = "SYSTEM("sysTo") DDNAME(COPYTo)", 00810004
"DATASET('"pdsTo"') DISP(SHR)" 00820004
if adrCsm("allocate" al, '*') ^= 0 then do 00830004
/* wir müssen es selbst allozieren csmxUtil
vergisst management class ||||| */
say 'could not allocate' al 00840004
say 'trying to create' 00850004
rc = listDsi("'"dsnSetMbr(dsnFr)"' SMSINFO") 00860004
if rc ^= 0 then 00870004
call err 'listDsi rc' rc 'reason' sysReason, 00880004
sysMsgLvl1 sysMsgLvl2 00890004
al = left(al, length(al)-4)'CAT)' 0090
if right(sysDsSms, 7) == 'LIBRARY' , 0091
| abbrev(sysDsSms, 'PDS') then 0092
al = al 'DSNTYPE(LIBRARY)' 0093
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")", 0094
"RECFM("sysREcFM") LRECL("SYSLRECL") blksize("sysBLkSIZE")",0095
"SPACE("sysPrimary"," sysSeconds")" sysUnits 0096
say al 0097
call adrCsm "allocate" al 0098
end 0099
call adrTso 'free dd(copyTo)'
call adrTso "exec 'CSM.DIV.P0.EXEC(CSRXUTIL)'",
"'COPY ''"dsnFr"'' TO "sysTo"/''"pdsTo"'' REPLACE'"
return 01070004
endProcedure csmCopyTx 01080004
01090004
varExp: 01100004
parse arg ggVarExpVars 01110004
ggVarExp = '' 01120004
do ggVarExpIx = 1 to words(ggVarExpVars) 01130004
ggVarExp1 = word(ggVarExpVars, ggVarExpIx) 01140004
ggVarExp = ggVarExp ggVarExp1':' value(ggVarExp1) 01150004
end 01160004
return ggVarExp 01170004
/* 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 = '' & ^ abbrev(disp, 'SYSO') then
return 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 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
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CSMV2) cre=2008-04-01 mod=2008-04-04-18.11.30 F540769 ---
/* rexx */ 00010000
if 1 then
call xmitWsl
if 0 then
call cloneWsl
exit
cloneWsl: procedure expose m.
CALL READdsn 'DSN.ZGL.MAI.DBOF.JCL(LISTNEU)', l.
call readDsn '~Wk.JCL(DBACLONW)', w.
do wx=1 by 1 to 50
if word(w.wx, 2) ^== '=' then
iterate
if word(w.wx, 1) = 'SRCWSLST' then
wSrcX = wx
else if word(w.wx, 1) = 'CLNWSLST' then
wClnX = wx
end
if symbol('wSrcX') ^== 'VAR' then
call err 'srcWsLst' not found
if symbol('wClnX') ^== 'VAR' then
call err 'clnWsLst' not found
iral = dsnAlloc('SYSOUT(T) dd(ir) .WRITER(INTRDR)')
do lx=1 to l.0
w = word(l.lx ,1)
if abbrev(w, '*') then
iterate
if length(w) <> 8 then
call err 'wsl bad length' w
q = left(w, 7)'Q'
w.wSrcX = left(w.wsrcX, pos('=', w.wSrcX)) q','
w.wClnX = left(w.wClnX, pos('=', w.wClnX)) w','
call writeDD 'IR', w.
end
call writeDDend 'IR'
interpret subword(irAl, 2)
return
endProcedure xmitWsl
xmitWsl: procedure expose m.
dst = RZ4
cl = 'DSN.DBA.CLON.WSL'
iffL = 'DSN.DBA.'
iffR = '.IFF'
CALL READdsn 'DSN.ZGL.MAI.DBOF.JCL(LISTCHG)', l.
do lx=1 to l.0
w = word(l.lx ,1)
w = XB03007C
if abbrev(w, '*') then
iterate
if length(w) <> 8 then
call err 'wsl bad length' w
q = left(w, 7)'Q'
i = iffL || q || iffR
c = cl'('q')'
say w cl'('q')' i
if sysDsn("'"c"'") =='OK' then
call csmCopyTx c, dst, c
else
say '***' w c sysDsn("'"c"'")
if sysDsn("'"i"'") =='OK' then
call csmCopyTx i, dst, i
else
say '***' w i sysDsn("'"i"'")
leave
end
return
endProcedure xmitWsl
system = 'RZ2' 00020001
exec= 'A540769.WK.REXX' 00030001
00040001
parse arg fun rest 00050001
say 'csmV2' fun rest 00060001
if fun ^== 'CSMSTARTED' then do 00070001
if 0 then do 00080004
say 'executing copy' 00090004
address Tso "CSMAPPC Start Pgm(CSMEXEC) ", 00100004
"Parm(""Select tsocmd('", 00110004
"%CSRXUTIL COPY WK.REXX(CSMXUTIL) TO RZ2/WK.REZZZ')"")" 00120004
say 'copy rc' rc 00130004
end 00140004
say 'executing start csmexec' 00150004
call adrCsm "select tsoCmd('%CSMV2 CSMSTARTED" fun rest"')" 00160004
say 'returned from start csmexec' 00190001
exit 00200001
call adrTso "CSMAPPC Start Pgm(CSMEXEC) ", 00160004
"Parm(""Select Tsocmd('EXEC ''"exec"(CSMV2)'' ''CSMSTARTED" , 00170001
fun rest"''')"")" 00180001
say 'returned from start csmexec' 00190001
exit 00200001
end 00210001
say 'csm started' rest 00220001
if 0 then do 00230004
'%CSRXUTIL COPY WK.REXX(CSMXUTIL) TO RZ2/WK.REZZZ' 00240004
say 'rc csrxutil' rc 00250004
"csmexec DSLIST DSNMASK('A540769.WK.**') system(*)" 00260004
end 00270004
if 0 then do 00280004
say 'dslist rc' rc 00290004
say stemsize 00300004
say dsname.1 dsname.10 00310004
say recfm.0 recfm.1 00320004
say lrecl.0 lrecl.1 00330004
end 00340004
if 0 then do 00350004
address tso 'free dd(copyFr copyTo)' 00360004
dsnFr = 'A540769.wk.rexx' 00370004
dsnTo = 'A540769.tmp.aaa' 00380004
call adrTso "alloc dd(copyFr) shr dsn('"dsnFr"')" 00390004
rc = listDsi("copyFr FILE SMSINFO") 00400004
say 'listDsi rc' rc 'for' w sysdsname 00410004
if rc ^= 0 then 00420004
say varExp('sysReason sysMsgLvl1 sysMsgLvl2') 00430004
say varExp('sysLRecL sysBlkSize sysKeyLen') 00440004
say varExp('sysUnit sysTrksCyl sysBlksTrk sysUnits sysUsed') 00450004
say varExp('sysMgmtClass') 00460004
if right(sysDsSms, 7) == 'LIBRARY' | abbrev(sysDsSms, 'PDS') then 00470004
al = 'DSNTYPE(LIBRARY)' 00480004
else 00490004
al = '' 00500004
al = "SYSTEM(RZ2) DDNAME(COPYTo)", 00510004
"DATASET('"dsnTo"') DISP(CAT) DSORG("sysDSorg")", 00520004
"MGMTCLAS("sysMgmtClass")", 00530004
"RECFM("sysREcFM") LRECL("SYSLRECL") blksize("sysBLkSIZE")", 00540004
al "SPACE("sysPrimary"," sysSeconds")" sysUnits 00550004
say al 00560004
address tso "csmexec allocate" al 00570004
say 'alloc rc' rc 00580004
address tso "csmexec COPY inDD(copyFr) outDD(copyTo)" , 00590004
"member(CSMV2)" 00600004
say 'copy rc' rc 00610004
address tso 'free dd(copyFr copyTo)' 00620004
end 00630004
if 0 then do 00640004
call csmCopyTo 'A540769.WK.REXX(CSMV2)', rz2, 'A540769.tmp.aaa(ef)' 00650004
end 00660004
if 1 then do 00640004
call csmCopyTx 'A540769.WK.REXX(CSMV2)', rz8,
, 'A540769.tmp.aaa(CSMV2)'
end 00660004
if 1 then do 00640004
call csmCopyTx 'DSN.DBA.CK01008N.IFF', rz8, 'A540769.tmp.IFFck' 00650004
end 00660004
exit 00670001
00680004
adrCsm: 00690004
return adrTso('csmExec' arg(1), arg(2)) 00700004
endProcedure adrCsm 00710004
00720004
csmCopyTo: procedure expose m. 00730004
parse arg dsnFr, sysTo, dsnTo 00740004
mbrFr = dsnGetMbr(dsnFr) 00750004
dsnFr = dsnSetMbr(dsnFr) 00760004
mbrTo = dsnGetMbr(dsnTo) 00770004
dsnTo = dsnSetMbr(dsnTo) 00780004
say 'fr' dsnFr mbrFr 'to' sysTo dsnTo mbrTo 00790004
call adrTso "alloc dd(copyFr) shr dsn('"dsnFr"')" 00800004
al = "SYSTEM("sysTo") DDNAME(COPYTo)", 00810004
"DATASET('"dsnTo"') DISP(OLD)" 00820004
if adrCsm("allocate" al, '*') ^= 0 then do 00830004
say 'could not allocate' al 00840004
say 'trying to create' al 00850004
rc = listDsi("copyFr FILE SMSINFO") 00860004
if rc ^= 0 then 00870004
call err 'listDsi rc' rc 'reason' sysReason, 00880004
sysMsgLvl1 sysMsgLvl2 00890004
al = left(al, length(al)-4)'CAT)' 00900004
if right(sysDsSms, 7) == 'LIBRARY' , 00910004
| abbrev(sysDsSms, 'PDS') then 00920004
al = al 'DSNTYPE(LIBRARY)' 00930004
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")", 00940004
"RECFM("sysREcFM") LRECL("SYSLRECL") blksize("sysBLkSIZE")",00950004
"SPACE("sysPrimary"," sysSeconds")" sysUnits 00960004
say al 00970004
call adrCsm "allocate" al 00980004
end 00990004
cs = "COPY inDD(copyFr) outDD(copyTo)" 01000004
if mbrFr <> '' then 01010004
cs = cs 'MEMBER('mbrFr')' 01020004
if mbrTo <> '' then 01030004
cs = cs 'NEWNAME('mbrTo')' 01040004
call adrCsm cs 01050004
call adrTso 'free dd(copyFr copyTo)', '*' 01060004
return 01070004
endProcedure csmCopyTo 01080004
01090004
csmCopyTx: procedure expose m. 00730004
parse arg dsnFr, sysTo, dsnTo 00740004
pdsTo = dsnSetMbr(dsnTo) 00780004
if dsnGetMbr(dsnTo) ^= '' ,
& dsnGetMbr(dsnFr) <> dsnGetMbr(dsnTo) then
call err 'member rename' dsnFr 'to' sysTo'/'dsnTo
al = "SYSTEM("sysTo") DDNAME(COPYTo)", 00810004
"DATASET('"pdsTo"') DISP(SHR)" 00820004
if adrCsm("allocate" al, '*') ^= 0 then do 00830004
/* wir müssen es selbst allozieren csmxUtil
vergisst management class ||||| */
say 'could not allocate' al 00840004
say 'trying to create' 00850004
rc = listDsi("'"dsnSetMbr(dsnFr)"' SMSINFO") 00860004
if rc ^= 0 then 00870004
call err 'listDsi rc' rc 'reason' sysReason, 00880004
sysMsgLvl1 sysMsgLvl2 00890004
al = left(al, length(al)-4)'CAT)' 0090
if right(sysDsSms, 7) == 'LIBRARY' , 0091
| abbrev(sysDsSms, 'PDS') then 0092
al = al 'DSNTYPE(LIBRARY)' 0093
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")", 0094
"RECFM("sysREcFM") LRECL("SYSLRECL") blksize("sysBLkSIZE")",0095
"SPACE("sysPrimary"," sysSeconds")" sysUnits 0096
say al 0097
call adrCsm "allocate" al 0098
end 0099
call adrTso 'free dd(copyTo)'
call adrTso "exec 'CSM.DIV.P0.EXEC(CSRXUTIL)'",
"'COPY ''"dsnFr"'' TO "sysTo"/''"pdsTo"'' REPLACE'"
return 01070004
endProcedure csmCopyTx 01080004
01090004
varExp: 01100004
parse arg ggVarExpVars 01110004
ggVarExp = '' 01120004
do ggVarExpIx = 1 to words(ggVarExpVars) 01130004
ggVarExp1 = word(ggVarExpVars, ggVarExpIx) 01140004
ggVarExp = ggVarExp ggVarExp1':' value(ggVarExp1) 01150004
end 01160004
return ggVarExp 01170004
/* 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 = '' & ^ abbrev(disp, 'SYSO') then
return 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 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
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(CSMXUTIL) cre=2008-04-01 mod=2008-04-01-12.26.02 F540769 ---
/* rexx */ 00010000
parse arg a 00020000
if a = '' then 00030000
a = wk 00040000
address tso "exec 'CSM.DIV.P0.EXEC(CSRXUTIL)'", 00050000
"'COPY WK.REXX(CSMXUTIL) TO RZ2/WK.REYYY'" 00060000
exit 00070000
}¢--- A540769.WK.REXX.O08(DBACHECK) cre=2007-01-29 mod=2008-11-13-13.12.38 F540769 ---
/* rexx ****************************************************************
synopsis: DBACHECK
edit macro to enforce CS defaults for DB2:
createTablespace createIndex
stoGroup GSMS stoGroup GSMS
priQty -1 priQty -1
secQty -1 secQty -1
compress YES copy NO
segSize 64 falls nicht part or LOB
dssize 32G falls partitioniert
large entfernen
************************************************************************
13.11.2008 w. keller kein Absturz auf leerem input
end of help */ /*
25.09.2008 w. keller geht auch für CDL und PartitonenAttribute
26.06.2008 w. keller scanner geht über recordGrenzen
26.06.2008 w. keller create auf last Line und - 1 gehen jetzt
11.12.2007 w. keller dsSize 32G
26.11.2007 w. keller priqty/secQty immer auf -1
24.09.2007 w. keller priqty/secQty < 1 auf -1 übersetzen
13.07.2007 w. keller remove large option in create tablespace
09.02.2007 w. keller remove // dd * lines if first line is not jcl
07.02.2007 w. keller dssize
05.02.2007 w. keller neu erstellt
toDo & Ideas
load data auf resume no replace umstellen, wegen RTS?
bekommt edit error, wenn letztes Zeile mit ; --> testCase
***********************************************************************/
parse arg args
call errReset 'h'
if pos('?', args) > 0 then
exit help()
call adrIsp 'control errors return'
if args = '' then
if adrEdit('macro (args)', '*') <> 0 then
exit errHelp('please run as edit macro')
call adrEdit "(cn) = linenum .zl", 4
if cn < 1 then
exit 0
/* call adrEdit 'setUndo on' nützt nicht, initMacro kann
nicht undo't werden ... */
m.debug = 0 /* debug output */
m.cdl = isCdl()
call debug 'isCdl' m.cdl
call jIni
call overrideTree mapReset(os, 'k')
if m.debug then
call overrideTreeShow os
call scanWinIni
call editReadIni
call editReadReset oMutate(er, 'EditRead'), 1
call scanSqlReset oMutate(es, 'ScanWin'), er
if m.cdl then
call scanWinOpts es, 5, 2, 9, 72
lx = 0
m.an.0 = 0
/* jedes create suchen und analysieren -> an */
do forever
lx = seekId(es, lx+1, 'CREATE')
call debug 'seek found CREATE at' lx scanPos(es)
if lx < 1 then
leave
call analyseCreate es, os, an
end
if m.debug then
call anaShow an
m.wr.0 = 0
/* overrides und adds bestimmen -> wr */
call override an, wr
if m.debug then
do y=1 to m.wr.0
w = wr'.'y
say 'over' m.w.fPos '-' m.w.tPos '=' m.w
end
oCnt = m.wr.0
ddSt = findDDStar(0)
say oCnt 'overrides and' ddSt '//DD*'
if (oCnt + ddSt) <= 0 then
exit 0
if args ^= 'dbaMulti' then do
call applyOverrides wr /* apply to edited file */
if ddSt > 0 then
call findDDStar 1
exit 0
end
do forever /* Benutzer muss entscheiden */
say 'bitte wählen Sie'
say ' m = multiClone ohne overrides'
say ' o = override Werte, save und end'
say ' e = edit override Werte'
say ' f = edit ohne override'
parse upper pull w
w = left(strip(w), 1)
if w = 'M' then
exit 0
if w == 'O' | w == 'E' then do
call applyOverrides wr /* apply to edited file */
if ddSt > 0 then
call findDDStar 1
end
if w == 'O' then do
call adrEdit 'SAVE'
call adrEdit 'END'
end
if pos(w, 'OEF') > 0 then
exit 4
say 'ungültige Antwort' w
end
exit
isCdl: procedure expose m.
parse arg lx
if lx = '' then do
if isCdl(1) then
return 1
if isCdl('CREATE') then
return 1
if isCdl('DROP') then
return 1
return 0
end
if ^ datatype(lx, 'n') then do
if adrEdit("seek" lx "word first", 4) = 4 then
return 0
call adrEdit "(lx) = cursor"
end
call adrEdit '(ll) = line' lx
if left(ll, 8) = 'SQLID' then
return subword(ll, 2, 2) = 'SET CURRENT'
if left(ll, 8) = 'CREATE' then
return wordPos(word(ll, 2), 'CREATE ALTER ADMIN --#SET') > 0
if left(ll, 8) = 'ALTER' then
return wordPos(word(ll, 2), 'CREATE ALTER ADMIN --#SET') > 0
if left(ll, 8) = 'DROP' then
return wordPos(word(ll, 2), 'DROP ADMIN --#SET') > 0
return 0
endProcedure isCdl
seekId: procedure expose m.
parse arg es, lx, id
if ^ m.cdl then
return scanSqlSeekId(es, lx, id)
do forever
lx = scanSqlSeekId(es, lx, id, 'WORD 9 80')
call debug 'seek found CREATE at' lx scanPos(es)
if lx < 1 then
return lx
call adrEdit '(ll) = line' lx
if word(left(ll, 8), 1) = 'CREATE' then
return lx
end
endProcedure seekId
/*--- we define the scan structure and overrides
in a tree ---------------------------------------------------*/
overrideTree: procedure expose m.
parse arg rt
ts = overrideTreeNd(rt, 'TABLESPACE', 'TS')
us = overrideTreeNd(ts, 'USING', 'US')
sg = overrideTreeNd(us, 'STOGROUP', 'SG', 'i GSMS')
c = overrideTreeNd(sg, 'PRIQTY', 'PQ', 'n -1')
c = overrideTreeNd(sg, 'SECQTY', 'SQ', 'n -1' , PQ)
c = overrideTreeNd(ts, 'SEGSIZE', 'SE', 'n 64')
c = overrideTreeNd(ts, 'DSSIZE', 'DS', 'G 32 G')
c = overrideTreeNd(ts, 'NUMPARTS', 'PA', 'n')
co = overrideTreeNd(ts, 'COMPRESS', 'CR', 'i YES')
br = overrideTreeNd(ts, '(', '(')
c = overrideTreeNd(br, 'PARTITION', 'PR?', 'n')
call mapAdd c, 'USING', us
call mapAdd c, 'COMPRESS', co
call mapAdd br, 'PART', c
ix = overrideTreeNd(rt, 'INDEX', 'IX')
call mapAdd ix, 'USING', us
c = overrideTreeNd(ix, 'COPY', 'CY', 'i NO')
br = overrideTreeNd(ix, '(', '(')
c = overrideTreeNd(br, 'PARTITION', 'PR?', 'n')
call mapAdd c, 'USING', us
call mapAdd br, 'PART', c
return
endProcedure overrideTree
/*--- create a node in the overrideTree with
pa=parent, scan=token, ident,
over=data type and override value, ty=id of type node ------*/
overrideTreeNd: procedure expose m.
parse arg pa, scan, ident, over, ty
ch = mapReset(pa'.'ident, 'k')
call mapAdd pa, scan, ch
m.ch.id = ident
m.ch.att = scan
m.ch.dataType = word(over, 1)
m.ch.overVal = subword(over, 2)
if ty ^== '' then
m.ch.overType = ty
else
m.ch.overType = ident
return ch
endProcedure overrideTreeNd
/*--- show the override tree -----------------------------------------*/
overrideTreeShow: procedure expose m.
parse arg pa, pr
ks = mapKeys(pa)
do kx = 1 to m.ks.0
ch = mapGet(pa, m.ks.kx)
say left(pr m.ks.kx, 20) right(ch, 2) ,
'over' m.ch.overVal 'type' m.ch.overType
call overrideTreeShow ch, pr' '
end
return
endProcedure overrideTreeShow
/*--- analyse a create statement -------------------------------------*/
analyseCreate: procedure expose m.
parse arg m, os, an
if m.m.val ^== 'CREATE' then
call scanErr m, 'analyseCreate but token' m.m.val 'not CREATE'
fp = scanPos(m)
if ^ scanSqlId(m) then
call scanErr m, 'no id'
subTyp = ''
do while wordPos(m.m.val, 'LARGE LOB UNIQUE WHERE') > 0
subTyp = strip(subTyp m.m.val)
if m.m.val = 'WHERE' then do
call checkIds m, 'NOT', 'NULL'
subTyp = subTyp 'NOT NULL'
end
if ^ scanSqlId(scanSkip(m)) then
call scanErr m, 'no id'
end
typ = m.m.val
if ^ mapHasKey(os, typ) then do
call scanSqlQuId scanSkip(m)
call debug 'analyseCreate skipping' subTyp typ 'name' m.m.val
return
end
nP = scanPos(m)
if ^ scanSqlQuId(scanSkip(m)) then
call scanErr 'name missing for create' subtyp typ
na = m.m.val
on = ''
if typ = 'TABLESPACE' then do
call checkIds m, 'IN'
if ^ scanSqlId(scanSkip(m)) then
call scanErr m 'dbName expected'
na = m.m.val'.'na
end
else if typ = 'INDEX' then do
/* wir muessen ueber die Column List scannen,
damit wir sie nicht mit der PartitionListe verwechseln*/
if ^ (scanSqlId(m) & m.m.val = 'ON') then
call scanErr m, 'ON expected after index' na
if ^ scanSqlQuId(scanSkip(m)) then
call scanErr m, 'table name expected'
on = 'on' m.m.val
if ^ scanSqlType(m) & m.m.sqlType = '(' then
call scanErr m, '( .. expected'
call scanSqlSkipBrackets m, 1
end
say left('analyse', 8) leftl(na, 17) strip(subtyp typ) on
a = mapReset(mAdd(an, mapGet(os, typ)), 'k')
m.a.name = na
m.a.subType = subTyp
m.a.fPos = fP
m.a.nPos = nP
call analyseNode m, a
tP = scanPos(m)
if m.m.sqlType = ';' then
tP = word(tP, 1) word(tP, 2) - 1
m.a.tPos = tP
return
endProcedure analyseCreate
/*--- analyse the substatement at scanner sc,
according to the description in node nd.1 -----------------*/
analyseNode: procedure expose m.
parse arg sc, nd.1, stopper
top = 1 /* top of node stack */
do while scanSqlType(sc) & pos(m.sc.sqlType, ';'stopper) < 1
if m.sc.sqlType = 'i' then
att = m.sc.val
else if pos(m.sc.sqlType, '()') > 0 then
att = m.sc.sqlType
else
iterate
do ox=top by -1 to 1 /* search id in all nodes in stack */
nd = nd.ox
os = m.nd
if mapHasKey(os, att) then
leave
end
if ox < 1 then do
if att == '(' then
call scanSqlSkipBrackets sc, 1
iterate
end
osNx = mapGet(os, att) /* the os node */
chfPos = scanPos(sc)
ty = m.osNx.dataType
if ty ^== '' then do /* scan the value of the attribute */
if ty = 'i' then
res = scanSqlId(sc)
else if ty = 'n' then
res = scanSqlNum(sc)
else if ty = 'G' then
res = scanSqlNumUnit(sc, 'G M K')
else
call err 'overwrite type' ty 'not supported'
if ^ res then
call scanErr sc, ty 'value expected after' att
res = m.sc.val
end
chId = m.osNx.id
if right(chId, 1) = '?' then
chId = chId || res
ch = mapReset(nd.ox'.'chId, 'k') /* the new analysis node*/
m.ch.fPos = chfPos
m.ch.tPos = scanPos(sc)
if ty ^== '' then
m.ch.val = res
call mapAdd nd.ox, chId, osNx
if att = '(' then do
top = ox
call analyseNode sc, ch, ')'
if m.sc.sqlType ^== ')' then
call scanErr sc, 'closing ) expected'
iterate
end
top = ox+1 /* pop higher nodes and push new one */
nd.top = ch
end
return
endProcedure analyseNode
/*--- show the the root analysises in stem a -------------------------*/
anaShow: procedure expose m.
parse arg a
do x=1 to m.a.0
call anaShow1 a'.' || x
end
return
/*--- show the analysis node a and its subnodes ----------------------*/
anaShow1: procedure expose m.
parse arg a
os = m.a
say a '->' os
if ^ abbrev(os, 'OS.') then
return
say ' val' m.a.val 'fr' m.a.fPos 'to' m.a.tPos
if wordPos(m.os.id, 'TS IX') > 0 then
say ' name' m.a.name '@' m.a.nPos
ks = mapKeys(a)
do kx = 1 to m.ks.0
call anaShow1 a'.'m.ks.kx
end
return
/*--- generate the override for all anaysis root nodes ---------------*/
override: procedure expose m.
parse arg an, wr
do ax=1 to m.an.0
call overrideNode an'.'ax, an'.'ax, wr
end
return
endProcedure override
/*--- create the necessary overrides for node rt and it's subnodes ---*/
overrideNode: procedure expose m.
parse arg rt, an, wr
os = m.an
if m.os.overVal <> '' & m.os.overVal <> m.an.val then
call overrideAtt rt, an, os, wr
if m.os.overType = 'TS' then do
wx = wordPos('LARGE', m.an.subType)
if wx > 0 then do
o = m.an.subType
n = subWord(o, 1, wx-1) subWord(o, wx+1)
call overrideOne wr, n 'TABLESPACE', m.an.fPos, m.an.nPos
call overrideSay 'override', rt, 'subType', n, o
end
end
ids = ''
keys = mapKeys(an)
do ax=1 to m.keys.0
nd = an'.'m.keys.ax
o1 = m.nd
ids = ids m.o1.id
call overrideNode rt, nd, wr
end
keys = mapKeys(os)
do ox=1 to m.keys.0
nd = mapGet(os, m.keys.ox)
if wordPos(m.nd.id, ids) < 1 then
call overrideAdd rt, an, nd, wr
end
return
endProcedure overrideNode
/*--- add to wr the override attribute osprefixed by tokens in scPa
for analysis node an with root rt pre ----------------------*/
overrideAdd: procedure expose m.
parse arg rt, an, os, wr, scPa
scPa = strip(scPa m.os.att)
if pos('?', os an) > 0 then
return
if m.os.overVal ^== '' then do
ty = m.os.overType
if ty = 'SE' then
if mapHasKey(rt, 'PA') | pos('LOB', m.rt.subType) > 0 then
ty = ''
if ty = 'DS' then
if ^mapHasKey(rt, 'PA') | pos('LOB', m.rt.subType) > 0 then
ty = ''
if ty <> '' then do
call overrideOne wr, scPa m.os.overVal,
, m.an.tPos, m.an.tPos
call overrideSay 'add', rt, scPa, m.os.overVal
scPa = ''
end
else
call debug 'no overrideAdd' scPa
end
keys = mapKeys(os)
do ox=1 to m.keys.0
call overrideAdd rt, an, mapGet(os, m.keys.ox), wr, scPa
end
return
endProcedure overrideAdd
/*--- override an attribute of cp with overrideNode on ---------------*/
overrideAtt: procedure expose m.
parse arg rt, an, os, wr
o = mAdd(wr, m.os.overVal)
m.o.fPos = m.an.fPos
m.o.tPos = m.an.tPos
call overrideSay 'override', rt, m.os.att, m.os.overVal, m.an.val' '
return
endProcedure overrideAtt
/*--- create on override node an add it ------------------------------*/
overrideOne: procedure expose m.
parse arg wr, new, fp, tp
o = mAdd(wr, new)
m.o.fPos = fp
m.o.tPos = tp
return
endProcedure overrideOne
/*--- say what we want to override -----------------------------------*/
overrideSay: procedure expose m.
parse arg f, rt, att, new, old
m = left(f, 8) leftl(m.rt.name, 17) leftl(att, 8) leftl(new, 8)
if old ^== '' then
m = m 'from' old
say m
return
endProcedure overrideSay
/*--- edit a sequence of overrides into data -------------------------*/
applyOverrides: procedure expose m.
parse arg wr
call adrEdit "(w) = linenum .zl"
w = max(w, m.wr.0) + 10
w = length(w)
do x=1 to m.wr.0
m.si.x = right(word(m.wr.x.fPos, 1)+0, w, 0) ,
right(word(m.wr.x.fPos, 2)+0, 3, 0) right(x, w)
end
m.si.0 = m.wr.0
call sort si, so
delta = 0
cx = 1
wx = word(m.so.cx, 3)
do while cx <= m.so.0
lx = word(m.wr.wx.fPos, 1)
line = applyGetLine(lx+delta)
call mAdd mCut(wrk, 0), left(line, word(m.wr.wx.fPos, 2)-1)
lStX = lx
wy = wx
do forever
call app72 wrk, m.wr.wx
cx = cx + 1
if cx > m.so.0 then
leave
wx = word(m.so.cx, 3)
if word(m.wr.wx.fPos, 1) > word(m.wr.wy.tPos, 1) then
leave
else if m.wr.wx.tPos == m.wr.wy.tPos ,
& (m.wr.wx.fPos == m.wr.wy.fPos ,
|m.wr.wx.fPos == m.wr.wx.tPos) then
nop
else if word(m.wr.wx.fPos, 1) <> word(m.wr.wy.tPos, 1) then
call err 'bad sequence in override'
else if word(m.wr.wx.fPos, 2) <= word(m.wr.wy.tPos, 2) then
do
say wy m.wr.wy.tPos
call err 'overlap in override'
end
else do
if lx <> word(m.wr.wx.fPos, 1) then do
lx = word(m.wr.wx.fPos, 1)
line = applyGetLine(lx+delta)
end
px = word(m.wr.wy.tPos, 2)
call app72 wrk, substr(line, px,
, word(m.wr.wx.fPos, 2) - px), px
wy = wx
end
end
if lx <> word(m.wr.wy.tPos, 1) then do
lx = word(m.wr.wy.tPos, 1)
line = applyGetLine(lx+delta)
end
px = word(m.wr.wy.tPos, 2)
call app72 wrk, substr(line, px, 72+1-px), px, 1
do xx = lStx to lx
call adrEdit 'delete' (lStx+delta)
end
delta = delta + lStX - lx - 1
do xx=1 to m.wrk.0
if m.cdl then
li = left(m.applyGetLineMark || m.wrk.xx, 80)
else
li = left(m.wrk.xx, 72)m.applyGetLineMark
call adrEdit "line_after" (lx+delta) "= (li)"
delta = delta + 1
end
end
return
endProcedure applyOverrides
/*--- return the sql portion of line lx
and put the mark field into m.applyGetLineMark -------------*/
applyGetLine: procedure expose m.
parse arg lx
call adrEdit "(line) = line" (lx)
if m.cdl then do
m.applyGetLineMark = left(line, 8)
if m.applyGetLineMark <> 'CREATE' then
call err 'bad applyGetLine mark' m.applyGetLineMark ,
'in line' lx':' strip(line, 't')
return substr(line, 9, 72)
end
else do
m.applyGetLineMark = substr(line, 73, 8)
return left(line, 72)
end
endProcedure applyGetLine
/*--- append to stem st string val, at position miLe
if fix=1 exactly at the position else can shift to right ---*/
app72: procedure expose m.
parse arg st, val, miLe, fix
sx = m.st.0
li = strip(m.st.sx, 't')
if miLe ^== '' then do
vx = verify(val, ' ')
if vx = 0 then
miLe = miLe + length(val)
else
miLe = miLe + vx - 1
end
val = strip(val)
if fix = 1 then do
if length(li)+1 >= miLe then do
sx = sx + 1
li = ''
end
nn = left(li, miLe-1)val
end
else do
if length(li)+1 < miLe then
nn = left(li, miLe-1)val
else if length(li val) < 72 then
nn = li val
else
nn = left(li, 80)val
do while length(nn) >= 72
m.st.sx = left(nn, 72)
sx = sx + 1
nn = substr(nn, 73)
end
end
m.st.sx = nn
m.st.0 = sx
return
endProcedure app72
/*--- scan from scanner m the ids arg(2) ... arg(arg()) --------------*/
checkids: procedure expose m.
parse arg m
do ax=2 to arg()
if ^ scanSqlId(scanSkip(m)) & m.m.val <> translate(arg(ax)) then
call scanErr m, 'sqlId' arg(ax) 'expected'
end
return
endProcedure checkIds
/*--- find the errously genereate // DD * statements ----------------*/
findDDStar: procedure expose m.
parse arg rem
parse arg m, lx, cmd
c = 0
call adrEdit "cursor = 1"
do while adrEdit("seek '//' 1", 4) = 0 /* find each command */
call adrEdit "(lx) = cursor"
call adrEdit "(li) = line" lx
if lx = 1 then do
say 'first line looks like jcl, no search for //DD*'
return 0
end
if space(li, 0) ^== '//DD*' then do
if ^ rem then
say 'ignoring // line' lx strip(li,'t')
end
else do
c = c + 1
if rem then do
call adrEdit 'delete' lx
call adrEdit "cursor =" (lx-1)
end
end
end
return c
endProcedure findDDStar
/*--- fill src with spaces to get at least length len ----------------*/
leftl: procedure
parse arg src, len
if len > length(src) then
return left(src, len)
else
return src
endProcedure leftl
/*--- define reader reading edit data from line lx -------------------*/
editReadIni: procedure expose m.
parse arg m, lx
call oDecMethods oNewClass("EditRead", "JRW"),
, "jRead return editRead(m, var)",
, "jOpen m.m.jReading = 1"
return m
endProcedure editReadReset
/*--- define reader reading edit data from line lx -------------------*/
editReadReset: procedure expose m.
parse arg m, lx
m.m.lineX = lx-1
return m
endProcedure editReadReset
/*--- read next line from edit data ----------------------------------*/
editRead: procedure expose m.
parse arg m, var
m.m.lineX = m.m.lineX + 1
if adrEdit('(ll) = line' m.m.lineX, 12) ^= 0 then
return 0
m.var = ll
return 1
endProcedure editReadRead
/* copy sort begin ****************************************************/
sort: procedure expose m.
parse arg i, o
call sort1 i, 1, m.i.0, o, 1, sort.work, 1
m.o.0 = m.i.0
return
endProcedure sort
sort1: procedure expose m.
parse arg i, i0, le, o, o0, w, w1
if le <= 1 then do
if le = 1 then
m.o.o0 = m.i.i0
return
end
h = (le + 1) % 2
call sort1 i, i0, h, o, o0+le-h, w, w1
call sort1 i, i0+h, le-h, w, w1, o, o0
call sortMerge o, o0+le-h, o0+le, w, w1, w1+le-h, o, o0
return
endProcedure sort1
sortMerge: procedure expose m.
parse arg l, l0, le, r, r0, re, o, o0
do while l0 < le & r0 < re
if m.l.l0 <<= m.r.r0 then do
m.o.o0 = m.l.l0
l0 = l0 + 1
end
else do
m.o.o0 = m.r.r0
r0 = r0 + 1
end
o0 = o0 + 1
end
do while l0 < le
m.o.o0 = m.l.l0
l0 = l0 + 1
o0 = o0 + 1
end
do while r0 < re
m.o.o0 = m.r.r0
r0 = r0 + 1
o0 = o0 + 1
end
return
endProcedure sortWork
/* copy sort end ****************************************************/
/* copy scanSql begin *************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanSql: procedure expose m.
parse arg inRdr
return scanSqlReset(scanWin(inRdr), inRdr)
scanSqlReset: procedure expose m.
parse arg m, rdr, scanWin
if scanWin ^== 0 then
call scanWinReset m, rdr, 5, 2, 1, 72
else
m.m.read = rdr
return scanOpts(m, , '0123456789_' , '--')
scanSqlSeekId: procedure expose m.
parse arg m, lx, cmd, opts
if opts = '' then
opts = word
if adrEdit("cursor =" max(trunc(lx), 1), 12) = 12 then
return -1
do while adrEdit("seek" cmd opts, 4) = 0 /* find each command*/
call adrEdit "(fx) = cursor"
if m.debug then do
call adrEdit "(LI) = LINE" fx
call debug 'scanSqlSeekId after' lx 'found' cmd 'at' fx li
end
call editReadReset m.m.read, fx
call scanWinOpen es, fx
do while word(scanPos(m), 1) <= fx & scanSqlType(m)
if m.m.sqlType = 'i' & m.m.val == cmd then
return fx
end
end
return -1
endProcedure scanSqlSeekId
/*--- scan a sql token put type in m.sqltype:
'i': ordinary identifier e.g. Name
'd': delimited identifier e.g. "Delimited"
'q': qualified identifier e.g. abc."efg"
'u': integer units e.g. 8G
'n': number e.g. -234
's': string e.g. 'abc''ef'
'' : at end
: any other character e.g. ;
----------------------------------------------------------------*/
scanSqlType: procedure expose m.
parse arg m, retSpace
m.m.val = ''
if scanSpaceNl(m) & retSpace = 1 then do
m.m.sqlType = 'b'
return 1
end
if scanString(m, "'") then
m.m.sqlType = 's'
else if scanSqlQuId(m) then do
if m.m.val.0 > 1 then
m.m.sqlType = 'q'
else if abbrev(m.m.tok, '"') then
m.m.sqlType = 'd'
else
m.m.sqlType = 'i'
end
else if scanSqlNum(m, 0, 1) then
m.m.sqlType = 'n'
else if scanChar(m, 1) then
m.m.sqlType = m.m.tok
else if scanAtEnd(m) then do
m.m.sqlType = ''
return 0
end
else
call scanErr m, 'cannot scan sql'
return 1
endProcedure scanSqlType
scanSqlSkipBrackets: procedure expose m.
parse arg m, br
if br ^== '' then
nop
else if scanLit(m, '(') then
br = 1
else
return 0
do while scanSqlType(m) & m.m.sqlType ^== ';'
if m.m.sqlType = '(' then br = br + 1
else if m.m.sqlType ^== ')' then iterate
else if br > 1 then br = br - 1
else return 1
end
call scanErr m, '; or eof, but' br 'closing ) expected'
endProcedure skipBrackets
/*--- scan an ordinary sql identifier e.g. abc, ef_12 ----------------*/
scanSqlId: procedure expose m.
parse arg m
if ^ scanName(m) then
return 0
m.m.val = translate(m.m.tok)
return 1
endProcedure scanSqlId
/*--- scan a delimited or ordinay sql identifier ---------------------*/
scanSqlDeId: procedure expose m.
parse arg m
if scanSqlId(m) then
return 1
if ^ scanString(m, '"') then
return 0
m.m.val = strip(m.m.val, 't')
return 1
endProcedure scanSqlDeId
/*--- scan a qualified sql identifier --------------------------------*/
scanSqlQuId: procedure expose m.
parse arg m
res = ''
do qx=1
if ^ scanSqlDeId(m) then do
if qx <> 1 then
call scanErr m, 'id expected after .'
return 0
end
m.m.val.qx = m.m.val
res = res'.'m.m.val
if ^ scanLit(scanSkip(m), '.') then
leave
call scanSpaceNl m
end
m.m.val.0 = qx
m.m.val = substr(res, 2)
return 1
endProcedure scanSqlQuId
/*--- scan a sql number ----------------------------------------------*/
scanSqlNum: procedure expose m.
parse arg m, checkEnd, noSp
n = ''
if scanLit(m, '+', '-') then do
n = m.m.tok
if noSp <> 1 then
call scanSpaceNl m
end
if scanLit(m, '.') then
n = n'.'
if scanVerify(m, '0123456789') then
n = n || m.m.tok
else if n == '' then
return 0
else if noSp = 1 then do
call scanBack m, n
return 0
end
else
call scanErr m, 'scanSqlNum bad number: no digits after' n
if pos('.', n) < 1 then
if scanLit(m, '.') then do
if scanVerify(m, '0123456789') then
n = n'.'m.m.tok
end
if scanLit(m, 'E', 'e') then do
n = n'E'
if scanLit(m, '+', '-') then
n = n || m.m.tok
if ^ scanVerify(m, '0123456789') then
call scanErr m, 'scanSqlNum bad number: no digits after' n
n = n || m.m.tok
end
if checkEnd ^= 0 then
if pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNum number' n 'bad end' ,
scanLook(m, 1)
m.m.val = n
return 1
endProcedure scanSqlNum
/*--- scan a sql number with a unit which may follow without space ---*/
scanSqlNumUnit: procedure expose m.
parse arg m, both, units
if ^ scanSqlNum(m, 0) then
return 0
nu = m.m.val
sp = scanSpaceNl(m)
if scanSqlId(m) then do
if units == '' | wordpos(m.m.val, units) > 0 then
nu = nu m.m.val
else if both | ^ sp then
call scanErr m, 'scanSqlNumUnit after' nu 'bad unit' m.m.val
else
call scanBack m, m.m.tok
end
else if both then
call scanErr m, 'scanSqlNumUnit no unit after' nu
else if ^sp & pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNumUnit bad number end after' nu
m.m.val = nu
return 1
endProcedure scanSqlNumUnit
/* copy scanSql end *************************************************/
/* copy scanWin begin *************************************************
scan the the concatenation of the lines of a reader
any token my be split over several line
except the end-of-line-comment-token
***********************************************************************/
scanWinIni: procedure expose m.
if m.scanWin.ini = 1 then
return
m.scanWin.ini = 1
call scanIni
call jIni
call oDecMethods oNewClass('ScanWin'),
, 'scanReadNl return scanWinNl(m, unCond)',
, 'scanSpaceNl scanWinSpaceNl(m)',
, 'scanClose call scanWinClose m ',
, 'scanInfo scanWinInfo(m)',
, 'scanPos scanWinPos(m)'
return
endProcedure scanReadIni
/*--- instanciate a new window scanner, open rdr ---------------------*/
scanWin: procedure expose m.
parse arg rdr, wiSz, wiBa, cuPo, cuLe
return scanWinReset(oNew('ScanWin'), rdr, wiSz, wiBa, cuPo, cuLe)
/*--- set the attributes of window scanner m, open rdr and start read*/
scanWinReset: procedure expose m.
parse arg m, rdr, wiSz, wiGa, cuPo, cuLe
call scanReset m
m.m.read = rdr
m.m.atEnd = 'still closed'
return scanWinOpts(m, wiSz, wiGa, cuPo, cuLe)
endProcedure scanWinReset
scanWinOpts: procedure expose m.
parse arg m, wiSz, wiGa, cuPo, cuLe
wiSz = word(wiSz 5, 1)
wiGa = word(wiGa 1, 1)
m.m.cutPos = word(cuPo 1, 1)
m.m.cutLen = word(cuLe 72, 1)
m.m.winTot = (wiSz * 2 + wiGa) * m.m.cutLen
m.m.posLim = (wiSz + wiGa) * m.m.cutLen
m.m.posOff = wiGa * m.m.cutLen
return scanWinOpen(m)
endProcedure scanWinReset
scanWinOpen: procedure expose m.
parse arg m, lx
m.m.atEnd = 0
if lx = '' then
m.m.lineX = 1
else
m.m.lineX = lx
m.m.pos = 1
m.m.src = ''
call jOpen m.m.read, 'r'
call scanWinRead m
return m
endProcedure scanWinOpen
scanWinClose: procedure expsoe m.
m.m.atEnd = 'still closed'
call jClose m.m.read
return
endProcedure scanWinClose
/*--- move the source window: cut left side and append at right side
return number of characters cut at left ------------------------*/
scanWinRead: procedure expose m.
parse arg m
dlt = 0
if m.m.atEnd then
return 0
if m.m.pos >= m.m.posLim then do /* cut left side */
dlt = m.m.pos - (m.m.pos // m.m.cutLen + m.m.posOff)
m.m.src = substr(m.m.src, dlt+1)
m.m.pos = m.m.pos - dlt
m.m.lineX = m.m.lineX + dlt % m.m.cutLen
end
do while length(m.m.src) < m.m.winTot /* read and fill to len */
if ^ jRead(m.m.read, m'.'one) then do
m.m.atEnd = 1
return dlt
end
m.m.src = m.m.src || substr(m.m.one, m.m.cutPos, m.m.cutLen)
end
call assert 'length(m.m.src) = m.m.winTot'
return dlt
endProcedure scanWinRead
/*--- return position of next line start -----------------------------*/
scanWinNLPos: procedure expose m.
parse arg m
return m.m.pos + m.m.cutLen - ((m.m.pos - 1) // m.m.cutLen)
/*--- scan over spaces and comments ----------------------------------*/
scanWinSpaceNL: procedure expose m.
parse arg m
res = 0
do forever
r1 = 0
if scanVerify(m, ' ') then do
r1 = 1
end
else if m.m.scanComment ^== '' ,
& abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
np = scanWinNlPos(m)
r1 = length(m.m.scanComment) <= np - m.m.pos
if r1 then
m.m.pos = np
end
if r1 then
res = 1
else if scanWinRead(m) = 0 then
return res
end
endProcedure scanWinSpaceNl
/*--- return current position in input ------------------------------*/
scanWinPos: procedure expose m.
parse arg m
if scanAtEnd(m) then
return 'E'
else
ps = m.m.pos - 1
return (m.m.lineX + (ps % m.m.cutLen)) (ps // m.m.cutLen + 1)
endProcedure scanWinPos
/*--- return a description of the current scan position --------------*/
scanWinInfo: procedure expose m.
parse arg m
p = scanWinPos(m)
if p == 'E' then do
res = 'atEnd after'
p = m.m.lineX - 1 + length(m.m.src) % m.m.cutLen
end
else do
res = 'pos' word(p, 2) 'in'
p = word(p, 1)
end
return res 'line' p':' strip(substr(m.m.src,
, 1 + (p - m.m.lineX) * m.m.cutLen, m.m.cutLen), 't')
endProcedure scanWinInfo
/* copy scanWin end *************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanRead??(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.m.tok ==> last token
m.m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.m.pos ==> scan position
m.m.src ==> scan source
***********************************************************************/
scanIni: procedure expose m.
if m.scan.ini == 1 then
return
m.scan.ini = 1
m.scan.alfLC = 'abcdefghijklmnopqrstuvwxyz'
m.scan.alfUC = translate(m.scan.alfLC)
m.scan.alfa = m.scan.alfLC || m.scan.alfUC
m.scan.alfNum = m.scan.alfa || '0123456789'
return
endProcedure scanIni
scanReset: procedure expose m.
parse arg m, n1, np, co
m.m.tok = ''
m.m.val = ''
m.m.key = ''
m.m.read = ''
return scanOpts(m, n1, np, co)
endProcedure scanReset
scanOpts: procedure expose m.
parse arg m, m.m.scanName1, namePlus, m.m.scanComment
call scanIni
if m.m.scanName1 == '' then
m.m.scanName1 = m.scan.alfa
if namePlus == '' then
m.m.scanNameR = m.m.scanName1 || '0123456789'
else
m.m.scanNameR = m.m.scanName1 || namePlus
return m
endProcedure scanReset
/*--- begin scanning a single line -----------------------------------*/
scanSrc: procedure expose m.
parse arg m, m.m.src
m.m.atEnd = 1
m.m.pos = 1
return m
endProcedure scanSrc
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
if len == '' then
return substr(m.m.src, m.m.pos)
else
return substr(m.m.src, m.m.pos,
, min(len, 1 + length(m.m.src) - m.m.pos))
endProcedure scanLook
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m
do ax=2 to arg()
if abbrev(substr(m.m.src, m.m.pos), arg(ax)) then do
m.m.tok = arg(ax)
m.m.pos = m.m.pos + length(arg(ax))
return 1
end
end
m.m.tok = ''
return 0
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.m.src)
if len ^= '' then
nx = min(m.m.pos + len, nx)
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanChar
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.m.tok = ''
if qu = '' then do
qu = substr(m.m.src, m.m.pos, 1)
if pos(qu, "'""") < 1 then
return 0
end
else do
if substr(m.m.src, m.m.pos, 1) ^== qu then
return 0
end
bx = m.m.pos
ax = bx + 1
m.m.val = ''
do forever
qx = pos(qu, m.m.src, ax)
if qx < 1 then
return scanErr(m, 'ending Apostroph('qu') missing')
m.m.val = m.m.val || substr(m.m.src, ax, qx-ax)
if qx >= length(m.m.src) then
leave
else if substr(m.m.src, qx+1, 1) <> qu then
leave
ax = qx+2
m.m.val = m.m.val || qu
end
m.m.tok = substr(m.m.src, bx, qx+1-bx)
m.m.pos = qx+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.scanName1, rest in *.scanNameR ----*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.m.src, m.m.pos, 1),
, m.m.scanName1) <= 0 then do
m.m.tok = ''
return 0
end
return scanVerify(m, m.m.scanNameR)
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.m.src, alpha, , m.m.pos)
else
nx = verify(m.m.src, alpha, vOpt, m.m.pos)
if nx = 0 then
nx = length(m.m.src) + 1
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
scanNat: procedure expose m.
parse arg m, chEn
if ^ scanVerify(m, '0123456789') then
return 0
if chEn^==0 & pos(substr(m.m.src, m.m.pos,1), m.m.scanNameR)>0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
scanInt: procedure expose m.
parse arg m, chEn
if scanNat(m, chEn) then
return 1
ox = m.scan.m.pos
if pos(substr(m.scan.m.src, ox, 1) , '+-') < 1 then
return 0
m.scan.m.pos = ox + 1
if | scanNat(m) then do
m.scan.m.pos = ox
return 0
end
m.tok =substr(m.scan.m.src, ox, 1)|| m.tok
return 1
endProcedure scanInt
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m) then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.m.val = m.m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.m.pos - length(tok)
if substr(m.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.m.key = m.m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.m.val = def
m.m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.m.key '=')
return 1
endProcedure scanKeyValue
scanAtEnd: procedure expose m.
parse arg m
return m.m.atEnd & m.m.pos > length(m.m.src)
endProcedure scanAtEnd
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.m.tok
if m.m.read ^== '' then
interpret 'res = ' oObjMethod(m, 'scanSpaceNl')
else
res = scanSpaceCom(m)
m.m.tok = lastTok
return res
endProcedure scanSpaceNL
scanSpaceCom: procedure expose m.
parse arg m
res = scanVerify(m, ' ')
if m.m.scanComment ^== '' then
if abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
m.m.pos = 1 + length(m.m.src)
return 1
end
return res
endProcedure scanSpaceCom
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
m.m.err.0 = 0
call err 'scanErr' txt'\n'scanInfo(m, m'.ERR')
return 0
endProcedure scanErr
scanPos: procedure expose m.
parse arg m
if m.m.read ^== '' then
interpret 'return' oObjMethod(m, 'scanPos')
else if scanAtEnd(m) then
return E
else
return 1 m.m.pos
endProcedure scanPos
scanInfo: procedure expose m.
parse arg m
msg = 'last token' m.m.tok 'scanPosition' ,
strip(left(substr(m.m.src, m.m.pos), 40), 't')
if m.m.read == '' then
return msg'\npos' m.m.Pos 'in string' strip(m.m.src, 't')
else
interpret 'return msg"\n" ||' oObjMethod(m, 'scanInfo')
endProcedure scanInfo
/* copy scan end ****************************************************/
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jRead: procedure expose m.
parse arg m, var
if m.m.jReading then
interpret oObjMethod(m, 'jRead')
else
call err 'jRead('m',' var') but not opened r'
else
endProcedure jRead
jWrite: procedure expose m.
parse arg m, line
if m.m.jWriting then
interpret oObjMethod(m, 'jWrite')
else
call err 'jWrite('m',' line') but not opened w'
return
endProcedure jWrite
jWriteAll: procedure expose m.
parse arg m, opt, rdr
interpret oObjMethod(m, 'jWriteAll')
return
endProcedure jWriteAll
jWriteAllImpl: procedure expose m.
parse arg m, opt, rdr
if pos('-', opt) < 1 then
call jOpen rdr, catOpt(opt)
do while jRead(rdr, line)
call jWrite m, m.line
end
if pos('-', opt) < 1 then
call jClose rdr
return
endProcedure jWriteAll
jReset: procedure expose m.
parse arg m, arg
call jClose m
interpret oObjMethod(m, 'jReset')
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret oObjMethod(m, 'jOpen')
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
if m.m.jReading = 1 | m.m.jWriting = 1 then
interpret oObjMethod(m, 'jClose')
m.m.jReading = 0
m.m.jWriting = 0
return m
endProcedure jClose
/*--- analyze an option in oOpt and oVal -----------------------------*/
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jIni: procedure expose m.
if m.j.ini == 1 then
return
m.j.ini = 1
call oIni
call oDecMethods oNewClass("JRW"),
, "jRead call err 'jRead('m',' var') but not opened r'",
, "jWrite call err 'jWrite('m',' line') but not opened w'",
, "jWriteAll call jWriteAllImpl m, opt, rdr",
, "jRead drop m.arg; return 0",
, "jWrite say 'jOut:' line",
, "jReset ;",
, "jOpen ;",
, "jClose ;"
x = oNew("JRW")
m.j.jIn = x
m.x.jReading = 1
m.x.jWriting = 0
x = oNew("JRW")
m.j.jOut = x
m.x.jReading = 0
m.x.jWriting = 1
call oDecMethods oNewClass("Jbuf", "JRW"),
, "jOpen return jBufOpen(m, arg)",
, "jReset return jBufReset(m, arg)",
, "oSetTypePara call jBufSetTypePara m, type",
, "jRead return jBufRead(m, var)",
, "jWrite call jBufWrite m, line"
return
endProcedure jInit
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
/*--- jBuf: buffer read or write (supports datataypes) ---------------*/
jBuf: procedure expose m.
m = oNew('Jbuf')
call jBufReset m
do ax=1 to arg()
m.m.buf.ax = arg(ax)
end
m.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
m.m.stem = m'.BUF'
m.m.buf.0 = 0
call oSetTypePara m
do ax=1 to arg() - 1
m.m.buf.ax = arg(ax+1)
m.m.buf.0 = ax
end
return m
endProcedure jBufReset
jBufSetTypePara: procedure expose m.
parse arg m, type
if m.m.buf.0 <> 0 then
call err 'jBufSetTypePara but not empty'
return
endProcedure jBufSetTypePara
jBufOpen: procedure expose m.
parse arg m, opt
call jClose m
if opt == 'r' then do
m.m.readIx = 0
m.m.jReading = 1
return m
end
if opt == 'w' then
m.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
m.m.jWriting = 1
return m
endProcedure jBufOpen
jBufRead: procedure expose m.
parse arg m, var
nx = m.m.readIx + 1
if nx > m.m.buf.0 then
return 0
m.m.readIx = nx
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.var = m.m.buf.nx
else
call oTyCopy ty, var, m'.BUF.'nx
return 1
endProcedure jBufRead
jBufWrite: procedure expose m.
parse arg m, line
nx = mInc(m'.BUF.0')
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.m.buf.nx = line
else
call oTyCopy ty, m'.BUF.'nx, line
return 1
endProcedure jBufRead
/* copy j end *********************************************************/
/* copy o begin ********************************************************
object layer has three freatures
* an object may have a class which has methods
* an object may have a parmeterized type
* a class may contain field descriptions
***********************************************************************/
oClaMethod: procedure expose m.
parse arg cl, me
if symbol('m.o.cla.cl.met.me') = 'VAR' then
return m.o.cla.cl.met.me
else
call err 'no method' me 'in class' cl
endProcedure oClaMethod
oHasMethod: procedure expose m.
parse arg obj, me
cla = oGetClass(obj)
return symbol('m.o.cla.cl.met.me') = 'VAR'
endProcedure oHasMethod
oGetClass: procedure expose m.
parse arg Obj
if symbol('m.o.obj2cla.Obj') = 'VAR' then
return m.o.obj2cla.Obj
call err 'no class found for object' obj
endProcedure oGetClass
oObjMethod: procedure expose m.
parse arg obj, me
if symbol('m.o.obj2cla.obj') = 'VAR' then
return oClaMethod(m.o.obj2cla.obj, me)
if abbrev(obj, 'oCast:') then do
cx = pos(':', obj, 7)
return 'M="'substr(obj, cx+1)'";' ,
oClaMethod(substr(obj, 7,cx-7), me)
end
call err 'no class found for object' obj
endProcedure oObjMethod
oCast: procedure
parse arg obj, cl
if abbrev(obj, 'oCast:') then
obj = substr(obj, 1 + pos(':', obj, 7))
return 'oCast:'cl':'obj
endProcedure oCast
oNewClass: procedure expose m.
parse arg name, super
/* call oIni */
name = oFldNew(name)
neMe = 'O.CLA.'name'.MET'
neFi = 'O.CLA.'name'.FLD'
do sx=1 to words(super)
sup = word(super, sx)
if symbol('m.o.cla.sup') ^== 'VAR' then
call err 'superclass' sup 'is not defined'
if m.o.cla.sup.val ^== '' then
m.o.cla.name.val = m.o.cla.sup.val
if m.o.cla.sup.stem ^== '' then
m.o.cla.name.stem = m.o.cla.sup.stem
st = 'O.CLA.'sup'.MET'
do x=1 to m.st.0
olMe = m.st.x
call oPut neMe, olMe, m.st.olMe
end
st = 'O.CLA.'sup'.FLD'
do x=1 to m.st.0
olFi = m.st.x
call oPut neFi, olFi, m.st.olFi
end
end
call oMutate 'O.CLA.'name, 'Class'
return name
endProcedure oNewClass
oValStemFldsWKOLD: procedure expose m.
parse arg cl, m.o.cla.cl.val, m.o.cla.cl.stem, flds
st = 'O.CLA.'cl'.FLD'
do wx=1 by 2 to words(flds)
call oPut st, word(flds, wx), word(flds, wx+1)
end
return cl
endProcedure oValStemFlds
oNewTypeWKOLD: procedure expose m.
parse arg cl, va, st, flds
return oValStemFlds(oNewClass(cl), va, st, flds)
/*--- a field type has only fields of type '='
finds or creates a field Type with the fields of types tps
and the field list aFl.
if dup = 'e' duplicate field names are resolved ------------*/
oFiTypeWKOLD: procedure expose m.
parse arg tps, aFl, dup
if symbol('m.o.cla.fiType.tps.aFl.dup') = 'VAR' then
return m.o.cla.fiType.tps.aFl.dup
fs = ''
do wx=1 to words(tps)
t1 = oFlds(word(tps, wx))
do fx=1 to m.t1.0
fs = fs m.t1.fx
end
end
fs = fs aFl
fd = ''
do wx=1 to words(fs)
f1 = word(fs, wx)
if wordPos(f1, fd) < 1 then do
fd = fd f1
end
else if dup == 'e' then do
do dx=2 by 1 while wordPos(f1 || dx, fn fs) > 0
end
fd = fd f1 || dx
end
end
fd = space(fd aFl)
if symbol('m.o.cla.fiType.fd') = 'VAR' then do
res = m.o.cla.fiType.fd
end
else do
res = oNewClass("FiType*")
m.o.cla.fiType.fd = res
st = 'O.CLA.'res'.FLD'
do wx=1 to words(fd)
call oPut st, word(fd, wx), '='
end
end
m.o.cla.fiType.tps.aFl = res
return res
endProcedure oFiType
oDecMethods: procedure expose m.
parse arg cla
st = 'O.CLA.'cla'.MET'
do ax=2 to arg()
call oPut st, word(arg(ax), 1), subWord(arg(ax), 2)
end
return
endProcedure oDecMethods
oNew: procedure expose m.
parse arg cla
st = 'O.CLA.'cla
if symbol('M.st') ^== 'VAR' then
call err 'class' cla 'is not initialized'
nn = m.st.inst + 1
m.st.inst = nn
nn = 'O.C' || m.st || 'I' || nn
if symbol('m.o.obj2cla.nn') == 'VAR' then
call err 'oNew already defined:' nn
m.o.obj2cla.nn = cla
return nn
endProcedure oNew
oMutate: procedure expose m.
parse arg obj, class
if obj == 'O.C13I12' then do
end
if symbol('M.O.CLA.class') ^== 'VAR' then
call err 'class' class 'is not initialized'
m.o.obj2cla.obj = class
return obj
endProcedure oMutate
oSay: procedure expose m.
parse arg type, a, aPr, mPr
ty = 'O.CLA.'type
msg = mPr || substr(a, length(aPr)+1)
redir = 0
do forever
if type == '=' then do
say msg '=' m.a
return
end
else if abbrev(type, '=') then do
a = m.a
msg = msg '==>' a
redir = 1
type = substr(type, 2)
end
else if left(type, 2) = '<>' then do
k = m.a
a = left(a, lastPos('.', a))k
msg = msg '=<>' k
redir = 1
type = substr(type, 3)
end
else if left(type, 1) = '.' then do
if ^ datatype(m.a.0, 'n') then
call err 'type' type 'not stem but m.'a'.0 is' m.a.0
type = substr(type, 2)
if redir then do
say msg 'stem 1..'m.a.0':' type
end
else do
do y=1 to m.a.0
call oSay type, a'.'y, a'.', mPr' '
end
end
return
end
else if redir then do
say msg':' type
return
end
else do
leave
end
end
if m.ty.val = '=' then
say msg '=' m.a
else
say msg '=' m.a':' m.ty.val
/* call oSay m.ty.val, a,==>' m.a '(to' m.ty.val')' */
do y=1 to m.ty.fld.0
f = m.ty.fld.y
call oSay m.ty.fld.f , a'.'f, a'.', mPr' '
end
if m.ty.stem ^== '' then
call oSay '.'m.ty.stem, a, a, mPr
return
endProcedure oSay
oClear: procedure expose m.
parse arg type, a, val
if abbrev(type, '.') then do
m.a.0 = 0
end
else if abbrev(type, '<>') then do
m.a = val
call oClear substr(type, 3), left(a, lastPos('.', a))val, val
end
else if abbrev(type, '=') then do
m.a = ''
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.a = val
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oClear m.ty.fld.k, a'.'k, val
end
if m.ty.stem ^== '' then
call m.a.0 = 0
end
return a
endProcedure oClear
oCopy: procedure expose m.
parse arg t, f
if symbol('m.o.obj2cla.f') ^== 'VAR' then
call err f 'has no class'
cl = m.o.obj2cla.f
m.o.obj2cla.t = m.o.obj2cla.f
return oTyCopy(cl, t, f)
endProcedure oCopy
oTyCopy: procedure expose m.
parse arg type, t, f
if abbrev(type, '.') then do
do y=1 to m.f.0
call oTyCopy substr(type, 2), t'.'y, f'.'y
end
m.t.0 = m.f.0
end
else if abbrev(type, '<>') then do
k = m.f
m.t = k
call oTyCopy substr(type, 3), left(t, lastPos('.', t))k,
, left(f, lastPos('.', f))k
end
else if abbrev(type, '=') then do
m.t = m.f
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.t = m.f
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oTyCopy m.ty.fld.k, t'.'k, f'.'k
end
if m.ty.stem ^== '' then
call oTyCopy '.'m.ty.stem, t, f
end
return t
endProcedure oTyCopy
/*--- Run ------------------------------------------------------------*/
oRunner: procedure expose m.
parse arg code
return oRunnerReset(oNew('ORunner'), code)
oRunnerReset: procedure expose m.
parse arg m, pCode
m.m.code = pCode
return m
endProcedure oRunnerReset
oRun: procedure expose m.
parse arg m
interpret m.m.code
return
endProcedure oRun
oIni: procedure expose m.
if m.o.ini = 1 then
return
m.o.ini = 1
call oFldIni
call mapIni
m.o.paTy.0 = 0
call oFldNew '=', '='
call oDecMethods oNewClass('ORunner'), 'oRun call oRun m'
return
endProcedure oIni
/* copy o end *********************************************************/
/* copy oFld begin *****************************************************
defines classes with field names
is the base for the oo layer in copy o
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
oFldIni: procedure expose m.
if m.oFld.ini = 1 then
return
m.oFld.ini = 1
call mapIni
m.o.fldOnly = mapNew() /* map fields -> class */
m.o.cla.0 = 0 /* the stem for classes */
call oFldNew 'Class', '=', , , /* MetaClass definieren */
'INST = MET .<>= FLD .<>=Class STEM =Class'
return
endProcedure oFldIni
/*--- create a new class
name: name of new class, a star will be replaced by a number
va: type of value
st: type of stem
flds: pairs of field names and types
dup: duplicate resolver -----------------------------------*/
oFldNew: procedure expose m.
parse arg name, va, st, flds, dup
if pos('*', name) > 0 then
name = oPut('O.CLA', name, , '*')
else
call oPut 'O.CLA', name, , 'n'
m.o.cla.name.inst = 0
m.o.cla.name.val = va
m.o.cla.name.stem = st
m.o.cla.name.FLD.0 = 0
m.o.cla.name.MET.0 = 0
return oFldAdd(name, flds, dup)
endProcedure oFldNew
/*--- create or find a class with only simple fields fs --------------*/
oFldOnly: procedure expose m.
parse arg fs, dup
kk = space(fs '?'dup, 1)
if mapHasKey(m.o.fldOnly, kk) then
return mapGet(m.o.fldOnly, kk)
if dup ^== 'e' then do
ll = space(fs, 1)
end
else do
ll = ''
do wx=1 to words(fs)
w = word(fs, wx)
v = w
do x=2 while wordPos(v, ff) > 0
v = w || x
end
ll = space(ll v, 1)
end
end
if mapHasKey(m.o.fldOnly, ll) then do
nn = mapGet(m.o.fldOnly, ll)
end
else do
nn = oFldNew('FldType*')
st = 'O.CLA.'nn'.FLD'
do lx=1 to words(ll)
call oPut st, word(ll, lx), '=', dup
end
call mapPut m.o.fldOnly, ll, nn
end
call mapPut m.o.fldOnly, kk, nn
return nn
endProcedure oFldOnly
/*--- return the stem of flds of class type --------------------------*/
oFlds: procedure expose m.
parse arg type
return 'O.CLA.'type'.FLD'
/*--- return the concatenation of the fields of type ty in stem st
formated by fmt -------------------------------------------*/
oFldCat: procedure expose m.
parse arg ty, st, fmt
flds = oFlds(ty)
res = ''
do ix=1 to m.flds.0
f = m.flds.ix
if fmt == '' then
res = res m.st.f
else
res = res fmt(m.st.f, m.fmt.ix)
end
return substr(res, 2)
endProcedure oFldCat
/*--- add fields to class cl given as name type pairs in fs ----------*/
oFldAdd: procedure expose m.
parse arg cla, fs, dup
st = 'O.CLA.'cla'.FLD'
do ix=1 by 2 to words(fs)
call oPut st, word(fs, ix), word(fs, ix+1), dup
end
return cla
endProcedure oFldAdd
/*--- add/put key k with value v to stem st
duplicate handling dup:
* replace * in k by a number until it is new
e add a number in it is not new
o replace old value at existing key
= add a new key, fail if key exists and value is different
------------------------------------------------------------*/
oPut: procedure expose m.
parse arg st, k, v, dup
if dup = '*' then do
cx = pos('*', k)
if cx < 1 then
call err 'no * in key' k
k = oPutDupResolve(st, left(k, cx-1), 1)
end
else if symbol('m.st.k') = 'VAR' then do
if dup = '' | dup = 'o' then do
m.st.k = v
return k
end
if dup = '=' then do
if v <> m.st.k | ^ (v = '' & datatype(m.st.k, 'n')) then
call err 'not =: m.'st'.'k '=>' m.st.k '<>' v
return k
end
if dup = 'e' then
k = oPutDupResolve(st, k, 2)
else
call err 'key' k 'exists in' st 'but dup' dup
end
else if dup = 'o' then
call err 'old key' k 'does not exist in' st
if datatype(k, 'n') | words(k) <> 1 | pos('.', k) > 0 then
call err 'illegal name' k
x = m.st.0 + 1
m.st.0 = x
m.st.x = k
if v == '' then
m.st.k = x
else
m.st.k = v
return k
endProcedure oPut
oPutDupResolve: procedure expose m.
parse arg st, k, b
do ix=b
a = k || ix
if symbol('m.st.a') <> 'VAR' then
return a
end
endProcedure oPutDupResolve
/*--- parameterized types --------------------------------------------*/
oGetTypePara: procedure expose m.
parse arg m
if symbol('m.o.tyPa.m') == 'VAR' then
return m.o.tyPa.m
else
return '='
endProcedure oGetTypePara
oSetTypePara: procedure expose m.
parse arg m, type, noCall
if type = '' then
type = '='
if oGetTypePara(m) == type then
return
if noCall ^== 'noCall' then
interpret oObjMethod(m, 'oSetTypePara')
m.o.tyPa.m = type
return
endProcedure oSetTypePara
/* copy oFld end ***************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = ''
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
if abbrev(a, 'MAP.') then do
do kx=1 to m.map.loKy.a.0
drop m.map.loKy.a.kx m.map.loVa.a.kx
end
m.map.loKy.a.0 = 0
end
return a
endProcedure mapClear
/*--- return a stem of all keys (including removed ones) -------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
if mapValAdr(a, ky) ^== '' then
call err 'duplicate key in mAdd('a',' ky',' val')'
if length(ky) < 200 then do
m.a.ky = val
end
else do
kx = mInc('MAP.LOKY.'a'.0')
m.map.loKy.a.kx = ky
m.map.loVa.a.kx = val
end
if m.map.keys.a ^== '' then
return mAdd(m.map.keys.a, ky)
return
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky)
if vv ^== '' then
m.vv = val
else
call mapAdd a, ky, val
return val
endProcedure mapPut
/*--- return the value pointer for a key, '' if non existang ---------*/
mapValAdr: procedure expose m.
parse arg a, ky
if length(ky) < 200 then do
if symbol('m.a.ky') == 'VAR' then
return a'.'ky
end
else if ^ abbrev(a, 'MAP.') then do
call err 'key too long mapValAdr('a',' ky')'
end
else do
do kx=1 to m.map.loKy.a.0
if m.map.loKy.a.kx == ky then
return 'MAP.LOVA.'a'.'kx
end
end
return ''
endProcedure mapValAdr
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if abbrev(vv, 'MAP.LOVA.') then
call err 'not implemented mapRemove('a',' ky')'
drop m.a.ky
return val
endProcedure mapRemove
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a,
fail if it does not exist ----------------------------------*/
mapGet: procedure expose m.
parse arg a, ky, noKey
vv = mapValAdr(a, ky)
if vv == '' then
call err 'missing key in mapGet('a',' ky')'
return m.vv
endProcedure mapGet
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m end *********************************************************/
/* 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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
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 expose m.
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 by 1
alRc = adrTso(c rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for' c rest
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
endProcedure tsoAlloc
dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
bl = 32760
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
recfm='f b'
bl = bl - (bl // rl)
end
else do
if rl = '' then
rl = bl-4
recfm = substr(atts, 2, 1) 'B'
end
end
if pos('(', dsn) > 0 then
po = 'dsntype(library) dsorg(po)'
else
po = ''
dsn = dsnSetMbr(dsn)
if forCsm == 1 then
return "dataset('"dsn"')" po,
"recfm("space(recfm, 0)") lrecl("rl") blkSize("bl")" ,
"mgmtclas(s005y000) space(10, 1000) cylinder"
else
return "dsn('"dsn"')" po,
"recfm("recfm") lrecl("rl") block("bl")" ,
"mgmtclas(s005y000) 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
copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
call readDDBegin word(frDD, 1)
call writeDDBegin word(toDD, 1)
cnt = 0
do while readDD(word(frDD, 1), r.)
call writeDD word(toDD, 1), r.
cnt = cnt + r.0
end
call readDDEnd word(frDD, 1)
call writeDDEnd word(toDD, 1)
interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
if ggSay == 1 | m.debug == 1 then
say cnt 'records copied from' frSpec 'to' to toSpec
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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(DBAMULTI) cre=2006-09-22 mod=2008-06-27-11.07.06 F540769 ---
/* rexx ****************************************************************
synopsis: dbaMulti ¢-r¦s¦u¦?! <member>
start multiClon for <member>
<member> must end with a W (new) or C (change)
as a tso command member must be 8 characters long
as an editmacro mbr defaults to the member being edited
and a single character overwrites its last character
dbaCheck applies the CS defaults (if run as editMacro)
if the member exists already in a WSL
it is removed, if the user whishes
the input dataset is overwritten for mbr
the appropriate mulitCloneJob is started
options:
-s silent: remove members without asking
-u unchecked: do not run dbaCheck
-? or ?: this help
***********************************************************************
02.06.2008 uses dbx
*/ /* end of help --- history
04.12.2007 copies wsl to DSN.DBA.CLON.WSLSRC
05.01.2007 uses DbaCheck
20.11.2006 runs also in RZ2, RZ4 RR2 and RR4
**********************************************************************/
nd = sysvar(sysnode)
libPre = 'DSN.DBA.'
if nd = 'RZ1' then
libMid = 'DBAF DBBA DBLF DBOC DBTF DBZF DVTB'
else if nd = 'RZ2' | nd = 'RR2' then
libMid = 'DBOF'
else if nd = 'RZ4' | nd = 'RR4' then
libMid = 'DBCP DBII DBOL DVBP'
else
call errHelp 'rz' nd 'is not supported'
libSuf = '.WSL'
multiInp = 'DSN.DBA.MULTI.CLON.INPUT'
multiNew = 'DSN.DBA.MULTI.CLON.NEW.JCL'
multiChg = 'DSN.DBA.MULTI.CLON.CDL.JCL'
multiCopy= 'DSN.DBA.CLON.WSLSRC'
parse arg args
call adrIsp 'control errors return'
mbr = ''
opt = ''
isMacro = 0
if args = '' then
if adrEdit('macro (args)', 20) == 0 then
isMacro = 1
if pos('?', args) > 0 then
return help()
do ax=1 to words(args)
wo = translate(word(args, ax))
if left(wo, 1) = '-' then do
if verify(wo, '-URS') <> 0 then
call errHelp 'bad option "'wo'" in "'args'"'
opt = opt substr(wo, 2)
end
else if mbr ^== '' then
call errHelp 'more than one member "'wo'" in "'args'"'
else
mbr = wo
end
if pos('U', opt) < 1 then do
res = dbaCheck('dbaMulti')
if res = 4 then
return
else if res ^== 0 then
call err 'dbaCheck returns' res
end
if length(mbr) <= 1 & isMacro then do
fnd = 'DSN.DBA. first'
if adrEdit("seek" fnd, 4) ^= 0 then
call err 'could not find member, dsn.dba not found'
call adrEdit "(lx, cx) = cursor"
call adrEdit "(line) = line" lx
sx = cx + 8
do 4
ex = verify(line, ' .', 'm', sx)
if ex <= sx then
ex = 1+length(line)
em = strip(substr(line, sx, ex-sx))
if length(em) = 8 then
leave
sx = ex+1
end
if length(em) <> 8 then
call errHelp 'no mbr detected in line' lx':' line
mbr = overlay(mbr, em, 9 - length(mbr))
say 'detected qualifier' em 'in edit data yielding member' mbr
end
if length(mbr) <> 8 then
call errHelp 'mbr "'mbr'" should have length 8'
else if pos(right(mbr, 1), 'CW') = 0 then
call errHelp 'mbr "'mbr'" should end with C or W'
doRm = pos('S', opt) > 0
do mx = 1 to words(libMid) while ^doRm
dsn = jcl2dsn(libPre || word(libMid, mx) || libSuf"("mbr")")
sd = sysDsn(dsn)
if sd = 'OK' then do
if pos('S', opt) < 1 then do
say 'remove existing mbr' mbr 'in' dsn' (r for remove)?'
parse upper pull a
if left(a, 1) ^== 'R' then do
say 'exiting because answer was' a 'and not r'
exit
end
doRm = 1
end
end
else if sd ^== 'MEMBER NOT FOUND' then do
call err 'unexpected sysDsn('dsn') =' sd
end
end
call dbx cloneWsl '*' mbr doRm
if isMacro & nd = 'RZ1' then do
call adrEdit '(zl) = lineNum .zl'
do x=2 to zl+1
call adrEdit '(li) = line' (x-1)
li.x = li
end
li.1 ='-- Copied by dbamulti for' userid() 'on' date() 'at' time()
call writeDsn multiCopy'('left(mbr,7)'Q)', li., zl+1
end
exit
/* 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(s005y000) 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(DBARB) cre=2006-09-28 mod=2008-05-08-16.10.36 F540769 ---
/* rexx ****************************************************************
synopsis: DBARB ¢subsys!
version vom 19.10.2006
edit macro to generate rebinds for a worklist
function:
search sql DDL statements in currently edited data
find packages dependent on created/dropped/altered
tablespaces, tables, views, indexes, aliases or synonyms,
append rebind statements for these packages and
remove existing rebinds at the end of the data
subsys may be one of the following
? for this help
empty for deduce subsys from WSLLib, qualifiers or sysnode
x for DBxF
yy for DByy
zzzz for zzzz
************************************************************************
14.12.2006 scan start robuster gemacht gegen ScanErr
***********************************************************************/
/*
20.10.2006 synonym und tablespace eingebaut
19.10.2006 viewDep muss nicht berücksichtigt werden, weil DB2
mit einem Objekt auch alle abhängigen Views löscht
***********************************************************************/
parse arg args
m.debug = 0 /* debug output */
m.cmp = userid() = 'A540769' /* compare old and new rebinds */
call adrIsp 'control errors return'
isMacro = 0
if word(args, 1) == 'isMacro' then do
isMacro = 1
args = subword(args, 2)
end
else if args = '' then do
if adrEdit('macro (args)', 20) == 0 then
isMacro = 1
end
if ^ isMacro then
call errHelp 'not started as editMacro'
if pos('?', args) > 0 then
exit help()
m.types = 'R T V X A S'
m.typNames = 'tablespace table view index alias synonym'
m.cmp.0 = 0
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
m.obj.typ.0 = 0
end
/* analyze ddl in data
and extract changed db2 objects */
call scanStart mr
call scanOptions mr, ,'_0123456789', '--'
call ooDefREad mr, 'res = readMacro('oid', var);'
if isMacro then
call searchObjects
li = '' /* format and display counts */
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
li = li',' m.obj.typ.0 word(m.typNames, tyx)
end
li = substr(li, 3)
say 'found' li
/* find db2 subsystem */
m.subsys = dbSubSys(translate(args))
/* show db2 objects in data */
call adrEdit '(origZl) = lineNum .zl'
call appLine '-- generating rebinds in' m.subsys ,
'at' time('n') date('e') 'for' userid()
call appLine '-- for' li
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
tNa = left(word(m.typNames, tyx), 10)
do x=1 to m.obj.typ.0
call appLine '-- ' tNa m.obj.typ.x
end
end
/* search dependent packages in db2 catalog */
sql = genSql()
if sql ^== '' then do
sp = left('-- rebind old state', 72-39-2)
say 'connecting to' m.subsys
call adrSqlConnect m.subsys
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
cnt = 0
/* fetch each package and write rebind */
do forever
call adrSql 'fetch c1 into :coll, :name, :vers, :type, :info'
if sqlCode = 100 then
leave
cnt = cnt + 1
coll = strip(coll)
name = strip(name)
vers = strip(vers)
if type == 'T' then
call appLine 'REBIND TRIGGER PACKAGE('coll'.'name');'
else
call appLine 'REBIND PACKAGE('coll'.'name'.('vers'));'
call appLine ' --' info
end
call adrSql 'close c1'
say 'found' cnt 'packages'
end
call deleteRebindsUntil origZl
if m.cmp then
call cmpPrint
call adrSqlDisconnect
exit
/--- search db2 objects changed in the ddl ---------------------------*/
searchObjects: procedure expose m.
sqls = 'create alter drop'
do sx =1 to words(sqls) /* for each sql command */
s1 = word(sqls, sx)
call adrEdit "cursor = .zf"
do while adrEdit("seek" s1 'word', 4) = 0 /* find each command*/
call adrEdit "(lx, cx) = cursor"
call adrEdit "(line) = line" lx
if ^ scanAtCursor(s1) then
iterate
typ = sqlName()
if wordpos(typ, 'UNIQUE LARGE LOB') > 0 then
typ = sqlName()
if typ = '' then
call scanErr mr, 'object type expected'
if wordPos(typ, translate(m.typNames)) <= 0 then
iterate
tyCh = word(m.types, wordPos(typ, translate(m.typNames)))
if s1 ^= 'create' then do
nm = sqlQualId()
end
else if typ = 'INDEX' then do
nm = sqlQualId()
if sqlName() ^== 'ON' then
call scanErr mr, 'ON expected after create index' nm
call addObj t, sqlQualId()
end
else if typ = 'TABLESPACE' then do
nm = sqlIdent()
if sqlName() ^== 'IN' then
call scanErr mr,
, 'IN expected after create tablespace' nm
nm = sqlIdent()'.'nm
end
else if typ = 'SYNONYM' then do
nm = sqlIdent()
if sqlName() ^== 'FOR' then
call scanErr mr,
, 'FOR expected after create synonym' nm
nm = sqlIdent()'.'nm
end
else do
nm = sqlQualId()
end
call addObj tyCh, nm
end /* each command found */
end /* each sql command */
return
endProcedure searchObjects
/*--- add a db2 object nm of type typ to the list,
if not done already -----------------------------------*/
addObj: procedure expose m.
parse arg typ, nm
if symbol('m.obj.typ.nm') ^= 'VAR' then do
nx = m.obj.typ.0 + 1
m.obj.typ.0 = nx
m.obj.typ.nx = nm
m.obj.typ.nm = nx
end
return
endProcedure addObj
/*--- return the sql to retrieve the packages
dependent on db2 objects in out list ----------------------*/
genSql: procedure expose m.
m.obj.ow.0 = 0
cntTav = 0
cntIdx = 0
/* build lists of names by qualifier */
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
do ox=1 to m.obj.typ.0
qu = anaQualIdent(m.obj.typ.ox)
cntTav = cntTav + 1
if symbol('m.obj.ow.qu') ^== 'VAR' then do
call addObj ow, qu
m.tav.qu = m.ident
m.idx.qu = ''
end
else do
m.tav.qu = m.tav.qu"," m.ident
end
if typ == 'X' then do
/* additional list for indexes */
cntIdx = cntIdx + 1
if m.idx.qu = '' then
m.idx.qu = m.ident
else
m.idx.qu = m.idx.qu"," m.ident
end
end
end
if cntTav = 0 & cntIdx = 0 then
return ''
do y=1 to m.debug * m.obj.ow.0 /* debug lists */
qu = m.obj.ow.y
say y 'qual' qu 'tav:' m.tav.qu 'index:' m.idx.qu
end
/* build sql */
sql = 'select distinct p.collid, p.Name, p.version, p.type,' ,
"'vivo=' || p.validate || p.isolation ||" ,
"p.valid || p.operative ||" ,
"' con=' || hex(p.contoken) ||" ,
"' tst=' || char(p.timestamp)" ,
'from sysibm.syspackdep d join sysibm.syspackage p' ,
'on p.location = d.dLocation and p.collid = d.dCollid' ,
'and p.name = d.dName and p.conToken = d.dConToken' ,
'where'
do y=1 to m.obj.ow.0 /* add each qualifier */
qu = m.obj.ow.y
if m.tav.qu ^= '' then
sql=sql '( bQualifier =' qu 'and bName in ('m.tav.qu')) or'
end
if cntIdx <= 0 then do
sql = left(sql, length(sql) - 3)
end
else do /* subselect for tables of indexes */
sql=sql '( (bQualifier, bName) in' ,
'( select tbcreator, tbname' ,
'from sysibm.sysindexes where'
do y=1 to m.obj.ow.0
qu = m.obj.ow.y
if m.idx.qu ^= '' then
sql=sql '( creator =' qu 'and name in ('m.idx.qu')) or'
end
sql = left(sql, length(sql) - 3) ') )'
end
if m.debug then do /* debug generated sql */
l = 60
c = 1
do while length(sql) - c > l
do e = c+l by -1 while substr(sql, e, 1) ^== ' '
end
say substr(sql, c, e - c)
c = e + 1
end
say substr(sql, c)
end
return sql
endProcedure genSql
/*--- analyze the two parts of a qualified sql identifier ------------*/
anaQualIdent: procedure expose m.
parse arg s
if left(s, 1) = '"' then do
dx = pos('"', s, 2)
m.qual = substr(s, 2, dx - 2)
dx = dx + 1
end
else do
dx = pos('.', s)
m.qual = left(s, dx - 1)
end
if substr(s, dx+1, 1) = '"' then do
ex = pos('"', s, dx+2)
m.ident = substr(s, dx+2, ex - dx - 2)
end
else do
m.ident = substr(s, dx+ 1)
end
m.qual = "'"m.qual"'"
m.ident = "'"m.ident"'"
return m.qual
endProcedure anaQualIdent
/*--- detect the db2 subsystem ---------------------------------------*/
dbSubSys: procedure expose m.
parse arg a
/* subsys may be passed as argument */
if length(a) = 4 then
return a
else if length(a) = 2 then
return 'DB'a
else if length(a) = 1 then
return 'DB'a'F'
else if length(a) ^= 0 then
call errHelp 'bad abbreviation for db2 subsystem: "'a'"'
/* the db admin tool puts the name of the curren WSL library
in the variable ADBWLDSN in the shared pool,
however the session might be in a different split screen */
wslSubSys= ''
if ADRISP('VGET ADBWLDSN', '*') = 0 then do
if left(adbwldsn, 9) == "'DSN.DBA." ,
& substr(adbwldsn, 14) == ".WSL'" then
wslSubSys = substr(adbwldsn, 10, 4)
/* say 'db2SubSys' wslSubSys 'deduced from WSLLib' adbwldsn */
end
/* can we deduce the db2SubSys from the qualifiers? */
quaSubSys = ''
aa = ''
q = ''
do tyx=1 to words(m.types)
typ = word(m.types, tyx)
do x=1 to m.obj.typ.0
id = anaQualIdent(m.obj.typ.x)
upper m.qual
if pos(m.qual, aa) > 0 then
iterate
aa = aa m.qual
if substr(m.qual, 2, 3) = 'OA1' then
n = substr(m.qual, 5, 1)
else if substr(m.qual, 2, 3) = 'GDB' then
n = 'A'
else
iterate
/* compare new char with previous */
if q == '' then
q = n
else if q ^== n then
q = '*'
end
end
nd = sysvar(sysnode)
if length(q) = 1 & pos(q, 'ATZLP') > 0 then do
quaSubSys = 'DB'translate(q, 'O', 'P')'F'
if nd = 'RZ8' & quaSubSys = 'DBOF' then
quaSubSys = 'DM0G'
/* say 'db2SubSys' quaSubSys 'deduced from qualifiers:' aa */
end
/* compare what we got */
if wslSubSys <> '' then
if wslSubSys == quaSubSys | quaSubSys == '' then
return wslSubSys
else
call errHelp 'specify subsys because' wslSubSys,
'from WSLLib mismatches' quaSubsys 'from qualifiers ('aa')'
else if quaSubSys <> '' then
return quaSubSys
if nd = 'RZ2' | nd = 'RR2' then
return 'DBOF' /* here we have only one subsys | */
else if nd = 'RZ8' then
return 'DM0G' /* here we have only one subsys | */
else
call errHelp 'specify subsys.' ,
'Neither WSLLib nor qualifiers ('aa') do'
endProcecdure dbSubSys
/*--- delete comments and rebind statements
backward from given line and position cursor --------------*/
deleteRebindsUntil: procedure expose m.
parse arg origZl
/* scan backward over old rebind statements */
do lx = origZl by -1 to 1
call adrEdit '(li) = line' lx
w = word(li, 1)
if w = '' | left(w, 2) = '--' then
nop
else if translate(left(w, 6)) = 'REBIND' then
call cmp 'o', li
else
leave
end
/* scan forward over comments without rebind */
do lx = lx+1 by 1 to origZl
call adrEdit '(li) = line' lx
if li = '' | (left(word(li, 1), 2) = '--' ,
& pos('REBIND', translate(li)) < 1) then nop
else
leave
end
if lx < origZl then
call adrEdit 'delete' lx origZl
/* position cursor */
if lx < 10 then
lx = 2
call adrEdit 'locate' (lx-1)
return
endProcedure deleteRebinds
/*--- append 1 line at the end of the data ---------------------------*/
appLine: procedure expose m.
parse arg line
call adrEdit 'line_after .zl = (line)'
if word(line, 1) = 'REBIND' then
call cmp 'n' , line
return
endProcedure appLine
/*--- compare rebind statements --------------------------------------*/
cmp: procedure expose m.
parse arg typ, line
line = strip(line)
do x=1 to m.cmp.0
if m.cmp.x = line then do
m.cmpTyp.x = m.cmpTyp.x || typ
return
end
end
m.cmp.0 = x
m.cmp.x = line
m.cmpTyp.x = typ
return
endProcedure cmp
/*--- print compare rebind statements --------------------------------*/
cmpPrint: procedure expose m.
parse arg typ, line
eq = 0
nw = 0
od = 0
un = 0
do x=1 to m.cmp.0
if m.cmpTyp.x = 'no' | m.cmpTyp.x = 'on' then do
m.cmpTyp.x = '='
eq = eq + 1
end
else if m.cmpTyp.x = 'n' then
nw = nw + 1
else if m.cmpTyp.x = 'o' then
od = od + 1
else
un = un + 1
end
call appLine '---- compare' eq '=,' nw 'new,' od 'old,' ,
un 'others, total' m.cmp.0
do x=1 to m.cmp.0
call appLine '--'left(m.cmpTyp.x, 5)m.cmp.x
end
return
endProcedure cmpPrint
/***********************************************************************
scanning sql
***********************************************************************/
/*--- scan a qualified sql identifier --------------------------------*/
sqlQualId: procedure expose m.
q1 = sqlIdent()
if q1 = '' then
call scanErr mr, 'sql qualifier expected'
call scanSpaceNl mr
if ^ scanLit(mr, '.') then
call scanErr mr,
, '. between sql qualifier' q1 'and identifer expected'
q2 = sqlIdent()
if q2 == '' then
call scanErr mr, 'sql identifier after . expected'
return q1'.'q2
endProcedure sqlQualId
/*--- scan a sql identifier e.g. abc or "efg" ------------------------*/
sqlIdent: procedure expose m.
nm = sqlName()
if nm ^== '' then
return nm
if scanString(mr, '"') then
return m.tok
else
return ''
endProcedure sqlIdent
/*--- scan a name after skipping over space and newLines -------------*/
sqlName: procedure expose m.
call scanSpaceNl mr
if ^ scanName(mr) then
return ''
return translate(m.tok)
endProcedure sqlName
/***********************************************************************
interface to scan - use edit data as scanner input
***********************************************************************/
/*--- start reading at cursor after token wrd ------------------------*/
scanAtCursor: procedure expose m.
parse upper arg wrd
call adrEdit "(lx, cx) = cursor"
call scanMacro mr, lx
if cx > 1 then do
x = scanChar(mr, cx-2)
if ^ (scanLit(mr, ' ') | scanLit(mr, ';')) then
return 0
end
nm = sqlName()
return nm == wrd
endProcedure scanAtCursor
/*--- start reading from edit line lx --------------------------------*/
scanMacro: procedure expose m.
parse arg m, lx
m.m.readMacroLx = lx - 1
call scanReader mr, mr
return
endProcedure scanMacor
/*--- read next line from edit data ----------------------------------*/
readMacro: procedure expose m.
parse arg m, var
m.m.readMacroLx = m.m.readMacroLx + 1
if adrEdit('(ll) = line' m.m.readMacroLx, 12) ^= 0 then
return 0
m.var = ll
return 1
endProcedure scanMacro
/*--- error handling -------------------------------------------------*/
err:
call errA arg(1), 1
endSubroutine err
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line
scanStem(m,ln) : begin scanning all lines in a stem
scanAtEOL(m) : returns whether we reached end of line
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
scanNum(m) : scan integer (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
call scanStart m
return
endProcedure scanLine
/*--- begin scanning the lines of a stem -----------------------------*/
scanReader: procedure expose m.
parse arg m, inRdr
call scanStart m, inRdr
m.scan.m.src = ''
m.scan.m.atEnd = ^ scanNL(m, 1)
return m
endProcedure scanReader
/*--- switch to next line if atEOF or argument unCond=1 --------------*/
scanNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then
m.scan.m.pos = 1 + length(m.scan.m.src)
else if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 0
else if ^ ooRead(m.scan.m.reader, 'SCAN.'m'.SRC') then do
m.scan.m.atEnd = 1
return 0
end
m.scan.m.pos = 1
m.scan.m.tok = ''
return 1
endProcedure scanNL
/*--- initialize scanner for m --------------------------------------*/
scanStart: procedure expose m.
parse arg m, m.scan.m.reader
m.scan.m.pos = 1
m.tok = ''
m.val = ''
m.key = ''
if symbol('m.scan.m.Name') ^== 'VAR' then do
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
end
return
endProcedure scanStart
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanStart
if nameOne ^== '' then
m.scan.m.Name1 = nameOne
if nameOne ^= '' | namePlus ^== '' then
m.scan.m.name = m.scan.m.name1 || namePlus
m.scan.m.comment = comm
return
endProcedure scanBegin
/*--- return true/false whether we are at the end of the line --------*/
scanAtEOL: procedure expose m.
parse arg m
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEOL
/*--- return true/false whether we are at the end of the input -------*/
scanAtEnd: procedure expose m.
parse arg m
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 1
else
return m.scan.m.atEnd
endProcedure scanAtEnd
/*--- scan len characters --------------------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
m.tok = substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
if nx = m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a number --------------------------------------------------*/
scanNum: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure scanNum
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, ix, length(tok) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into *.key and word into val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(scanSkip(m)) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok
say ' charPos' m.scan.m.Pos':',
strip(substr(m.scan.m.src, m.scan.m.Pos), 't')
say ' in line:' strip(m.scan.m.src, 't')
call err 'scanErr' txt
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
res = 0
cc = m.scan.m.comment
do forever
if scanVerify(m, ' ') then nop
else if scanNL(m) then nop
else if cc == '' then leave
else if ^ scanLit(m, cc) then leave
else if ^scanNL(m, 1) then leave
res = 1
end
m.tok = lastTok
return res
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/* copy scan end ****************************************************/
/* copy oo begin ******************************************************/
call ooIni
/* ri = readDsnOpen(ooNew(), 'wk.text(testin)') */
call ooArgs2Stem aaa, 1, 'aaa.1 eins', 'aaa.2 zwei', 'aaa.3 drei'
ri = readCatOpen(ooNew(), "&AAA $ wk.text(testin) ",,'&' aaa,
, 'wk.text(msk1) $ &AAA')
do i=1 by 1 while ooRead(ri, line)
say 'line' i strip(m.line, 't')
end
call ooReadClose ri
exit
ooIni: procedure expose m.
m.oo.lastId = 1
return
endProcedure ooIni
ooNew: procedure expose m.
m.oo.lastId = m.oo.lastId + 1
return m.oo.lastId
endProcedure newoo
ooFree: procedure expose m.
parse arg id
return
endProcedure ooFree
ooRead: procedure expose m.
parse arg oid, var
res = '?'
interpret m.oo.oid.read
return res
endProcedure ooRead
ooReadClose: procedure expose m.
parse arg oid
stem = ''
interpret m.oo.oid.readClose
m.oo.oid.read = 'res=0'
m.oo.oid.readClose = ''
return
endProcedure ooReadClose
ooDefRead: procedure expose m.
parse arg oid, m.oo.oid.read, m.oo.oid.readClose
return oid
endProcedure ooDefRead
ooDefReadStem: procedure expose m.
parse arg oid, m.oo.oid.readStem, close
m.oo.oid.0 = 0
m.oo.oid.readStemCx = 0
return ooDefRead(oid, 'res = ooReadStem2Ln("'oid'", var);', close)
endProcedure ooDefReadStem
ooReadStem2Ln: procedure expose m.
parse arg oid, v
cx = m.oo.oid.readStemCx
if cx >= m.oo.oid.0 then do
res = '?'
stem = 'OO.'oid
m.stem.0 = 0
m.oo.oid.stCx = 0
interpret m.oo.oid.readStem
if ^ res then
return 0
else if m.stem.0 < 1 then
call err 'stem.0='m.stem.0 'after 1 from' m.oo.oid.readStem
cx = 0
end
cx = cx + 1
m.v = m.oo.oid.cx
m.oo.oid.readStemCx = cx
return 1
endProcedure ooReadStem2Ln
ooReadStemOpen: procedure expose m.
parse arg oid, stem
call ooDefReadStem oid, 'res = 0;'
do ix=0 by 1 to m.stem.0
m.oo.oid.ix = m.stem.ix
end
m.oo.oid.0 = m.stem.0
return oid
endProcedure ooReadStemOpen
ooReadArgsOpen: procedure expose m.
parse arg oid, ox
call ooDefReadStem oid, 'res = 0;'
if ox = '' then
ox = m.oo.oid.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.oo.oud.ox = arg(ax)
end
m.oo.oid.0 = ox
return oid
endProcedure ooReadArgsOpen
ooArgs2Stem: procedure expose m.
parse arg stem, ox
if ox = '' then
ox = m.stem.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.stem.ox = arg(ax)
end
m.stem.0 = ox
return stem
endProcedure ooArgs2Stem
/* copy oo end ********************************************************/
/* copy adrSql begin *************************************************/
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then do
return 0
end
else if rc < 0 then do
if ggRet == '*' then nop
else if wordPos(sqlCode, ggRet) > 0 then nop
else
call err "sql rc" rc sqlmsg() ggNo
end
else if sqlWarn.0 ^== ' ' then do
say 'warning' sqlMsg() ggNo
end
return sqlCode
endSubroutine adrSql
adrSqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call adrSql "connect" ggSys, ggRetCon ,1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
parse arg ggRet
call adrSql "disconnect ", ggRet, 1
return
endProcedure adrSqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggW = ''
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggw = ggw ggx'='sqlWarn.ggx
end
ggXX = pos(':', ggSqlStmt)
ggVV = ''
if ggXX > 0 then do
ggVV = word(substr(ggSqlStmt, ggXX + 1), 1)
ggVV = 'with' ggVV '=' value(ggVV)
end
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x)) ,
'stmt = ' ggSqlStmt ggVV
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/* copy adrSql end *************************************************/
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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 .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'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
dsn = strip(dsn)
if right(dsn, 1) = "'" then
dsn = strip(left(dsn, length(dsn) - 1))
bx = pos('(', dsn)
if bx > 0 then
dsn = strip(left(dsn, bx-1))
if mbr <> '' then
dsn = dsn'('strip(mbr)')'
if left(dsn, 1) = "'" then
dsn = dsn"'"
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), 't', "'")
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
if left(spec, 1) = '=' then
return strip(substr(spec, 1))
dsn = ''
do wx=1 to 3
w = word(spec, wx)
if w = '' then
leave
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if dsn = '' | left(w, 1) = "'" then
dsn = 'dsn('w')'
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
call adrTso 'alloc dd('dd')' disp dsn subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
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)
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- 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 *****************************************************/
COMMIT;
CREATE unique index vdps2.iixdu on VDPS2.DTUNDERFIXCOMQ
alter index vdps2.iixduZwei on VDPS2.DTUNDERFIXCOMQ
create lob tablespace a123 in db123
create synonym syefgh for own123.taefgh
CREATE TABLE VDPS2.DTUNDERFIXCOMP
alter table oa1a038.twk003a
alter table gdb9998.twk003a
commit sdf sdf; CREATE TABLE "VDPS3 "
. -- sdf sdf
-- sdf
"vdps table drei " ; create alias efg.hik
-s silent: remove members wi
kommentar vorher
-- generating rebinds in DBAF at 14:21:19 20/10/06 for A540769
-- for 1 tablespace, 5 table, 0 view, 2 index, 1 alias, 1 synonym
-- tablespace DB123.A123
-- table VDPS2.DTUNDERFIXCOMQ
-- table VDPS2.DTUNDERFIXCOMP
-- table "VDPS3 "."vdps table drei "
-- table OA1A038.TWK003A
-- table GDB9998.TWK003A
-- index VDPS2.IIXDU
-- index VDPS2.IIXDUZWEI
-- alias EFG.HIK
-- synonym OWN123.SYEFGH
REBIND PACKAGE(DB.DBWK2.(DB2J000003));
-- vivo=BSNY con=17EF4F701D8D1B72 tst=2006-09-29-14.38.38.590494
REBIND PACKAGE(DB.DBWK2.(DB2J000ABC));
-- vivo=BSNY con=17EF50AF1ACF23CB tst=2006-09-29-15.58.43.647758
REBIND PACKAGE(DB.DBWK2.(DB2J000XYZ));
-- vivo=BSNY con=17EF50B10BBC328C tst=2006-09-29-15.58.56.607691
REBIND TRIGGER PACKAGE(DGDB9998.WK003TRIG);
-- vivo=BSYY con=17ECF6B005DF3C90 tst=2006-09-14-16.52.20.179834
---- compare 4 =, 0 new, 0 old, 0 others, total 4
--= REBIND PACKAGE(DB.DBWK2.(DB2J000003));
--= REBIND PACKAGE(DB.DBWK2.(DB2J000ABC));
--= REBIND PACKAGE(DB.DBWK2.(DB2J000XYZ));
--= REBIND TRIGGER PACKAGE(DGDB9998.WK003TRIG);
}¢--- A540769.WK.REXX.O08(DBX) cre=2007-06-25 mod=2008-12-18-17.33.27 F540769 ---
/* rexx ****************************************************************
synopsis: DBX fun args
edit macro fuer CS Nutzung von DB2 AdminTool 7.2
(die a* Funktionen gehen auch mit tso dbx ...)
? diese Hilfe
a,aw,ac pr naechste AuftragsId suchen fuer praefix pr
a: anzueigen, aw, ac entsprechendes Member editieren
n, nt neuen Auftrag erstellen (nt = test)
q subSys? query und expandiert Scope Zeilen vom Db2Catalog
* fuegt alle bestehenden Objekte ein
* ergaenzt scope Zeile mit infos, z.B tb -> ts
* UNDO um Expansion rueckgaengig zu machen
* mit q, qq, etc. Zeile selekieren,
sonst werden alle expandiert
* funktioniert nicht nur in Auftrag
falls SubSys angegeben wird da gesucht sonst DBAF/DBOF
c opt? compare source gegen target
i subSys nct changes in Db2Subsystem subSys importieren
subSys: DBAF (im RZ1); RR2.DBOF (im PTA); *, RZ4.*;
RZ8.DB0G,DC0G; *.* (alle in RZ1,RR2,RZ2, RZ8)
nct: Nachtraege:
leer: noch nicht in dieses SubSys importierte
= : vom letzten import plus neue
89A : Nachtraege 8, 9 und A
v opt? version files erstellen für altes Verfahren
sw rz? WSL ins RZ rz schicken und clonen, ohne rz mulitclone
do cmd for auftraege: batchfunktion cmd fuer jeden auftrag
opt? Optionale Optionen =, -f, -=f etc. (fuer c, v, st)
= statt aktuelle source aus Db2 extrahieren
letzte extrahierte Version als Source brauchen
-f force: ignoriere QualitaetsVerletzungen
cloneWsl dbaMulti Funktionalitaet ist hier implementiert
Variabeln im Auftrag (expandiert werden $varName imd ${varName}
varName ist case sensitive|)
srcNm NamensKonvention compare source (z.B. DBAF)
trgNm NamensKonvention compare target (z.B. DBAF)
impNm NamensKonvention import Ziel (z.B. DBOF)
subsys Db2 Subsystem (source, target, import, je nachdem)
************************************************************************
18.12.2008 p. kuhn neues Delta Merge Verfahren im import fuer DQ0G
18.12.2008 p. kuhn SW fuer DVBP im RZ2 (frueher im RZ4)
*/ /* end of help
10.12.2008 p. kuhn Timeout vom Sendjob von 30 auf 600 Sek. erhoeht.
28.11.2008 w. keller v9 Fehler bei leerer Selektion
24.09.2008 p. kuhn v9 checks
15.09.2008 p. kuhn beim ersten import wird cdl dbaCheck't und editiert
09.09.2008 w. keller target mit RZ (job holt ddl, version aus RZ), opt =
08.08.2008 w. keller import mit wildcards
24.07.2008 w. keller overwrite ausgebaut +25.7
24.06.2008 w. keller fix spezialFall für DB +18.7
19.05.2008 w. keller qualitaetsKontolle in c,v und st und -f Option
13.05.2008 w. keller rw, rs, sw, st und do ... for ... eingebaut
25.02.2008 w. keller subSys argument für dbx q
22.11.2007 w. keller fun v für ObjectCompare Verfahren inkl db ddl save
dq0g mit eigenen Libraries
12.11.2007 w. keller DSN für neuen Wartungsstand
05.06.2007 w. keller neu
***********************************************************************/
/* Ideen, Wünsche ******************************************************
AuftragsId aus Prototyp bestimmen
translate scopes
import produktion/pta inkl. filetransfer
LCTL
sämtliche infos aus XLS
jedesmal Zwischenspeichern mit und restore Funktion
analyze generieren, falls möglich
batch Funktionen ganzen Zügelschub importieren usw.
generierte Runs starten in richtiger Reihenfolge
mails an Entwickler schicken
Rückmeldung falls keine changes (leeres cdl)
**** alte Funktion (braucht es nicht mehr) *****************************
sw rz? WSL aus RZ rz holen und clonen, ohne rz mulitclone
rs rz source ddl und version aus RZ rz holen
st opt? rz target ddl und version extrahieren und ins rz schicken
***********************************************************************/
m.debug = 0
call errReset h
if sysvar(sysispf) = 'ACTIVE' then
call adrIsp 'Control errors return'
call mapIni
parse upper arg oArgs
m.auftrag.dataset = ''
m.editMacro = 0
m.editProc = 0
if oArgs = '' then do
if adrEdit('macro (oArgs) NOPROCESS', '*') <> 0 then
call errHelp('keine Argumente und kein editMacro rc =' rc)
m.editMacro = 1
call adrEdit 'caps off'
call adrEdit '(x) = member'
m.auftrag.member = x
m.edit.member = x
call adrEdit '(x) = dataset'
m.auftrag.dataset = x
m.edit.dataset = x
end
else do
oArgs = 'BATCH' oArgs
end
if oArgs = '' | pos('?', oArgs) > 0 then
exit help()
m.uId = strip(userid())
if m.uId = 'A540769' then
m.uNa = 'Walter'
else if m.uId = 'A914227' then
m.uNa = 'Gerrit'
else if m.uId = 'A918249' then
m.uNa = 'Petra'
else if m.uId = 'A828386' then
m.uNa = 'Reni'
else if m.uId = 'A234579' then
m.uNa = 'Marc'
else if m.uId = 'A666308' then
m.uNa = 'Frank'
else if m.uId = ' ' then
m.uNa = 'Claudia'
else
m.uNa = m.uId
m.zuegelSchub = '20081114 ??:00'
m.scopeTypes = 'DB TS TB VW IX AL'
m.nachtragChars = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
call work oArgs
exit
/*--- hier wählen wir die wirklich Arbeit aus -----------------------*/
work: procedure expose m.
parse upper arg fun args
call mapReset e, 'K'
if m.auftrag.dataset = 'A540769.DBX.AUFTRAG' then do
m.libSkels = 'A540769.wk.skels(dbx'
m.libPre = 'A540769.DBX'
end
else if m.auftrag.dataset = 'DSN.DBQ.AUFTRAG' then do
m.libSkels = 'ORG.U0009.B0106.KIUT23.SKELS(dbx'
m.libPre = 'DSN.DBQ'
end
else do
m.libPre = 'DSN.DBX'
m.libSkels = 'ORG.U0009.B0106.KIUT23.SKELS(dbx'
end
if 0 then do /* ??? testSkels */
if userid() = 'A540769' then
m.libSkels = 'A540769.wk.skels(dbx'
else if userid() = 'A918249' then
m.libSkels = 'a918249.tso.skels(dbx'
else
m.libSkels = 'DSN.DBX.TEST(dbx'
say '??? test skels' m.libSkels '|||'
end
m.libSpezial = m.libPre'.spezial'
m.sysRz = sysvar('SYSNODE')
call configureRZ m.sysRz
call db2Rel '910'
call mapPut e, 'rexxLib', 'ORG.U0009.B0106.KIUT23.EXEC'
call mapPut e, 'ovrDD', 'DISP=SHR,DSN='m.libPre'.MASK(OVERRIDE)'
call mapPut e, 'libPre', m.libPre
if fun = 'Q' then /* macht process selber | */
return queryScope(args)
if m.editMacro & ^ m.editProc then do
call adrEdit 'process'
m.editProc = 1
end
if wordPos(fun, 'A AC AW') > 0 then
return nextAuftrag(word(args, 1), substr(fun, 2), word(args, 2))
else if fun = 'BATCH' then
return batch(args)
else if wordPos(fun, 'ADATASET DO') > 0 then
return batch(fun args)
else if fun = 'COPYDUMMY' then
return copyDummy(args)
else if fun = 'CLONEWSL' then
return cloneWsl(word(args, 1), word(args, 2), 1==word(args, 3))
call memberOpt
if wordPos(fun, 'N NT') > 0 then
call neuerAuftrag (fun = 'NT'), args, m.auftrag.member
else if fun = 'C' | fun = 'V' | fun = 'ST' then
call compare fun, args
else if fun = 'I' then
call import args
else if fun = 'N' then
call neuerNachtrag args
else if fun = 'RS' then
call receiveSource args
else if fun = 'RW' then
call receiveWSL args
else if fun = 'SW' then
call sendWSL args
else
call errHelp 'bad fun' fun 'in args' args, , ' '
if m.auftrag.orig = m.auftrag.0 | m.auftrag.0 = '' then do
end
else do
if abbrev(m.auftrag.orig, 'rmQu') then do
/* alte | Zeilen loeschen */
oldOr = word(m.auftrag.orig, 2)
ox = 0
do ix = 1 to m.auftrag.0
if abbrev(word(m.auftrag.ix, 1), '|') & ix <= oldOr then
iterate
ox = ox + 1
m.auftrag.ox = m.auftrag.ix
end
m.auftrag.0 = ox
m.auftrag.orig = 'rep'
end
if m.editMacro & m.auftrag.dataset = m.edit.dataset ,
& m.auftrag.member = m.edit.member then do
if m.auftrag.orig = 'rep' then do
call adrEdit 'delete .zf .zl'
m.auftrag.orig = 0
end
do lx = m.auftrag.orig+1 to m.auftrag.0
li = left(m.auftrag.lx, 72)
call adrEdit "line_after .zl = (li)"
end
call adrEdit 'save', 4
end
else do
call writeDsn dsnSetMbr(m.auftrag.dataset,
,m.auftrag.member), m.auftrag.,,1
end
end
return
endProcedure work
/*--- batch funktionen -----------------------------------------------*/
batch: procedure expose m.
parse upper arg args
m.auftrag.dataset = 'DSN.DBX.AUFTRAG'
wx = 1
do forever
w1 = word(args, wx)
if w1 = '' then
return 0
if w1 = 'ADATASET' then do
m.auftrag.dataset = word(args, wx+1)
wx = wx+2
end
else if w1 = 'DO' then do
fx = wordPos('FOR', args, wx)
if fx < 1 then
call err 'DO ohne FOR in' args
cmd = subWord(args, wx+1, fx-wx-1)
do wx=fx+1
ww = word(args, wx)
if ww = '' then
leave
m.auftrag.member = ww
say 'batch do' cmd 'for' ww '...'
call work cmd
end
end
else do
call work subword(args, wx)
return 0
end
end
return 0
endProcedure batch
/*--- create the necessary dbx libries in the specified rz -----------*/
copyDummy: procedure expose m.
parse arg rz
call copyDummy1 rz, 'DSN.DBX.AUFTRAG(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.AUTO(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.CDL(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.DBAUTO(DUMMY)'
/* call copyDummy1 rz, 'DSN.DBX.DBSRCCAT(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.DBSRCDDL(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.DBTRGCAT(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.DBTRGDDL(DUMMY)'
*/
call copyDummy1 rz, 'DSN.DBX.JCL(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.MASK'
/* call copyDummy1 rz, 'DSN.DBX.OVRCAT(DUMMY)' */
call copyDummy1 rz, 'DSN.DBX.SENDCF(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.SRCCAT(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.SRCDDL(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.TRGCAT(DUMMY)'
call copyDummy1 rz, 'DSN.DBX.TRGDDL(DUMMY)'
return 0
endProcedure copyDummy
copyDummy1: procedure expose m.
parse arg sys, dsn
if sysDsn("'"dsn"'") <> 'OK' then
call writeDsn dsn, x, 0, 1
call csmCopy dsn, sys'/'dsn
return
/*--- die Konfiguration pro RZ ---------------------------------------*/
configureRZ: procedure expose m.
parse arg m.myRz
m.jobCard = 'jobCa'
call mapPut e, 'toolPref', 'DSN.TOOLS'
if m.myRz = 'RZ1' then do
m.allSubs = 'DBAF DBTF DBZF DBLF'
if m.libPre = 'DSN.DBQ' then do
m.allSubs = 'DQ0G'
m.jobCard = 'jobCQ'
call mapPut e, 'toolPref', 'DSN.ADB72'
end
end
else if m.myRz = 'RZ2' | m.myRZ = 'RR2' then do
m.allSubs = 'DBOF DVBP'
/* call mapPut e, 'toolPref', 'DSN.ADB72' --> nicht mehr 25.7.08 */
end
else if m.myRz = 'RZ4' | m.myRZ = 'RR4' then do
m.allSubs = 'DBOL DVBP'
end
else if m.myRz = 'RZ8' then do
m.allSubs = 'DM0G DB0G DC0G DD0G DE0G'
end
else if m.myRz = 'RZ0T' | m.myRz = 'RZ0' then do
m.allSubs = 'DBIA'
m.myRz = 'RZ0'
end
m.mySub = word(m.allSubs, 1)
call mapPut e, 'rz', m.myRz
call mapPut e, 'zz', overlay('Z', m.myRz, 2)
return
endProcedure configureRZ
/*--- die Konfiguration fuer einen DB2 Release -----------------------*/
db2Rel: procedure expose m.
parse arg rel, px
if px = '' then
px = 'P0'
call mapPut e, 'db2rel', rel
call mapPut e, 'dsnload', px'.DSNLOAD'
return
endProcedure db2Rel
/*--- Member Namen prüfen und Auftrag lesen---------------------------*/
memberOpt: procedure expose m.
if m.auftrag.dataset <> m.libPre'.AUFTRAG' then
call err 'dbx sollte' m.libPre'.AUFTRAG editieren, nicht' ,
m.auftrag.dataset
m8 = substr(m.auftrag.member, 8, 1)
if pos(m8, 'CW') < 1 then
call err 'Member muss 8 stellig sein und mit C oder W enden',
'nicht' m.auftrag.member
m.optOvr = 0 /* (m8 == 'W') & (m.libPre ^== 'DSN.DBQ') */
m.optAuto = 1
call readAuftrag '', m.auftrag.dataset, m.auftrag.member
return
endProcedure memberOpt
/*--- Auftrag einlesen -----------------------------------------------*/
readAuftrag: procedure expose m.
parse arg sys, pds, mbr
editingAuftrag = 0
if sys = '' & m.editMacro then do
call adrEdit '(em) = member'
call adrEdit '(ed) = dataset'
editingAuftrag = ed = pds & em = mbr
end
if editingAuftrag then do
if adrEdit('(zl) = lineNum .zl', 4) = 4 then
zl = 0
m.auftrag.0 = zl
do lx=1 to zl
call adrEdit "(li) = line" lx
m.auftrag.lx = li
end
end
else do
dsn = dsnSetMbr(m.auftrag.dataset, m.auftrag.member)
if sys = '' then
if sysDsn("'"dsn"'") <> 'OK' then
call err 'auftrag' dsn 'existiert nicht:' sysDsn("'"dsn"'")
call readDsn sys'/'dsn, m.auftrag.
end
m.auftrag.orig = m.auftrag.0
return
endProcedure readAuftrag
/*--- naechste AuftragsNummer suchen ---------------------------------*/
nextAuftrag: procedure expose m.
parse arg pre, make, rz
if rz = '' | rz = '*' then
rz = m.myRz
if m.myRz <> 'RZ1' then
call err 'Auftrag für RZ' rz 'muss aus RZ1 erstellt werden'
auft = m.libPre'.AUFTRAG'
call mAdd mCut(na, 0), auft, 'DSN.DBA.CLON.WSL'
max = pre
do nx=1 to m.na.0
lmm = lmmBegin(dsnSetMbr(m.na.nx, pre'*'))
mb = lmmNext(lmm)
fi = mb
la = ''
do cnt=2 by 1 while mb <> ''
la = mb
mb = lmmNext(lmm)
end
call lmmEnd lmm
say left(fi, 8) '-' left(la, 8)right(cnt-2, 5) ,
'member in' dsnSetMbr(m.na.nx, pre'*')
if la >> max then
max = la
end
nn = left(max, 7, '0')
do cx=7 by-1 to length(pre)+1,
while pos(substr(nn, cx, 1), '0123456789') > 0
end
if cx >= 7 then
nn = ''
else do
pp = 1 + substr(nn, cx+1)
if length(pp) > 7-cx then
nn = ''
else
nn = left(nn, cx) || right(pp, 7-cx, 0)
end
if length(nn) <> 7 then do
say 'max Auftrag' max 'kein naechster bestimmbar'
end
else if make = '' then do
say 'max Auftrag' max 'naechster' nn'?'
end
else do
nn = nn || make
say 'max Auftrag' max 'naechster' nn
m.auftrag.0 = 0
call neuerAuftrag 0, rz, nn
dsnNN = dsnSetMbr(auft, nn)
call writeDsn dsnNN, m.auftrag.
if rz = 'RZ1' then
call adrIsp "edit dataset('"dsnNN"')"
else
call writeDsn rz'/'dsnNN, m.auftrag.
end
m.auftrag.0 = '' /* do not write back the new auftrag | */
return 0
endProcedure nextAuftrag
/*--- einen neuen Auftrag initialisieren -----------------------------*/
neuerAuftrag: procedure expose m.
parse arg isTst, rz, auftName
if rz = '' then
rz = m.myRz
else
call configureRz rz
if isTst then do
ow = m.uid
maPr = 'T' || left(translate(m.uNa), 3, 'X')
comMask = m.libPre'.MASK('maPr'PROT)'
impMask = m.libPre'.MASK('maPr'$subsys)'
end
else do
ow = 'S100447'
comMask = m.libPre'.MASK(PROT$trgNm)'
impMask = m.libPre'.MASK($trgNm$impNm)'
end
comIgno = m.libPre'.MASK(IGNORE)'
impIgno = ''
if m.auftrag.0 <> 0 then
call err 'fun n erstellt neuen Auftrag nur in leeres Member'
call mAdd auftrag ,
, addDateUs('auftrag ' auftName ow) ,
, ' Zuegelschub' m.zuegelSchub ,
, ' Besteller pid name tel' ,
, ' comMask ' comMask ,
, ' comIgno ' comIgno ,
, ' impMask ' impMask ,
, ' impIgno ' impIgno ,
, 'source' m.mySub ,
, ' ts dgdb0___.A%' ,
, 'target' m.myRz'.'m.mySub
return
endProcedure neuerAuftrag
neuerNachtrag: procedure expose m.
parse upper arg opt
call analyseAuftrag
call addNachtrag
return
endProcedure neuerNachtrag
nextNachtrag: procedure expose m.
parse arg nt
nx = pos(nt, m.nachtragChars) + 1
if nx > length(m.nachtragChars) then
call err 'kein Nachtrag char mehr nach' nt
return substr(m.nachtragChars, nx, 1)
m.e.nachtrag = nt
return nt
endProcedure nextNachtrag
/*--- compare: Funktionen c, v und st --------------------------------*/
compare: procedure expose m.
parse upper arg fun, sendToRz
opts = ''
do forever
if abbrev(sendToRz, '=') then do
sendToRz = strip(substr(sendToRz, 2))
opts = opts'='
end
else if abbrev(sendToRz, '-') then do
opts = opts || substr(word(sendToRz, 1), 2)
sendToRz = subword(sendToRz, 2)
end
else
leave
end
cmpLast = pos('=', opts) > 0
if fun = 'C' then
function = 'compare'
else if fun = 'ST' then do
if sendToRz = '' | sendToRz = '*' then
call errHelp 'ST without sendToRz'
call mapPut e, 'toRz', sendToRz
function = 'sendTarget' sendToRz
end
else if fun = 'V' then
function = 'version'
else
call err 'bad fun' fun
call analyseAuftrag
if m.scopeSrc.rz = m.sysRz then do
if qualityCheck(getDb2Catalog('SRC')) then
if pos('F', opts) < 1 then
return
else
say 'wegen Option -f Verarbeitung',
'trotz Qualitaetsfehlern'
end
nacLast = m.e.nachtrag
if nacLast = '?' & cmpLast then
call err 'c = oder v = ohne vorangaengiges c oder v'
if nacLast = '?' | m.nacImp then
m.e.nachtrag = nextNachtrag(nacLast)
call mapPut e, 'mbrNac', left(m.e.auftrag, 7)m.e.nachtrag
m.o.0 = 0
call readDsn m.libSkels || m.jobCard')', m.i.
call mapPut e, 'jobName', 'Y'left(m.e.auftrag, 7)
call mapPut e, 'fun', function opts
call namingConv m.scopeTrg.rz, m.scopeTrg.subsys, 'trgNm'
call namingConv m.scopeSrc.rz, m.scopeSrc.subsys, 'srcNm'
call mapExpAll e, o, i
call mapPut e, 'mask', shrDummy(mapExp(e, m.e.comMask))
call mapPut e, 'ignore', shrDummy(mapExp(e, m.e.comIgno))
if 0 then /* db ddl extrahieren ja / nein ???? */
call extractSrcTrg o, 'DB', cmpLast left(m.e.auftrag, 7)nacLast
call extractSrcTrg o, '', cmpLast left(m.e.auftrag, 7)nacLast
if fun = 'C' then do
if m.optOvr then do
call mapPut e, 'ovr', 'OVR'
call readDsn m.libSkels'Ovr)', m.ovr.
call mapExpAll e, o, ovr
call mapPut e, 'src', 'OVR'
end
call readDsn m.libSkels'Comp)', m.cmp.
call mapExpAll e, o, cmp
end
if fun = 'ST' then do
call readDsn m.libSkels'ST)', m.st.
call mapExpAll e, o, st
end
call writeSub o
call mAdd auftrag, addDateUs(function ,
left('===', 3*cmpLast)m.e.nachtrag,
m.scopeTrg.rz'.'m.scopeTrg.subSys ,
mapExp(e, "'${libPre}.srcCAT($mbrNac)'"))
return
endProcedure compare
/*--- find the naming convention for a rz and subsystem --------------*/
namingConv: procedure expose m.
parse arg rz, subsys, var
if rz = '.' then
if pos('.', subSys) > 0 then
parse var subsys rz '.' subsys
else
rz = m.sysRz
if strip(rz) = 'RZ1' then
t = strip(subsys)
else
t = 'DBOF'
if var ^== '' then
call mapPut e, var, t
return t
endProcedure namingConv
/*--- write jcl and submit it ----------------------------------------*/
writeSub: procedure expose m.
parse arg o, rz, noWri
userSubmits = 0 /* edit jcl and user submits it */
if noWri <> 1 then do
jcl = m.libPre'.JCL('m.e.auftrag')'
call mStrip o, 't'
do ox=1 to m.o.0
if length(m.o.ox) > 70 then
call debug 'o.'ox 'len' length(m.o.ox)':' m.o.ox
end
call writeDsn jcl, m.o., ,1
if userSubmits then /* edit dataset and user may submit it */
call adrIsp "edit dataset('"jcl"')", 4
end
if (noWri <> 1) & (rz = '' | rz = m.sysRz) then do
if ^ userSubmits then
call adrTso "sub '"jcl"'"
end
else do /* submit jcl in another rz */
sysl = csmSysDsn(rz'/')
if sysl = '*/' then
sysl = ''
iral = dsnAlloc(sysl 'SYSOUT(T) dd(ir) .WRITER(INTRDR)')
call writeDDBegin ir
call writeDD ir, m.o.
call writeDDend 'IR'
interpret subword(irAl, 2)
end
return
endProcedure writeSub
/*--- return jcl either dd dummy or dd disp=shr,dsn=... --------------*/
shrDummy: procedure expose m.
parse arg dsn
if dsn = '' then
return 'DUMMY'
else
return 'DISP=SHR,DSN='translate(dsn)
endProcedure shrDummy
/*--- funktion i -----------------------------------------------------*/
import: procedure expose m.
parse upper arg rzSubSysList opt .
call analyseAuftrag
if m.e.nachtrag = '?' then
call err 'vor i=import braucht es compare'
if opt <> '' then
nop
else if words(m.targets) > 1 then
call err 'i=import mit mehreren targets muss Nachtraege',
'explizit angeben, z.B. dbx i' rzSubSysList m.e.nachtrag
else if m.cmpLast then
call err 'i=import mit c = oder v = muss Nachtraege',
'explizit angeben, z.B. dbx i' rzSubSysList m.e.nachtrag
if ^ m.nacImp then do
cdl = cdlDsnCheck(m.e.nachtrag)
call adrIsp "edit dataset('"cdl"') macro(dbacheck)", 4
end
trgNm = namingConv(m.targets)
call readDsn m.libSkels || m.jobCard')', m.jc.
call readDsn m.libSkels'imp)', m.ic.
restList = space(rzSubSysList, 0)
impCnt = 0
rz = '?'
do forever
parse var restList r1 ',' restList
if r1 = '' & restList <> '' then
iterate
if r1 = '**' | r1 = '*.*' then do
restList = 'RZ1.*,RR2.*,RZ2.*,RZ8.*' estList
iterate
end
if pos('.', r1) < 1 then
r1 = m.myRz'.'r1
parse var r1 r '.' subsys
if r <> rz | subsys = '' then do
if impCnt <> 0 then do
if rz <> m.sysRz then
call csmCopy m.libPre'.CDL('left(m.e.auftrag,7)'*)',
, rz'/'m.libPre'.CDL'
call writeSub job, rz
end
if subsys = '' then
return
rz = r
call configureRz rz
impCnt = 0
m.job.0 = 0
call mapPut e, 'jobName', 'Y'left(m.e.auftrag, 7)
call mapPut e, 'fun', 'import' rz
call mapPut e, 'subsys'
/* call mapPut e, 'mask', shrDummy(mapExp(e, m.e.impMask))
call mapPut e, 'ignore', shrDummy(mapExp(e, m.e.impIgno))
*/ call mapExpAll e, job, jc
end
if subsys = '*' then do
do wx=words(m.allSubs) by -1 to 1
restList = rz'.'word(m.allSubs,wx)','restList
end
iterate
end
if length(subsys) <> 4 then
call err 'ungueltiges db2SubSys' subsys 'im import' rz
call mapPut e, 'subsys', subsys
if rz = m.sysRz then
impCnt = impCnt + importAdd(job, subsys, opt, ic)
else if m.sysRz == 'RZ1' then
impCnt = impCnt + importAdd(job, rz'.'subsys, opt, ic)
else
call err 'cannot import into' rz 'from' m.sysRz
end
endProcedure import
/*--- add a single import to jcl in o --------------------------------*/
importAdd: procedure expose m.
parse upper arg o, rzSubSys, opt, ic
/* Uebergang altes auf neue Delta Merge Verfahren ++++++++ begin */
deltaNew = pos('DQ0G', rzSubSys) > 0
if deltaNew then do /* neues delta merge verfahren */
inDdn = 'DCHG'
call mapPut e, 'cType', "''''T''''"
end
else do /* altes delta merge verfahren */
inDdn = 'SRCDDN2'
call mapPut e, 'cType', "''''C''''"
end
call mapPut e, 'inDdn', inDdn
/* Uebergang altes auf neue Delta Merge Verfahren ++++++++ end */
if opt ^= '' & opt ^= '=' then do
nachAll = opt
end
else if symbol('m.imp.rzSubSys.nachtrag') ^== 'VAR' then do
nachAll = m.compares
end
else do
if opt = '=' then
la = left(m.imp.rzSubSys.nachtrag, 1)
else
la = right(m.imp.rzSubSys.nachtrag, 1)
cx = pos(la, m.compares)
if cx < 1 then
call err 'nachtrag' la 'von' rzSubSys m.rzSubSys.change ,
'nicht in Compare Liste' m.compares
nachAll = substr(m.compares, cx + (opt ^= '='))
end
if nachAll = ' ' then do
say 'alle Nachtraege schon importiert fuer' rzSubSys
return 0
end
if length(nachAll) = 1 then
nachVB = nachAll
else
nachVB = left(nachAll, 1)'-'right(nachAll, 1)
trgNm = ''
do nx=1 to m.nachtrag.0
if pos(m.nachtrag.nx, nachAll) < 1 then
iterate
act = namingConv('.', m.nachtrag.nx.trg)
if trgNm = '' then
trgNm = act
else if trgNm <> act then
call err 'targetNaming' trgNm 'wechselt zu' act ,
'fuer nachtrag' m.nachtrag.nx 'auf' m.nachtrag.nx.trg
end
m.imp.seq = m.imp.seq + 1
if length(m.imp.seq) > 3 then
call err 'import Sequenz Ueberlauf' m.imp.seq
m.imp.seq = right(m.imp.seq, 3, 0)
chaPre = m.e.auftrag'.'nachVB'.'m.imp.seq
call mapPut e, 'change', chaPre'.'m.e.zuegelSchub'.IMP'
call mapPut e, 'change', chaPre'.IMP'
call mapPut e, 'changeRem', 'zs' m.e.zuegelSchub ,
'auf' m.e.auftrag nachAll 'import DBX'
call mapPut e, 'deltaVers', chaPre'.DLT'
call namingConv '.', rzSubSys, 'impNm'
call namingConv m.scopeSrc.rz, m.scopeSrc.subsys, 'srcNm'
call mapPut e, 'trgNm', trgNm
call mapPut e, 'mask', shrDummy(mapExp(e, m.e.impMask))
call mapPut e, 'ignore', shrDummy(mapExp(e, m.e.impIgno))
cdlPds = m.libPre'.CDL'
call mapPut e, 'cdlPds', cdlPds
sto = mapExpAllAt(e, o, ic, 1, 1)
do while sto ^= ''
parse var sto lx cx
w = word(substr(m.ic.lx, cx), 1)
if w ^== '$@cdl' then do
call err 'unbekannte Anweisung' w 'in Zeile' cx m.ic.cx
end
else if deltaNew then do
do ix=1 to length(nachAll)
call mAdd o, left('//'inDdn || right(ix,3,0), 13) ,
|| 'DD DISP=SHR,DSN=',
|| cdlDsnCheck(substr(nachAll, ix, 1))
end
end
else do
le = left('//'inDdn, 13)
do ix=1 to length(nachAll)
call mAdd o, le || 'DD DISP=SHR,DSN=',
|| cdlDsnCheck(substr(nachAll, ix, 1))
le = left('//', 13)
end
end
sto = mapExpAllAt(e, o, ic, lx, cx + length(w))
end
call mAdd auftrag,
, addDateUs("import" rzSubsys nachAll chaPre".IMP")
return 1
endProcedure importAdd
/*--- DSN für CDL des Nachtrags zurückgeben und auf Existenz prüfen---*/
cdlDsnCheck: procedure expose m.
parse arg nt
cdl = m.libPre'.CDL('left(m.e.auftrag, 7) || nt')'
rr = sysDsn("'"cdl"'")
if rr <> 'OK' then
call err 'cdl fuer' nt'. Nachtrag fehlt:' cdl rr
return cdl
endProcedure cdlDsnCheck
/*--- Date und user rechtsbuendig einfuegen --------------------------*/
addDateUs: procedure expose m.
parse arg le
return le right(date(s) time() m.uNa, 71-length(le))
endProcedure addDateUs "'"
/*--- den aktuellen Auftrag analysieren ------------------------------*/
analyseAuftrag: procedure expose m.
m.scopeSrc.0 = 0
m.scopeSrc.subSys = m.mySub
m.scopeSrc.rz = m.myRz
m.catSrc.0 = ''
m.scopeTrg.0 = 0
m.scopeTrg.subSys = m.mySub
m.scopeTrg.rz = m.myRz
m.catTrg.0 = ''
m.imp.seq = -1
m.nacImp = 0
if m.auftrag.0 = 0 then
call err 'Auftrag ist leer'
vaWo = 'AUFTRAG'
varWo = 'ZUEGELSCHUB BESTELLER COMMASK' ,
'COMIGNO IMPMASK IMPIGNO'
ignWo = 'SW SENDWSL RECEIVEWSL RECEIVESOURCE'
ignCh = '*|'
lev1Wo = 'SCOPE SOURCE TARGET COMPARE VERSION IMPORT SENDTARGET' ,
varWo 'PROTOTYPERZ'
do lx=1 to m.auftrag.0
li = m.auftrag.lx
parse upper var li w1 w2 w3 .
if w1 = '' | pos(left(w1, 1), ignCh) > 0 ,
| wordPos(w1, ignWo) > 0 then
iterate
if wordPos(w1, vaWo) < 1 then
call err 'operation' w1 ', erwartet' vaWo 'in Zeile' lx li
w2 = translate(word(li, 2))
if w1 = 'AUFTRAG' then do
if w2 ^= m.auftrag.member then
call err 'auftrag' w2 '<> member' m.auftrag.member
m.e.auftrag = w2
m.e.nachtrag = '?'
m.nachtrag.0 = 0
if dataType(left(w3, 1), 'U') & length(w3) <= 8 then
ow = w3
else
ow = 'S100447'
call mapPut e, 'chgOwn', ow
vaWo = lev1Wo
end
else if wordPos(w1, varWo) > 0 then do
m.e.w1 = word(li, 2)
end
else if w1 = 'PROTOTYPERZ' then do /* alte syntax sep08 ??? */
m.scopeSrc.rz = word(li, 2)
end
else if wordPos(w1, 'SCOPE SOURCE TARGET') > 0 then do
suSy = ''
if w1 = 'SOURCE' then do
scp = 'SCOPESRC'
suSy = w2
end
else if w1 = 'TARGET' then do
scp = 'SCOPETRG'
if abbrev('EXPLICIT', w2, 2) then do
m.optAuto = 0
suSy = w3
end
else do
suSy = w2
if abbrev('EXPLICIT', w3, 2) then
m.optAuto = 0
end
end
else do /* alte syntax */
if abbrev('SOURCE', w2) then
scp = 'SCOPESRC'
else if abbrev('TARGET', w2) then
scp = 'SCOPETRG'
else
call err 'scope' w2 'nicht abk. von SOURCE TARGET',
'in Zeile' lx li
end
if (abbrev(suSy, 'DQ0') | abbrev(suSy, 'RZ1.DQ0')) ,
<> (m.libPre == 'DSN.DBQ') then
call err 'subSys' suSy 'mit Auftrag in' m.libPre
m.scp.0 = 0
if pos('.', suSy) > 0 then
parse var suSy suRz '.' suSy
else
suRZ = ''
if suSy <> '' then
m.scp.subsys = suSy
if suRz <> '' then
m.scp.rz = suRz
vaWo = m.scopeTypes lev1Wo
call debug 'scope' scp m.scp.rz'.'m.scp.subsys
end
else if wordPos(w1, m.scopeTypes) > 0 then do
parse value analyseScope(li) with ty nm qu
if ty = '?' then
call err nm qu 'in scope line' lx':' strip(li)
aa = mAdd(scp, 'scope')
m.aa.type = ty
m.aa.qual = qu
m.aa.name = nm
end
else if wordPos(w1, 'COMPARE VERSION SENDTARGET') > 0 then do
if w1 = 'SENDTARGET' then
w2 = w3
cmpLast = abbrev(w2, '=')
w2 = strip(w2, 'l', '=')
if length(w2) <> 1 | pos(w2, m.nachtragChars) < 1 then
call err 'nachtrag' w2 'in Zeile' lx li
if pos(w2, m.nachtragChars) ,
< pos(m.e.nachtrag, m.nachtragChars) then
call err 'nachtrag' w2 '< vorherigem' m.e.nachtrag ,
'in Zeile' lx li
if m.e.nachtrag <> w2 then do
m.e.nachtrag = w2
nx = mInc(nachtrag.0)
m.nachtrag.nx = w2
end
m.nachtrag.nx.fun = ''
m.nachtrag.nx.last = cmpLast
if pos(left(w1, 1), 'CV') > 0 then
m.nachtrag.nx.fun = left(w1, 1)
if abbrev(w3, "'") | pos('.', w3) < 1 then
t1 = m.myRz'.'m.mySub
else
t1 = w3
m.nachtrag.nx.trg = t1
call debug 'nachtr' nx m.nachtrag.nx 'trg' m.nachtrag.nx.trg
m.nacImp = (w1 <> 'COMPARE')
end
else if w1 = 'IMPORT' then do
parse upper var li . subsys nachAll chg .
if chgAuf <> m.e.auftrag then
if right(nachAll, 1) <> m.e.nachtrag then
call err 'aktueller Nachtrag' m.e.nachtrag ,
'aber import' nachAll 'in Zeile' lx li
parse var chg chgAuf '.' chgNac '.' chgSeq '.' chgImp
if chgAuf <> m.e.auftrag then
call err 'Auftrag mismatch in Zeile' lx li
if left(chgNac, 1) <> left(nachAll, 1) then
call err 'Nachtrag von mismatch in Zeile' lx li
if right(chgNac, 1) <> right(nachAll, 1) then
call err 'Nachtrag bis mismatch in Zeile' lx li
if chgImp ^== 'IMP' then
call err '.IMP mismatch in Zeile' lx li
if chgSeq <= m.imp.seq then
call fehl 'seq' chgSeq 'nicht > letzte' m.imp.seq,
'in Zeile' lx li
m.nacImp = 1
m.imp.subSys.nachtrag = nachAll
m.imp.subSys.change = chg
m.imp.seq = chgSeq
end
else do
call err 'ungültiger Operator' w1 'in Zeile' lx':' strip(li)
end
end
/* nachtrae durchgehen und kumulieren */
m.targets = ''
m.compares = ''
m.versions = ''
drop cmpLast
m.cmpLast = 0
do nx=1 to m.nachtrag.0
m.cmpLast = m.cmpLast | m.nachtrag.nx.last
if wordPos(m.nachtrag.nx.trg, m.targets) < 1 then
m.targets = m.targets m.nachtrag.nx.trg
if m.nachtrag.nx.fun = 'C' then
m.compares = m.compares || m.nachtrag.nx
if m.nachtrag.nx.fun = 'V' then
m.versions = m.versions || m.nachtrag.nx
call debug 'nachtrag' nx m.nachtrag.nx 'trg' m.nachtrag.nx.trg,
'all' m.targets 'fun' ,
m.nachtrag.nx.fun 'com' m.compares 'ver' m.versions,
'cmpLast' m.cmpLast
end
if 1 & abbrev(m.scopeSrc.subSys, 'DQ0') then
call db2Rel '910', 'P0'
if 0 then do
say 'auftrag ' m.e.auftrag m.e.nachtrag mapGet(e, 'chgOwn')
say ' comMask ' m.e.comMask
say ' comIgno ' m.e.comIgno
say ' impMask ' m.e.impMask
say ' impIgno ' m.e.impIgno
scp = 'SCOPESRC'
drop subsys
say ' scope ' m.scp.0 m.scp.subsys ,
' target ' m.scopeTrg.0 m.scopeTrg.subsys
do sx=1 to m.scp.0
say ' ' m.scp.sx.type m.scp.sx.qual'.'m.scp.sx.name
end
end
return
endProcedure analyseAuftrag
/*--- eine Scope Zeile analysieren -----------------------------------*/
analyseScope: procedure expose m.
parse arg li
parse upper var li ty w1 rest
if wordPos(ty, m.scopeTypes) < 1 then
return '?'
cx = pos('.', w1)
if cx < 1 then do
qu = w1
end
else do
qu =strip(left(w1, cx-1))
rest = substr(w1, cx) rest
end
if qu = '' then
return '? leerer Qualifier'
if ty = 'DB' then
return ty qu
if left(rest, 1) = '.' then
rest = substr(rest, 2)
nm = word(rest, 1)
if nm = '' then
return '? leerer Name'
return ty nm qu
endProcedure analyseScope
/*--- jcl generieren um Src und Trg Version und DDL zu extrahieren ---*/
extractSrcTrg: procedure expose m.
parse arg o, xx, oldSrc mbrLast
call readDsn m.libSkels'ExVe)', m.exVe.
call mapPut e, 'subsys', m.scopeSrc.subsys
call mapPut e, 'auto', xx'AUTO'
call mapPut e, 'src', xx'SRC'
call mapPut e, 'trg', xx'TRG'
mbrNac = mapGet(e, 'mbrNac')
call mapPut e, 'what', xx'SRC'
if ^ oldSrc then do
call extractScopeVersion o, exVe, xx, 'SRC'
end
else if mbrNac <> mbrLast then do
pr = m.libPre'.'xx'SRC'
call copyDsn pr'DDL('mbrLast')', pr'DDL('mbrNac')', 1
call copyDsn pr'CAT('mbrLast')', pr'CAT('mbrNac')', 1
end
call mapPut e, 'subsys', m.scopeTrg.subsys
call mapPut e, 'what', xx'TRG'
if m.optAuto then do
call readDsn m.libSkels'AutMa)', m.autoMap.
call readDsn m.libSkels'AutEx)', m.autoExt.
call mapExpAll e, o, autoMap
if m.sysRz = m.scopeTrg.rz then do
call mapExpAll e, o, autoExt
end
else do
mbrN = mapGet(e, 'mbrNac')
mark = mbrN'@'time()
autD = mapExp(e, '${libPre}.$auto($mbrNac)')
cf = mapExp(e, '${libPre}.SENDCF($mbrNac)')
sndIn = sendJob1(o, m.scopeTrg.rz, 'RECTRG',
, 'send' autD ,
, 'job -ddJob 600//??' cf mark ,
, 'receive' mapExp(e, '${libPre}.${what}DDL($mbrNac)') ,
, 'receive' mapExp(e, '${libPre}.${what}CAT($mbrNac)') )
call mapExpAll e, o, autoExt
call sendJob2 o, sndIn, cf mark
end
end
else do
call extractScopeVersion o, exVe, xx, 'TRG'
end
return
endProcedure extractSrcTrg
/*--- Version + DDL zu extrahieren -----------------------------------*/
extractScopeVersion: procedure expose m.
parse arg o, i, ty, what
scp = 'SCOPE'what
/* say m.scp.rz 'scp' scp */
if m.sysRz = m.scp.rz then do
call extractVersionStep o, i, ty, what
end
else do
mbrN = mapGet(e, 'mbrNac')
mark = mbrN'@'time()
cf = mapExp(e, '${libPre}.SENDCF($mbrNac)')
sndIn = sendJob1(o, m.scp.rz, 'RECSRC',
, 'job -ddJob 30//??' cf mark ,
, 'receive' mapExp(e, '${libPre}.${what}DDL($mbrNac)') ,
, 'receive' mapExp(e, '${libPre}.${what}CAT($mbrNac)') )
call extractVersionStep o, i, ty, what
call sendJob2 o, sndIn, cf mark
end
return
endProcedure extractScopeVersion
/*--- einen Step um Version + DDL zu extrahieren ---------------------*/
extractVersionStep: procedure expose m.
parse arg o, i, ty, what
scp = 'SCOPE'what
call mapPut e, 'what', ty || what
sto = mapExpAllAt(e, o, i, 1, 1)
do while sto ^== ''
parse var sto lx cx
w = word(substr(m.i.lx, cx), 1)
if w == '$@scope' then do
if ty == '' then do
do sx=1 to m.scp.0
sn = scp'.'sx
t = " TYPE = '"m.sn.type"',"
if m.sn.type <> 'DB' then
t = t "QUAL = '"m.sn.qual"',"
t = t "NAME = '"m.sn.name"';"
call mAdd o, t
end
end
else if ty == 'DB' then do
c = getDb2Catalog(what)
do x=1 to m.c.0
d1 = m.c.x.db
if db.d1 == 1 then
iterate
db.d1 = 1
call mAdd o, " TYPE = 'DB,' NAME = '"d1"';"
end
end
else
call err 'extractVersionStep bad ty' ty
end
else do
call err 'implement stop' sto 'word' w 'in line' lx m.i.lx
end
sto = mapExpAllAt(e, o, i, lx, cx + length(w))
end
return
endProcedure extractVersionStep
/*--- add jcl to stem o to send a job to rz toRz with stepname step
and add the remaining arguments as sendJob statements
afterwards the caller must add the jcl and call sendJob2 ----*/
sendJob1: procedure expose m.
parse arg o, toRz, step
oldRz = m.myRz
call configureRz toRz
call readDsn m.libSkels'SendJ)', m.sendJob.
call mapPut e, 'step', step
call mapExpAll e, o, sendJob
do ax=4 to arg()
call debug 'sendJob1 le' length(arg(ax)) arg(ax)'|'
call mAdd o, arg(ax) left('-', (ax < arg()))
end
call mAdd o, '//DDJOB DD *'
stReX = m.o.0+1
call readDsn m.libSkels || m.jobCard')', m.i.
call mapPut e, 'jobName', 'Y'left(m.e.auftrag, 7)
call mapPut e, 'fun', 'extract data from' toRz
call mapExpAll e, o, i
return oldRz stReX
endProcedure sendJob1
/*--- add the mark step to the job, translate leading // to ??
and switch back to original rz -----------------------------*/
sendJob2: procedure expose m.
parse arg o, oldRz stReX, cfMark
if cfMark ^= '' then do
call mAdd o, '// IF NOT ABEND' ,
'AND RC >= 0 AND RC <= 4 THEN'
call mapPut e, 'step', 'MARKOK'
call mapExpAll e, o, sendJob
call mAdd o, 'mark' cfMark 'okRc0'
call mAdd o, '// ELSE'
call mapPut e, 'step', 'MARKERR'
call mapExpAll e, o, sendJob
call mAdd o, 'mark' cfMark 'badRcOrAbend'
call mAdd o, '// ENDIF'
end
do ox = stReX to m.o.0
if abbrev(m.o.ox, '//') then
m.o.ox = overlay('??', m.o.ox)
end
call configureRz oldRz
return
endProcedure sendJob2
/*--- return Stem fuer die CatalogInfo für Src oder Trg
falls noetig aus Db2Catalog einlesen -----------------------*/
getDb2Catalog: procedure expose m.
parse arg wh
st = 'CAT'wh
if datatype(m.st.0, n) then
return st
else if m.st.0 ^== '' then
call err 'getDb2Catalog('wh') bad value m.'st'.0' m.st.0
scp = 'SCOPE'wh
call sqlConnect m.scp.subSys
call queryDb2Catalog st, wh
m.v9.0 = 0
if m.scp.subSys = 'DBAF' then
call queryDb2V9 st, 'V9'
call sqlDisconnect
return st
endProcedure getDb2Catalog
/*--- Information aus Db2Catalog fuer einen Scope einlesen -----------*/
queryDb2Catalog: procedure expose m.
parse arg st, what
scp = 'SCOPE'what
/* m.scopeTypes = 'DB TS TB VW IX AL' */
ts = ''
tb = ''
ix = ''
unQueried = 0
do sx=1 to m.scp.0
sn = scp'.'sx
t = " TYPE = '"m.sn.type"',"
if m.sn.type <> 'DB' then
t = t "QUAL = '"m.sn.qual"',"
t = t "NAME = '"m.sn.name"';"
call debug 'queryDb2Catalog' sx t
if m.sn.type = 'DB' then
ts = ts 'or s.dbName' sqlClause(m.sn.name)
else if m.sn.Type = 'TS' then
ts = ts 'or (s.dbName' sqlClause(m.sn.qual) ,
'and s.name' sqlClause(m.sn.name)')'
else if m.sn.Type = 'TB' then
tb = tb 'or (t.creator' sqlClause(m.sn.qual) ,
'and t.name' sqlClause(m.sn.name)')'
else if m.sn.Type = 'IX' then
ix = ix 'or (x.creator' sqlClause(m.sn.qual) ,
'and x.name' sqlClause(m.sn.name)')'
else if wordPos(m.sn.type, 'AL VW') > 0 then
unQueried = unQueried + 1
else
call err 'not implemented'
end
sel = 'select s.dbName, s.name, s.type, s.partitions, s.segSize,' ,
't.creator, t.name, t.status, t.tableStatus',
'from sysibm.sysTableSpace S, sysibm.sysTables T'
vFlds = 'db ts type partitions segSize',
'cr tb tbSta tbTbSta'
wh = "where s.dbName = t.dbName and s.name = t.tsName",
"and t.type = 'T'"
sql = ''
if ts <> '' then
sql = sql 'union' sel wh 'and ('substr(ts, 5)')'
call debug 'ts sql' sql
if tb <> '' then
sql = sql 'union' sel wh 'and ('substr(tb, 5)')'
call debug 'tb sql' sql
if ix <> '' then
sql = sql 'union' sel ', SYSIBM.SYSINDEXES X',
wh 'and t.creator=x.tbCreator and t.name=x.tbName',
'and ('substr(ix, 5)')'
call debug 'ix sql' sql
if sql = '' then do
m.st.0 = 0
if unQueried < 1 then
say 'nothing specified in source scope'
return 0
end
drop db ts cr tb type
call sqlPreAllCl 1, substr(sql, 8), st, sqlVars('M.st.sx', vFlds)
if m.debug == 1 then do
say m.st.0
do sx = 1 to m.st.0
say strip(m.st.sx.db)'.'strip(m.st.sx.ts) m.st.sx.type ,
m.st.sx.partitions m.st.sx.segSize
end
end
return m.st.0
endProcedure queryDb2Catalog
/*--- haben wir schon DB2 V9 Objekte ? -------------------------------*/
queryDb2V9: procedure expose m.
parse arg sc, vv
m.vv.0 = 0
wh =''
do x = 1 to m.sc.0
wh = wh "or (cr='"m.sc.x.cr"' and tb='"m.sc.x.tb"')"
end
if wh == '' then
return 0
sql = "select tp,nm,v9",
"from s100447.db2v9",
"where V9 <> '' and (" substr(wh, 5) ")",
"order by cr,tb,cl"
call sqlPreAllCl 1, sql, vv, ":m.st.sx.tp,:m.st.sx.nm,:m.st.sx.v9"
return m.vv.0
endProcedure queryDb2V9
/*--- Qualitaets Pruefung fuer CatalogInfo Stem c --------------------*/
qualityCheck: procedure expose m.
parse arg c
if m.libPre <> 'DSN.DBQ' then
call maskIni
o = 'AUFTRAG'
m.o.orig = 'rmQu' m.o.orig
m.spezialFall.done = ''
aufOld = m.o.0
do x=1 to m.c.0
vDb = strip(m.c.x.db)
n = '|| db' vDb
if d.n ^== 1 then do
d.n = 1
call spezialfall vDb, substr(n, 4)
end
n = '|| ts' vDb'.'strip(m.c.x.ts)
if d.n ^== 1 then do
d.n = 1
call spezialfall vDb, substr(n, 4)
if m.c.x.partitions > 0 then
nop
else if m.c.x.segSize = 0 then
call mAdd o, n 'simple TS'
end
n = '|| tb' strip(m.c.x.cr)'.'strip(m.c.x.tb)
if d.n ^== 1 then do
d.n = 1
call spezialfall vDb, substr(n, 4)
if m.c.x.tbTbSta = 'L' then
call mAdd o, n 'auxilary index oder table fehlt'
else if m.c.x.tbTbSta = 'P' then
call mAdd o, n 'primary index fehlt'
else if m.c.x.tbTbSta = 'R' then
call mAdd o, n 'index auf Row ID fehlt'
else if m.c.x.tbTbSta = 'U' then
call mAdd o, n 'index auf unique key fehlt'
else if m.c.x.tbTbSta = 'V' then
call mAdd o, n 'Regenerierung interne ViewDarstellung'
else if m.c.x.tbTbSta ^= '' then
call mAdd o, n 'TableStatus' m.c.x.tbTbSta 'unbekannt'
end
end
do vx=1 to m.v9.0
call mAdd o, '|| V9' m.v9.vx.tp left(m.v9.vx.nm, 30) ,
left(m.v9.vx.v9, 30)
end
return aufOld < m.o.0
endProcedure qualityCheck
/*--- für jedes Objekt aus Source Scope Eintrage in der
Spezialfall Library suchen und falls vorhanden anzeigen --------*/
spezialFall: procedure expose m.
parse upper arg db, typ qua '.' nam
if m.libPre = 'DSN.DBQ' then
return
pDb = mask2prod('DBNAME', db)
if (typ = 'DB' | typ = 'TS') & db <> qua then
call err 'db mismatch spezialFall('db',' typ qua'.'nam')'
if typ = 'DB' then
srch = typ pDb'.'
else if typ = 'TS' then
srch = typ pDb'.'mask2prod('TSNAME', nam)
else if typ = 'TB' then
srch = typ mask2prod('TBOWNER', qua)'.'mask2prod('TBNAME', nam)
else
call err 'bad typ' typ
st = spezialFall'.'pDb
if symbol('m.st.0') <> 'VAR' then do
dsn = m.libSpezial"("pDb")"
sy = sysDsn("'"dsn"'")
if sy <> 'OK' then do
m.st.0 = 0
if sy <> 'MEMBER NOT FOUND' then
call err 'spezialFall library' dsn':' sy
end
else do
call readDsn dsn, 'M.SPEZIALFALL.'pDB'.'
end
end
if m.st.0 < 1 then
return
offs = 999
found = 0
do sx = 1 to m.st.0
fx = verify(m.st.sx, ' ')
if fx = 0 | fx > 72 then
iterate
if substr(m.st.sx, fx, 1) = '*' then
iterate
if fx <= offs then do
offs = fx
m.st.sx = left(m.st.sx, 72)
n = ''
if pos('.', m.st.sx) > 0 then
parse upper var m.st.sx t q '.' n .
else
parse upper var m.st.sx t q .
if wordPos(t, 'DB TS TB') < 1 then
call err 'spezialFall' pDb 'line' sx 'ungueltig:' m.st.sx
found = match(srch, t strip(q)'.'strip(n)) ,
& ^ (wordPos(pDb'.'sx, m.spezialFall.done) > 0)
if found then
m.spezialFall.done = m.spezialFall.done pDb'.'sx
end
if found then
call mAdd auftrag, '|-'left(m.st.sx, 78)
end
return
endProcedure spezialFall
/*--- mask handling initialise ---------------------------------------*/
maskIni: procedure expose m.
call maskHierarchy
call maskRead mask.prot, m.libPre'.MASK(PROTDBAF)'
call maskRead mask.dbof, m.libPre'.MASK(DBAFDBOF)'
return
endProcedure maskIni
/*--- mask test functions --------------------------------------------*/
testMask: procedure expose m.
call maskIni
call maskTT OWNER, GDB9998
call maskTT DBNAME, DGDB9998
call maskTT DBNAME, DGDB0287
call maskTT OWNER, GDB0301
call maskTT TSNAME, AGRFX12A2
call maskTT OWNER, SYS123EF
return 0
endProcedure testMask
maskTT: procedure expose m.
parse arg ty, na
say 'maskTrans(prot,' ty',' na') =' maskTrans(mask.prot, ty, na) ,
' -> DBOF' maskTrans(mask.dbof, ty, maskTrans(mask.prot,ty,na))
return
/*--- translate a prototype object to DBOF naming -------------------*/
mask2Prod: procedure expose m.
parse arg ty, na
return translate(strip(,
maskTrans(mask.dbof, ty, maskTrans(mask.prot,ty,na))))
/*--- translate an object of type ty and name na
by the masking file in st --------------------------------*/
maskTrans: procedure expose m.
parse arg st, ty, na
if symbol('m.mask.hier.ty') <> 'VAR' then
call err 'bad type' ty
types = m.mask.hier.ty
do sx=1 to m.st.0
if wordPos(m.st.sx.typ, types) < 1 then
iterate
if match(na, m.st.sx.in, vv) then
return matchTrans(m.st.sx.out, vv)
end
return na
endProcedure maskTrans
/*--- read and analyse the masking file dsn into stem st ------------*/
maskRead: procedure expose m.
parse arg st, dsn
maskIgno = 'COMPRESS SEGSIZE'
call readDsn dsn, i.
j = 0
do i=1 to i.0
parse var i.i t ':' s ',' d
t = strip(t)
if symbol('m.mask.hier.t') == 'VAR' then
nop
else if wordPos(t, maskIgno) > 0 then
iterate
else
call err 'bad typ' t 'in maskline' i':' i.i
j = j+1
m.st.j.typ = t
m.st.j.in = strip(s)
m.st.j.out = word(d, 1)
end
m.st.0 = j
return
drop typ in out
do wx=1 to m.st.0
say wx m.st.wx.typ':' m.st.wx.in'==>'m.st.wx.out'|'
end
endProcedure maskRead
/*--- initialise the type hierarchy of masking
as input use the msgLines of the mask editor --------------*/
maskHierarchy: procedure expose m.
/* copy der hierarch aus masking template */
call mAdd mCut('T', 0) ,
, 'COLNAME ' ,
, 'NAME ' ,
, ' DBNAME,TSNAME,TBNAME,IXNAME,UDFNAME, ' ,
, ' UDTNAME,COLLNAME,PKGNAME,PGMNAME,PLNNAME ' ,
, ' DBRMNAME,STPNAME,SFNAME,TGNAME,GRPNAME, ' ,
, ' VCATNAME,GBPNAME ' ,
, ' BPNAME ' ,
, ' TSBPNAME,IXBPNAME ' ,
, ' SGNAME ' ,
, ' TSSGNAME,IXSGNAME ' ,
, 'AUTHID ' ,
, ' SQLID,SCHEMA ' ,
, ' OWNER ' ,
, ' DBOWNER,TSOWNER,TBOWNER,IXOWNER ' ,
, ' GRANTID ' ,
, ' GRANTOR,GRANTEE '
qx = 0
lOff = -1
m.mask.hier = ''
do x=1 to m.t.0
of = verify(m.t.x, ' ', 'n')
li = translate(m.t.x, ' ', ',')
do while qx > 0 & word(q.qx, 1) >= of
qx = qx -1
end
px = qx - 1
if (qx = 0 | of > word(q.qx, 1)) & words(li) = 1 then do
px = qx
qx = qx + 1
if qx = 1 then
q.qx = of word(li, 1)
else
q.qx = of word(li, 1) subword(q.px, 2)
end
do wx=1 to words(li)
w1 = word(li, wx)
m.mask.hier = m.mask.hier w1
if wordPos(w1, subWord(q.qx, 2)) < 1 then
m.mask.hier.w1 = w1 subWord(q.qx, 2)
else
m.mask.hier.w1 = subWord(q.qx, 2)
end
end
return
endProcedure maskHierarchy
/*--- Funktion q: scope Zeilen pruefen -------------------------------*/
queryScope: procedure expose m.
parse arg subSys
if subSys = '' then
subSys = m.mySub
call sqlConnect subSys
rf = 1
if adrEdit('(rl) = lineNum .zl', 4) = 4 then
rl = 0
if ^ m.editMacro then
call err 'q nicht als Macro'
if ^ m.editProc then do
if adrEdit('PROCESS RANGE Q', 0 4) = 0 then do
call adrEdit '(rf) = lineNum .zfrange'
call adrEdit '(rl) = lineNum .zlrange'
end
m.editProc = 1
end
do rx = rf by 1 while rx <= rl
call adrEdit '(li) = line' rx
parse value analyseScope(li) with ty nm qu
if ty = '?' then do
if nm <> '' then
say nm qu 'in line' rx':' strip(li)
iterate
end
call expandScope mCut(qq, 0), ty, qu, nm
neu = m.qq.1
if adrEdit("line" rx "= (neu)", 4) = 4 then
say 'truncation line' rx':' neu
do qx=2 to m.qq.0
neu = m.qq.qx
if adrEdit("line_after" rx "= (neu)", 4) = 4 then
say 'truncation line' rx':' neu
rx = rx+1
rl = rl+1
end
end
call sqlDisConnect
return 0
endProcedure queryScope
/*--- einen Scope Ausdruck expandieren -------------------------------*/
expandScope: procedure expose m.
parse arg o, ty, qu, nm
c = 'ni'
if ty = 'IX' then do
sql = 'select creator, name, tbCreator, tbName' ,
'from sysibm.sysIndexes' ,
'where creator' sqlClause(qu),
'and name' sqlClause(nm)
call sqlPreOpen 1, sql
do c=0 by 1 while sqlFetchInto(1, ':cr, :ix, :tc, :tb')
call mAdd o, ty lefA(strip(cr)'.'strip(ix), 30) ,
'tb' strip(tc)'.'strip(tb)
end
call sqlClose 1
end
else if ty = 'TB' | ty = 'VW' | ty = 'AL' then do
if ty = 'AL' then
sql = 'location, tbCreator, tbName'
else
sql = "'', dbName, tsName"
sql = 'select creator, name,' sql,
'from sysibm.systables' ,
'where type =' quote(left(ty, 1), "'"),
'and creator' sqlClause(qu),
'and name' sqlClause(nm)
call sqlPreOpen 1, sql
do c=0 by 1 while sqlFetchInto(1, ':cr, :tb, :lo, :db, :ts')
info = strip(db)'.'strip(ts)
if lo <> '' then
info = strip(lo) || '.' || info
if ty = 'AL' then
info = 'for' info
else
info = 'ts' info
call mAdd o, ty lefA(strip(cr)'.'strip(tb), 30) info
end
call sqlClose 1
end
else if ty = 'TS' then do
sql = 'select creator, name, dbName, tsName' ,
'from sysibm.systables' ,
'where type = ''T'' and dbName' sqlClause(qu),
'and tsName' sqlClause(nm)
call sqlPreOpen 1, sql
do c=0 by 1 while sqlFetchInto(1, ':cr, :tb, :db, :ts')
call mAdd o, ty lefA(strip(db)'.'strip(ts), 30) ,
'tb' strip(cr)'.'strip(tb)
end
call sqlClose 1
end
if c = 0 then
call mAdd o, ty lefA(strip(qu)'.'strip(nm), 30) ,
'* nicht gefunden'
else if c = 'ni' then
call mAdd o, ty left(qu'.'nm, 30) '* query nicht implementiert'
else if m.o.0 < 1 then
call err 'no expand for' ty qu'.'nm
return
endProcedure expandScope
/*--- return sql condition (= String oder like String) ---------------*/
sqlClause: procedure expose m.
parse arg val
val = translate(val, '%_', '*?')
if verify(val, '%_', 'm') > 0 then
return 'like' quote(val, "'")
else
return '=' quote(val, "'")
endProcedure sqlClause
lefA: procedure expose m.
parse arg s, len
if length(s) < len then
return left(s, len)
else
return s
endProcedure lefA
/*--- copy srcDdl und srcCat aus anderem rz --------------------------*/
receiveSource: procedure expose m.
parse arg rz
if rz = '' | rz = '*' | rz = m.myRz then
call err 'rs receiveSource mit ungueltigem rz' rz
call readAuftrag rz, m.auftrag.dataset, m.e.auftrag
call analyseAuftrag
if m.e.nachtrag = '?' then
call err 'keine Version in Auftrag' m.e.auftrag 'im' rz
nacMbr = left(m.e.auftrag, 7) || m.e.nachtrag
call csmCopy rz'/'m.libPre'.srcDdl('nacMbr')', m.libPre'.'rz'DDL'
call csmCopy rz'/'m.libPre'.srcCat('nacMbr')', m.libPre'.'rz'Cat'
call readAuftrag , m.auftrag.dataset, m.auftrag
call mAdd auftrag, addDateUs('receiveSource' rz,
m.libPre'.'rz'Cat('nacMbr')')
return
endProcedure receiveSource
/*--- copy wsl aus anderem rz ----------------------------------------*/
receiveWSL: procedure expose m.
parse arg rz
if rz = m.myRz then
rz = ''
call analyseAuftrag
sWsl = 'dsn.dba.clon.wsl('left(m.e.auftrag, 7)'Q)'
sIff = 'dsn.dba.'left(m.e.auftrag, 7)'Q.IFF'
if rz <> '' then do
call csmCopy rz'/'sWsl, sWsl
if adrCsm("dslist SYSTEM("rz") DSNMASK('"sIff"') SHORT", 4) = 0,
& stemSize = 1 then
call csmCopy rz'/'sIff, sIff
else
say 'iff existiert nicht im' rz
end
call cloneWsl '', m.e.auftrag, 1
call mAdd auftrag, addDateUs('receiveWSL' rz)
return
endProcedure receiveWSL
/*--- send wsl to the argument rz ------------------------------------*/
sendWSL: procedure expose m.
parse arg rz
if rz = m.myRz then
rz = ''
call analyseAuftrag
if m.versions = '' | m.compares <> '' then
call warn 'sendWSL ohne versions oder mit compares'
sWsl = 'dsn.dba.clon.wsl('left(m.e.auftrag, 7)'Q)'
sIff = 'dsn.dba.'left(m.e.auftrag, 7)'Q.IFF'
if sysDsn("'"sWsl"'") <> 'OK' then
call err 'source wsl fehlt:' sWsl sysDsn("'"sWsl"'")
if rz <> '' then do
call csmCopy sWsl, rz'/'sWsl
if sysDsn("'"sIff"'") <> 'OK' then
say 'iff existiert nicht' sIff sysDsn("'"sIff"'")
else
call csmCopy sIff, rz'/'sIff
end
call cloneWsl rz, m.e.auftrag, 1
call mAdd auftrag, addDateUs('sendWSL' rz)
return
endProcedure sendWSL
/*--- clone a wsl mbr in the rz sys,
if doRemove=1 remove old members first ---------------------*/
cloneWsl: procedure expose m.
parse arg sys, mbr, doRemove
/* copy multi clone jcl from target rz */
jcl = csmSysDsn(sys'/DSN.DBA.MULTI.CLONE'right(mbr, 1)'.JCL', 0)
CALL READdsn jcl, m.jj.
/* modify the jcl */
do jx=1 to m.jj.0
if word(m.jj.jx, 2) == '=' then do
if word(m.jj.jx, 1) = 'SRCWSLST' then
m.jj.jx = 'SRCWSLST =' left(mbr, 7)'Q'
else if word(m.jj.jx, 1) = 'CLNWSLST' then
m.jj.jx = 'CLNWSLST =' mbr
end
else if space(subword(m.jj.jx, 1, 2) ,1) ,
== '//DELMBRIF IF' then do
m.jj.jx = '//DELMBRIF IF RC =' (7 *(^doRemove)) 'THEN'
end
else if word(m.jj.jx, 1) == 'DELETE' then do
nm = word(m.jj.jx, 2)
cx = pos('(', nm)
if right(nm, 1) = ')' & cx > 0 then
m.jj.jx = ' DELETE' left(nm, cx)mbr')'
else
call err 'bad delete' jx m.jj.jx
end
end
call writeSub jj, sys, 1
return 0
endProcedure cloneWsl
warn:
say '*** warning:' arg(1)
return
endSubroutine warn
/* copy match begin ***************************************************/
/************************************* begin copy match ******/
/*--- wildCard matching with the following wildchars:
* 0-n chars
? 1 char
fill matched expressions instem st if st is non empty
return 1 if mask matches wert ----------------------------------*/
match: procedure expose m.
parse arg wert, mask, st
if st == '' then
return matchRO(wert, mask)
m.st.0 = -9
return matchSt(wert, mask, st, 0)
endProcedure match
/*--- return the fixed prefix of maskt -------------------------------*/
matchPref: procedure
arg mask, suff
ix = verify(mask, '*?', 'm')
if ix = 0 then
return mask
else
return left(mask, ix-1)suff
endProcedure matchPref
/*--- return true if mask matches wert -------------------------------*/
matchRO: procedure
arg wert, mask
ix = verify(mask, '*?', 'm')
if ix < 1 then return (mask == wert)
if length(wert) < ix-1 then return 0
if left(mask, ix-1) ^== left(wert, ix-1) then return 0
if substr(mask, ix, 1) == '?' then do
if length(wert) < ix then return 0
return matchRO(substr(wert, ix+1), substr(mask, ix+1))
end
mask = substr(mask, ix+1) /* * 0 - n Chars */
do ex = 1+length(wert) to ix by -1
if matchRO(substr(wert, ex), mask) then return 1
end
return 0
endProcedure matchRO
/*--- wildCard matching: fill matched expressions instem st
return 1 if mask matches wert ----------------------------------*/
matchSt: procedure expose m.
parse arg wert, mask, st, sx
ix = verify(mask, '*?', 'm')
if ix < 1 then do
if mask ^== wert then
return 0
m.st.0 = sx
return 1
end
if ^ abbrev(wert, left(mask, ix-1)) then
return 0
reMa = substr(mask, ix+1)
sx = sx + 1
if substr(mask, ix, 1) == '?' then do /* ? 1 Character */
if length(wert) < ix then
return 0
m.st.sx = substr(wert, ix, 1)
return matchSt(substr(wert, ix+1), reMa, st, sx)
end
do lx = 1+length(wert) to ix by -1 /* greedy: from all to empty */
if matchSt(substr(wert, lx), reMa, st, sx) then do
m.st.sx = substr(wert, ix, lx-ix)
return 1
end
end
return 0
endProcedure matchSt
matchTrans: procedure expose m.
parse arg mask, st
r = ''
ox = 1
sx = 0
ix = verify(mask, '*?', 'm')
do sx=1 to m.st.0 while ix > 0
if sx > m.st.0 then
call err 'matchTrans('mask',' st') has only' ,
m.st.0 'variables'
r = r || substr(mask, ox, ix-ox)m.st.sx
ox = ix+1
ix = verify(mask, '*?', 'm', ox)
end
if ix > 0 then
call err 'matchTrans('mask',' st') has only' ,
m.st.0 'variables'
return r || substr(mask, ox)
endProcedure matchTrans
/* copy match end *****************************************************/
/* copy csm begin ******************************************************
interface to csm,
it is integrate with adrTso, eg. dsnAlloc , 'RZ3/..' uses csm
***********************************************************************/
adrCsm:
return adrTso('csmExec' arg(1), arg(2))
endProcedure adrCsm
csmCopy: procedure expose m.
parse arg csnFr, csnTo, ggRet
if dsnGetMbr(csnTo) ^= '' ,
& dsnGetMbr(csnFr) <> dsnGetMbr(csnTo) then
call err 'member rename' csnFr 'to' csnTo
parse value csmSysDsn(csnFr) with sysFr '/' dsnFr
parse value csmSysDsn(csnTo) with sysTo '/' dsnTo
if sysFr = '*' & sysTo <> '*' then do
pdsTo = dsnSetMbr(dsnTo)
al = "SYSTEM("sysTo") DDNAME(COPYTo)",
"DATASET('"pdsTo"') DISP(SHR)"
alRes = dsnAlloc(systo'/'pdsTo, ,'COPYTO', '*')
if datatype(alRes, 'n') then do
/* wir müssen es selbst allozieren csmxUtil
vergisst management class ||||| */
say 'could not allocate' al
say 'trying to create'
rc = listDsi("'"dsnSetMbr(dsnFr)"' SMSINFO")
if rc ^= 0 then
call err 'listDsi rc' rc 'reason' sysReason,
sysMsgLvl1 sysMsgLvl2
al = left(al, length(al)-4)'CAT)'
if right(sysDsSms, 7) == 'LIBRARY' ,
| abbrev(sysDsSms, 'PDS') then
al = al 'DSNTYPE(LIBRARY)'
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")",
"RECFM("sysREcFM") LRECL("SYSLRECL")",
"blksize("sysBLkSIZE")",
"SPACE("sysPrimary"," sysSeconds")" sysUnits
call adrCsm "allocate" al
end
call adrTso 'free dd(copyTo)'
end
c = "'COPY" sysFr"/''"dsnFr"'' TO" ,
sysTo"/''"dsnSetMbr(dsnTo)"'' REPLACE'"
return adrTso("exec 'CSM.DIV.P0.EXEC(CSRXUTIL)'" c , ggRet)
return
endProcedure csmCopy
csmAlloc: procedure expose m.
parse upper arg dd, disp, dsn, rest, nn, retRc
sys = ''
al = ''
parse value csmSysDsn(dsn) with sys '/' dsn
if disp = '' then
disp = 'shr'
al = "SYSTEM("sys") DDNAME("dd")"
if abbrev(disp, 'SYSOUT(') then
al = al disp
else
al = al "DISP("disp")"
if dsn <> '' then do
al = al "DATASET('"dsnSetMbr(dsn)"')"
mbr = dsnGetMbr(dsn)
if mbr <> '' then
al = al 'MEMBER('mbr')'
end
if retRc <> '' | nn = '' then do
alRc = adrCsm('allocate' al rest, retRc)
if alRc <> 0 then
return alRc
return dd 'call adrTso "free dd('dd')";'
end
do retry=0 to 1
alRc = adrCsm(al rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if nn = '' | wordPos(disp, 'OLD SHR') < 1 then,
leave
say 'csmAlloc rc' alRc 'for' al rest '...trying to create'
call adrCsm 'allocate' left(al, length(al)-4)'CAT)' ,
dsnCreateAtts(dsn, nn)
call adrTso 'free dd('dd')'
end
call err 'cmsAlloc rc' alRc 'for' al rest
endProcedure csmAlloc
csmSysDsn: procedure expose m.
parse upper arg dsn, withStar
if pos('/', dsn) < 1 then
sys = '*'
else
parse var dsn sys '/' dsn
if sys <> '' & sys <> '*' & sys <> sysvar(sysnode) then
return sys'/'dsn
else if withStar == 0 then
return dsn
else
return '*/'dsn
endProcedure csmSysDsn
/* copy csm end********************************************************/
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure expose m.
parse arg ggSys, ggRetCon
call sqlIni
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
if ggSys = '-' then
return 0
return sqlExec("connect" ggSys, ggRetCon ,1)
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure expose m.
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql end **************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = ''
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
if abbrev(a, 'MAP.') then do
do kx=1 to m.map.loKy.a.0
drop m.map.loKy.a.kx m.map.loVa.a.kx
end
m.map.loKy.a.0 = 0
end
return a
endProcedure mapClear
/*--- return a stem of all keys (including removed ones) -------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
if mapValAdr(a, ky) ^== '' then
call err 'duplicate key in mAdd('a',' ky',' val')'
if length(ky) < 200 then do
m.a.ky = val
end
else do
kx = mInc('MAP.LOKY.'a'.0')
m.map.loKy.a.kx = ky
m.map.loVa.a.kx = val
end
if m.map.keys.a ^== '' then
return mAdd(m.map.keys.a, ky)
return
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky)
if vv ^== '' then
m.vv = val
else
call mapAdd a, ky, val
return val
endProcedure mapPut
/*--- return the value pointer for a key, '' if non existang ---------*/
mapValAdr: procedure expose m.
parse arg a, ky
if length(ky) < 200 then do
if symbol('m.a.ky') == 'VAR' then
return a'.'ky
end
else if ^ abbrev(a, 'MAP.') then do
call err 'key too long mapValAdr('a',' ky')'
end
else do
do kx=1 to m.map.loKy.a.0
if m.map.loKy.a.kx == ky then
return 'MAP.LOVA.'a'.'kx
end
end
return ''
endProcedure mapValAdr
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if abbrev(vv, 'MAP.LOVA.') then
call err 'not implemented mapRemove('a',' ky')'
drop m.a.ky
return val
endProcedure mapRemove
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a,
fail if it does not exist ----------------------------------*/
mapGet: procedure expose m.
parse arg a, ky, noKey
vv = mapValAdr(a, ky)
if vv == '' then
call err 'missing key in mapGet('a',' ky')'
return m.vv
endProcedure mapGet
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy mapExp begin **************************************************/
mapVia: procedure expose m.
parse arg a, ky
sx = pos('*', ky)
if sx < 1 then
return mapGet(a, ky)
via = mapGet(a, left(ky, sx-1))
do while sx <= length(ky)
fx = sx+1
sx = pos('*', ky, fx)
if sx < 1 then
sx = length(ky) + 1
if sx = fx then do
if symbol('m.via') ^== 'VAR' then
call err 'missing m.'via 'at' sx 'in mapVia('a',' ky')'
via = m.via
end
else do
f = substr(ky, fx, sx - fx)
if symbol('m.via.f') ^== 'VAR' then
call err 'missing m.'via'.'f ,
'at' sx 'in mapVia('a',' ky')'
via = m.via.f
end
end
return via
endProcedure mapVia
mapExpAt: procedure expose m.
parse arg a, src, sx
m.map.ExpAt = 0
cx = pos('$', src, sx)
if cx < 1 then
return substr(src, sx)
res = substr(src, sx, cx-sx)
do forever
if substr(src, cx+1, 1) = '{' then do
ex = pos('}', src, cx+2)
if ex < 1 then
call err 'missing } after' substr(src, cx) 'in' src
res = res || mapVia(a, strip(substr(src, cx+2, ex-cx-2)))
ex = ex + 1
end
else do
ex = verify(src, m.mAlfDot, 'n', cx+1)
if ex < 1 then
return res || mapVia(a, substr(src, cx+1))
if ex = cx+1 then do
m.map.ExpAt = cx
return res
end
res = res || mapVia(a, substr(src, cx+1, ex-cx-1))
end
cx = pos('$', src, ex)
if cx < 1 then
return res || substr(src, ex)
res = res || substr(src, ex, cx-ex)
end
endProcedure mapExpAt
mapExp: procedure expose m.
parse arg a, src
res = mapExpAt(a, src, 1)
if m.map.ExpAt ^== 0 then
call err 'mapExp stopped at' substr(src, map.ExpAt) 'in' src
return res
endProcedure mapExp
mapExpAllAt: procedure expose m.
parse arg a, dst, src, sx, cx
do while sx <= m.src.0
li = mapExpAt(a, m.src.sx, cx)
dx = m.map.ExpAt
if (cx=1 & dx = 0) | li ^= '' then
call mAdd dst, li
if dx = 0 then do
cx = 1
sx = sx+1
end
else do
return sx dx
end
end
return ''
endProcedure mapExpAllAt
mapExpAll: procedure expose m.
parse arg a, dst, src
sto = mapExpAllAt(a, dst, src, 1, 1)
if sto == '' then
return
lx = word(sto, 1)
call err 'mapExpAll stopped at' sto':' m.src.lx
endProcedure mapExpAll
/* copy mapExp end ****************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m end *********************************************************/
/* 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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
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 expose m.
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 by 1
alRc = adrTso(c rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for' c rest
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
endProcedure tsoAlloc
dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
bl = 32760
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
recfm='f b'
bl = bl - (bl // rl)
end
else do
if rl = '' then
rl = bl-4
recfm = substr(atts, 2, 1) 'B'
end
end
if pos('(', dsn) > 0 then
po = 'dsntype(library) dsorg(po)'
else
po = ''
dsn = dsnSetMbr(dsn)
if forCsm == 1 then
return "dataset('"dsn"')" po,
"recfm("space(recfm, 0)") lrecl("rl") blkSize("bl")" ,
"mgmtclas(s005y000) space(10, 1000) cylinder"
else
return "dsn('"dsn"')" po,
"recfm("recfm") lrecl("rl") block("bl")" ,
"mgmtclas(s005y000) 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
copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
call readDDBegin word(frDD, 1)
call writeDDBegin word(toDD, 1)
cnt = 0
do while readDD(word(frDD, 1), r.)
call writeDD word(toDD, 1), r.
cnt = cnt + r.0
end
call readDDEnd word(frDD, 1)
call writeDDEnd word(toDD, 1)
interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
if ggSay == 1 | m.debug == 1 then
say cnt 'records copied from' frSpec 'to' to toSpec
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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(DBXCDL) cre=2008-09-09 mod=2008-09-09-18.22.24 F540769 ---
dsn = dsn.dbx.cdl
id = lmmBegin(dsn)
list = ''
i2 = 9999
len = 0
do forever
m = lmmNext(id)
say m
if m = test1 then
iterate
if m = '' then
leave
call readDsn dsn'('m')', i.
do x = 1 to i.0
w1 = word(i.x, 1)
if wordPos(w1, list) < 1 then do
list = list w1
$£ list 'in' x m':' strip(i.x)
end
ii = wordIndex(i.x, 2)
if ii > 0 & ii < max(i2, 11) then do
i2 = ii
$£ 'i2' i2 'in' x m':' strip(i.x)
end
if len < length(i.x) then do
len = length(i.x)
$£ 'len' len 'in' x m':' strip(i.x)
end
end
end
$***out 20080909 18:07:27
SQLID in 1 AAAAAAA1: SQLID SET CURRENT SQLID = 'S100447' ;
i2 11 in 1 AAAAAAA1: SQLID SET CURRENT SQLID = 'S100447' ;
len 80 in 1 AAAAAAA1: SQLID SET CURRENT SQLID = 'S100447' ;
SQLID CREATE in 2 AAAAAAA1: CREATE CREATE TABLESPACE A401A
SQLID CREATE ALTER in 2 AAAAAAA3: ALTER ADMIN ALTER TABLE A540769.TWK401A
SQLID CREATE ALTER DROP in 2 AU020010: DROP ADMIN DROP TABLESPACE AU02A1A.
i2 9 in 83 AU020010: CREATE TH DEFAULT BEFORE AU180020;
i2 9 in 86 AU020010: CREATE TH DEFAULT BEFORE AU180020;
i2 9 in 89 AU020010: CREATE U180020;
i2 9 in 107 AU020010: CREATE TH DEFAULT BEFORE AU181020;
i2 9 in 110 AU020010: CREATE TH DEFAULT BEFORE AU181020;
i2 9 in 113 AU020010: CREATE U181020;
i2 9 in 131 AU020010: CREATE TH DEFAULT BEFORE AU190020;
i2 9 in 134 AU020010: CREATE TH DEFAULT BEFORE AU190020;
i2 9 in 137 AU020010: CREATE U190020;
i2 9 in 155 AU020010: CREATE TH DEFAULT BEFORE AU191020;
i2 9 in 158 AU020010: CREATE TH DEFAULT BEFORE AU191020;
i2 9 in 161 AU020010: CREATE U191020;
SQLID CREATE ALTER DROP SQL in 2 AV050020: SQL ALTER TABLE "OA1A"."TAV503A1" AD
i2 5 in 2 AV050020: SQL ALTER TABLE "OA1A"."TAV503A1" ADD "AV503102"
i2 5 in 3 AV050020: SQL DATE WITH DEFAULT NULL;
i2 9 in 4 LERZ0002: ALTER TH DEFAULT BEFORE FELD4;
i2 9 in 4 NI021060: CREATE --#SET TERMINATOR ?
i2 9 in 40 NI021060: CREATE --#SET TERMINATOR ;
i2 9 in 43 NI021060: CREATE --#SET TERMINATOR ?
i2 9 in 78 NI021060: CREATE --#SET TERMINATOR ;
i2 9 in 81 NI021060: CREATE --#SET TERMINATOR ?
i2 9 in 162 NI021060: CREATE --#SET TERMINATOR ;
i2 9 in 885 NI021120: CREATE --#SET TERMINATOR ?
i2 9 in 921 NI021120: CREATE --#SET TERMINATOR ;
i2 9 in 924 NI021120: CREATE --#SET TERMINATOR ?
i2 9 in 959 NI021120: CREATE --#SET TERMINATOR ;
i2 9 in 653 NI021130: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 655 NI021130: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 813 NI021130: CREATE ;
i2 9 in 4 PK000010: ALTER TH DEFAULT BEFORE FELD4;
i2 9 in 4 PK010023: ALTER "
i2 9 in 6 PK010023: ALTER ";
i2 9 in 4 PK010030: ALTER "
i2 9 in 6 PK010030: ALTER ";
i2 9 in 4 PK010041: ALTER ";
i2 9 in 4 PK010042: ALTER TH DEFAULT BEFORE " ";
i2 9 in 4 PK020020: ALTER TH DEFAULT BEFORE DI040_STATUS;
i2 9 in 2 PK020030: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 PK020030: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 2 PK020042: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 4 PK030020: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 6 PK030020: ALTER TH DEFAULT BEFORE FELD4;
i2 9 in 4 PK030021: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 6 PK030021: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 8 PK030021: ALTER ELD4;
i2 9 in 4 PK030022: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 6 PK030022: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 8 PK030022: ALTER ELD4
i2 9 in 10 PK030022: ALTER TH DEFAULT BEFORE " "
i2 9 in 4 PK030030: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 6 PK030030: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 8 PK030030: ALTER ELD4
i2 9 in 10 PK030030: ALTER TH DEFAULT BEFORE " "
i2 9 in 4 PK030100: ALTER TH DEFAULT BEFORE " ";
i2 9 in 12 PK030110: ALTER TH DEFAULT BEFORE " "
i2 9 in 2 PK030130: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 2 PK030140: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 PK030140: DROP --#SET ACCEPT_RC 0 -204
SQLID CREATE ALTER DROP SQL -- in 7 PK030140: -- DROP DROP ALIAS GDB9998
i2 6 in 7 PK030140: -- DROP DROP ALIAS GDB9998.AWK408A1 ;
i2 9 in 2 PK030150: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 PK030150: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 14 SD010011: ALTER FAULT NULL BEFORE FILLER
SQLID CREATE ALTER DROP SQL -- in 1 SV500010:
i2 9 in 4 VDPS0251: ALTER 1_PHNE,CUST_CONTACT1_EML,CUST_CONTACT2_NAME,CUST_CON
i2 9 in 5 VDPS0251: ALTER ACT2_EML,CREATETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 29 VDPS0251: ALTER S_ACTIVE,DB_COLUMN,TABLE_NAME,DESCRIPTION,CREATETIM
i2 9 in 30 VDPS0251: ALTER P);
i2 9 in 33 VDPS0251: ALTER RIPTION,CREATETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 36 VDPS0251: ALTER D,IS_ACTIVE,RECORD_ID,CREATETIMESTAMP,UPDATETIMESTA
i2 9 in 42 VDPS0251: ALTER TETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 48 VDPS0251: ALTER L_STMT,DESCRIPTION,CREATETIMESTAMP,UPDATETIMESTAMP)
i2 9 in 51 VDPS0251: ALTER _STMT,DESCRIPTION,CREATETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 54 VDPS0251: ALTER TETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 85 VDPS0251: ALTER S_ACTIVE,CREATETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 7 WB110090: CREATE .speichern. Die werden bei der Verknuepfung wieder b
i2 9 in 47 WB120160: CREATE FTEN ZU BESTIMMENDEN GEGENPARTEIEN MIT DEN DAZUGEHO
i2 9 in 24 WI020062: ALTER I11802
i2 9 in 32 WI020062: ALTER WI11805
i2 9 in 34 WI020062: ALTER WI11805
i2 9 in 36 WI020062: ALTER WI11805
i2 9 in 38 WI020062: ALTER WI11805
i2 9 in 24 WK402AA0: ALTER K40202
i2 9 in 32 WK402AA0: ALTER WK40205
i2 9 in 34 WK402AA0: ALTER WK40205
i2 9 in 36 WK402AA0: ALTER WK40205
i2 9 in 38 WK402AA0: ALTER WK40205
i2 9 in 24 WK402AB0: ALTER K40202
i2 9 in 32 WK402AB0: ALTER WK40205
i2 9 in 34 WK402AB0: ALTER WK40205
i2 9 in 36 WK402AB0: ALTER WK40205
i2 9 in 38 WK402AB0: ALTER WK40205
len 99 in 8 WK402AC0: CREATE TRACKMOD YES
i2 9 in 2 WK405AB0: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 2 WK406AA2: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 2 WK408BB0: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 WK408BB0: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 WQ010200: ALTER "
i2 9 in 8 WQ010200: ALTER "
i2 9 in 10 WQ010200: ALTER ";
i2 9 in 4 XR01003A: ALTER ITH DEFAULT BEFORE XR103_UPDATE_PID
i2 9 in 6 XR01003A: ALTER ITH DEFAULT BEFORE XR103_UPDATE_PID;
i2 9 in 8 XXWK0120: CREATE --#SET TERMINATOR ?
i2 9 in 15 XXWK0120: CREATE --#SET TERMINATOR ;
i2 9 in 4 XXWK0121: CREATE --#SET TERMINATOR ?
i2 9 in 12 XXWK0121: CREATE --#SET TERMINATOR ;
i2 9 in 49 XXWK0752: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2100: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2101: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2102: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2103: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2105: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 864 XXWK2230: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 866 XXWK2230: DROP --#SET ACCEPT_RC 0 -204
$***out 20080909 17:59:41
SQLID in 1 AAAAAAA1: SQLID SET CURRENT SQLID = 'S100447' ;
i2 11 in 1 AAAAAAA1: SQLID SET CURRENT SQLID = 'S100447' ;
len 80 in 1 AAAAAAA1: SQLID SET CURRENT SQLID = 'S100447' ;
SQLID CREATE in 2 AAAAAAA1: CREATE CREATE TABLESPACE A401A
SQLID CREATE ALTER in 2 AAAAAAA3: ALTER ADMIN ALTER TABLE A540769.TWK401A
SQLID CREATE ALTER DROP in 2 AU020010: DROP ADMIN DROP TABLESPACE AU02A1A.
i2 9 in 83 AU020010: CREATE TH DEFAULT BEFORE AU180020;
i2 9 in 86 AU020010: CREATE TH DEFAULT BEFORE AU180020;
i2 9 in 89 AU020010: CREATE U180020;
i2 9 in 107 AU020010: CREATE TH DEFAULT BEFORE AU181020;
i2 9 in 110 AU020010: CREATE TH DEFAULT BEFORE AU181020;
i2 9 in 113 AU020010: CREATE U181020;
i2 9 in 131 AU020010: CREATE TH DEFAULT BEFORE AU190020;
i2 9 in 134 AU020010: CREATE TH DEFAULT BEFORE AU190020;
i2 9 in 137 AU020010: CREATE U190020;
i2 9 in 155 AU020010: CREATE TH DEFAULT BEFORE AU191020;
i2 9 in 158 AU020010: CREATE TH DEFAULT BEFORE AU191020;
i2 9 in 161 AU020010: CREATE U191020;
SQLID CREATE ALTER DROP SQL in 2 AV050020: SQL ALTER TABLE "OA1A"."TAV503A1" AD
i2 5 in 2 AV050020: SQL ALTER TABLE "OA1A"."TAV503A1" ADD "AV503102"
i2 5 in 3 AV050020: SQL DATE WITH DEFAULT NULL;
i2 9 in 4 LERZ0002: ALTER TH DEFAULT BEFORE FELD4;
i2 9 in 4 NI021060: CREATE --#SET TERMINATOR ?
i2 9 in 40 NI021060: CREATE --#SET TERMINATOR ;
i2 9 in 43 NI021060: CREATE --#SET TERMINATOR ?
i2 9 in 78 NI021060: CREATE --#SET TERMINATOR ;
i2 9 in 81 NI021060: CREATE --#SET TERMINATOR ?
i2 9 in 162 NI021060: CREATE --#SET TERMINATOR ;
i2 9 in 885 NI021120: CREATE --#SET TERMINATOR ?
i2 9 in 921 NI021120: CREATE --#SET TERMINATOR ;
i2 9 in 924 NI021120: CREATE --#SET TERMINATOR ?
i2 9 in 959 NI021120: CREATE --#SET TERMINATOR ;
i2 9 in 653 NI021130: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 655 NI021130: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 813 NI021130: CREATE ;
i2 9 in 4 PK000010: ALTER TH DEFAULT BEFORE FELD4;
i2 9 in 4 PK010023: ALTER "
i2 9 in 6 PK010023: ALTER ";
i2 9 in 4 PK010030: ALTER "
i2 9 in 6 PK010030: ALTER ";
i2 9 in 4 PK010041: ALTER ";
i2 9 in 4 PK010042: ALTER TH DEFAULT BEFORE " ";
i2 9 in 4 PK020020: ALTER TH DEFAULT BEFORE DI040_STATUS;
i2 9 in 2 PK020030: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 PK020030: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 2 PK020042: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 4 PK030020: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 6 PK030020: ALTER TH DEFAULT BEFORE FELD4;
i2 9 in 4 PK030021: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 6 PK030021: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 8 PK030021: ALTER ELD4;
i2 9 in 4 PK030022: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 6 PK030022: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 8 PK030022: ALTER ELD4
i2 9 in 10 PK030022: ALTER TH DEFAULT BEFORE " "
i2 9 in 4 PK030030: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 6 PK030030: ALTER TH DEFAULT BEFORE FELD4
i2 9 in 8 PK030030: ALTER ELD4
i2 9 in 10 PK030030: ALTER TH DEFAULT BEFORE " "
i2 9 in 4 PK030100: ALTER TH DEFAULT BEFORE " ";
i2 9 in 12 PK030110: ALTER TH DEFAULT BEFORE " "
i2 9 in 2 PK030130: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 2 PK030140: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 PK030140: DROP --#SET ACCEPT_RC 0 -204
SQLID CREATE ALTER DROP SQL -- in 7 PK030140: -- DROP DROP ALIAS GDB9998
i2 6 in 7 PK030140: -- DROP DROP ALIAS GDB9998.AWK408A1 ;
i2 9 in 2 PK030150: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 PK030150: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 14 SD010011: ALTER FAULT NULL BEFORE FILLER
SQLID CREATE ALTER DROP SQL -- in 1 SV500010:
SQLID CREATE ALTER DROP SQL -- HIER in 1 TEST1: HIER IST MEIN TEST1 CHANGE
i2 6 in 1 TEST1: HIER IST MEIN TEST1 CHANGE
SQLID CREATE ALTER DROP SQL -- HIER DELTA in 2 TEST1: DELTA
i2 9 in 4 VDPS0251: ALTER 1_PHNE,CUST_CONTACT1_EML,CUST_CONTACT2_NAME,CUST_CON
i2 9 in 5 VDPS0251: ALTER ACT2_EML,CREATETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 29 VDPS0251: ALTER S_ACTIVE,DB_COLUMN,TABLE_NAME,DESCRIPTION,CREATETIM
i2 9 in 30 VDPS0251: ALTER P);
i2 9 in 33 VDPS0251: ALTER RIPTION,CREATETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 36 VDPS0251: ALTER D,IS_ACTIVE,RECORD_ID,CREATETIMESTAMP,UPDATETIMESTA
i2 9 in 42 VDPS0251: ALTER TETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 48 VDPS0251: ALTER L_STMT,DESCRIPTION,CREATETIMESTAMP,UPDATETIMESTAMP)
i2 9 in 51 VDPS0251: ALTER _STMT,DESCRIPTION,CREATETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 54 VDPS0251: ALTER TETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 85 VDPS0251: ALTER S_ACTIVE,CREATETIMESTAMP,UPDATETIMESTAMP);
i2 9 in 7 WB110090: CREATE .speichern. Die werden bei der Verknuepfung wieder b
i2 9 in 47 WB120160: CREATE FTEN ZU BESTIMMENDEN GEGENPARTEIEN MIT DEN DAZUGEHO
i2 9 in 24 WI020062: ALTER I11802
i2 9 in 32 WI020062: ALTER WI11805
i2 9 in 34 WI020062: ALTER WI11805
i2 9 in 36 WI020062: ALTER WI11805
i2 9 in 38 WI020062: ALTER WI11805
i2 9 in 24 WK402AA0: ALTER K40202
i2 9 in 32 WK402AA0: ALTER WK40205
i2 9 in 34 WK402AA0: ALTER WK40205
i2 9 in 36 WK402AA0: ALTER WK40205
i2 9 in 38 WK402AA0: ALTER WK40205
i2 9 in 24 WK402AB0: ALTER K40202
i2 9 in 32 WK402AB0: ALTER WK40205
i2 9 in 34 WK402AB0: ALTER WK40205
i2 9 in 36 WK402AB0: ALTER WK40205
i2 9 in 38 WK402AB0: ALTER WK40205
len 99 in 8 WK402AC0: CREATE TRACKMOD YES
i2 9 in 2 WK405AB0: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 2 WK406AA2: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 2 WK408BB0: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 WK408BB0: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 6 WQ010200: ALTER "
i2 9 in 8 WQ010200: ALTER "
i2 9 in 10 WQ010200: ALTER ";
i2 9 in 4 XR01003A: ALTER ITH DEFAULT BEFORE XR103_UPDATE_PID
i2 9 in 6 XR01003A: ALTER ITH DEFAULT BEFORE XR103_UPDATE_PID;
i2 9 in 8 XXWK0120: CREATE --#SET TERMINATOR ?
i2 9 in 15 XXWK0120: CREATE --#SET TERMINATOR ;
i2 9 in 4 XXWK0121: CREATE --#SET TERMINATOR ?
i2 9 in 12 XXWK0121: CREATE --#SET TERMINATOR ;
i2 9 in 49 XXWK0752: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2100: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2101: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2102: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2103: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 49 XXWK2105: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 864 XXWK2230: DROP --#SET ACCEPT_RC 0 -204
i2 9 in 866 XXWK2230: DROP --#SET ACCEPT_RC 0 -204
$***out 20080909 17:58:14
$***out 20080909 17:55:55
$***out 20080909 17:54:39
$***out 20080909 17:37:41
$***out 20080909 17:36:43
$***out 20080909 17:36:02
$***out 20080909 17:31:45
$***out
}¢--- A540769.WK.REXX.O08(DB2COARC) cre=2008-03-19 mod=2008-07-07-14.12.40 F540769 ---
/* rexx ****************************************************************
Synopsis Db2CoArc <subsys> <phase>
Db2CoArc hat zwei Phasen
gen bestimmt die zu archvierenden Copies,
seit dem letzten abgeschlossenen VorgaengerJob (TADM62A1)
schreibt den Input für IDCAMS und Statistik
check überprüft den Output von IDCAMS (auf Anzahl Alter)
ExtraFunktion
dist distribution statistics
Input Phase gen
dd TST: aktueller Timestamp, Managment class,
creator und Name der Statistik Tabelle Tadm62a1
dd COPIES: DsnTiaul Ouput von SysCopy (full + increm Copies)
sortiert nach db, ts, part, timestamp DESC
TADM62A1: Timestamp des letzten abgeschlossenen VorgaengerJobs
Output Phase gen
dd ALTER: Alter Management Class statements für IDCAMS
TADM62A1: insert mit aktuellem Timestamp, Status=G und Statistik
Input Phase gen
dd TST: wie oben
dd ALOUT: Sysprint von IDCAMS
dd DIST : Distripbution DCAMS
TADM62A1: in Input Phase erzeugtes Tupel
Output Phase gen
TADM62A1: update Status=E (falls ok, sonst Fehlermeldung)
Input dist
dd TST: aktueller Timestamp, Managment class,
creator und Name der Statistik Tabelle Tadm62a1
dd COPIES: DsnTiaul Ouput von SysCopy, sortiert
Output dist
dsn DSN.QMW1000.DIST(Dmmddhhj) -- monat tag stunde Minute (1.St.)
enthält die kumulierten copies pro db
und die Verteilung nach Stunde des vorherigen Copies
************************************************************************
22.05.08 W.Keller, job output redigiert v1.03
*/ /* end of help
22.05.08 W.Keller, dist ergaenzt mit Jobs die zuSchnellArchivieren v1.02
16.05.08 W.Keller, zusaetzlich Kommentare v1.01
17.03.08 W.Keller, kiut 23 neu v1.00
************************************************************************
Hinweise
UnterModule: sind mit copy <modul> begin
und copy <modul> end
eingerahmt, und beginnen meist einen Ueberblick Kommentar
Memory Modell (m.) see comment at 'copy m begin'
Statistik Tabelle Tadm62A1
wir benutzen timestamp als primary key ( = curr) und
status (G nach gen, E nach check)
die restlichen Felder fuellt gen mit Statistik-Werten:
LABEL ON OA1T.TADM62A1
(OLDSIZE IS 'size(B) old copies',
OLDCOUNT IS 'count old copies',
ALTSIZE IS 'size(B) new copies',
ALTCOUNT IS 'count alter copies',
NEWSIZE IS 'size(B) alter copies',
NEWCOUNT IS 'count new copies',
STATUS IS 'Generiert, Erledigt',
TIMESTAMP IS 'timestamp of run');
***********************************************************************/
/*-- main code -------------------------------------------------------*/
parse upper arg subsys phase m.opt
ddTst = '-TST'
ddCop = '-COPIES'
ddALT = '-ALTER'
ddAOU = '-ALOUT'
if subsys = '' then do
/* für online tests ==> auf if 0 then ändern */
if 1 then
call errHelp 'keine Argumente mitgegeben'
parse upper value 'dbTf gen 2008-04-20' with subsys phase m.opt
/* für online tests ==> private Datasets benutzen */
ddTst = DSN.QMW1900.DBTF.TST
ddCOP = DSN.QMW1900.DBTF.COPIES
ddAlt = '~tmp.text(db2CoArc)'
ddAOU = DSN.QMW1000.DBAF.ALOUT
say '*** test test benutze test inputs/outputs ***'
end
say myTime() 'Db2CoArc version 1.03 db2Subsys' subsys 'phase' phase
call errReset 'h' /* initialize modules */
call mapIni
curr = readTimestamp(ddTst) /* timestamp dieses Jobs einlesen */
call sqlConnect subsys
if phase = 'GEN' then do
last = selectLast(curr)
call genAlter curr, last, ddCop, ddAlt
call insertStatistics curr, last
end
else if phase = 'CHECK' then do
call selectStats curr
if ^ checkAlterOutput(ddAOu) then
call err 'AlterOuput hat Fehler'
call updateStats curr, 'E'
end
else if phase = 'DIST' then do
ddDist= 'DSN.QMW1000.'subsys'.DIST(D' ,
|| substr(date(s), 5)translate(124, time(), 1234)') ::V'
call genDistribution curr, subsys, ddCop, ddDist, m.opt
end
else do
call errHelp 'ungueltige Phase' phase 'in args' arg(1)
end
call sqlDisconnect
exit
/*--- timestamp und managment Class aus inputfile lesen --------------*/
readTimestamp: procedure expose m.
parse arg ddTst
call readDsn ddTst, i.
if i.0 <> 1 then
call err 'tst input hat' i.0 'records statt 1'
parse var i.1 tst m.mgmtClas m.crTb o
m.opt = m.opt o
return tst
endProcedure readTimestamp
/*--- letzten fertigen Job aus %.TADM62A1 selektieren ---------------*/
selectLast: procedure expose m.
parse arg curr
call sqlPreOpen 1, 'select timestamp , status',
'from' m.crTb,
'order by 1 desc', '*'
do while sqlFetchInto(1, ':tst, :sta') & sta <> 'E'
say 'ueberspringe nicht abgeschlossenen VorgaengerJob von' tst ,
', status' sta
end
call sqlClose 1
if sta = 'E' then do
say 'letzter abgeschlossener VorgaengerJob' tst
return tst
end
else do
say 'keinen abgeschlossenen VorgaengerJob gefunden'
if sqlPreAllCl(1, "select timestamp('"curr"') - 2 days la",
'from sysibm.sysDummy1', st, ':tst') <> 1 then
call err 'could not select (timestamp curr' curr') - 2 days'
say 'letzter Zeitpunkt gewählt' tst
return tst
end
endProcedure selectLast
/*--- aktuellen Job aus %.TADM62A1 selektieren ----------------------*/
selectStats: procedure expose m.
parse arg curr
if sqlPreAllCl(1, 'select timestamp tst, status, altCount' ,
'from' m.crTb ,
"where timestamp = '"curr"'",
, st, ':m.s.tst, :m.s.status, :m.s.altCount') <> 1 then
call err m.st.0 'statistics found for' curr
say 'Statistik gefunden' m.s.tst', status' m.s.status ,
|| ', alters' m.s.altCount
if m.s.status <> 'G' then
call err 'status muss G sein, nicht' m.s.status
return
endProcedure selectStats
/*--- Status in %.TADM62A1 updaten -----------------------------------*/
updateStats: procedure expose m.
parse arg curr, sta
call sqlExImm "update" m.crTb ,
"set status = '"sta"'" ,
"where timestamp = '"curr"'"
call sqlCommit
return
endProcedure updateStats
/*--- die alter managementClass generieren -----------------------------
curr: timestamp des aktuellen Jobs,
alle neueren SysCopy Eintraege ignorieren
last: timestamp des letzten VorgaengerJobs
ddCop: Spez des input Files mit DsnTiaul output
ddAlt: Spez des output Files für Alter Statements --------------*/
genAlter: procedure expose m.
parse arg curr, last, ddCop, ddAlt
say myTime() 'generiere alter fuer'
say ' aktuell ' curr '* neuere SysCopies ignorieren'
say ' Vorgaenger ' last '* SysCopies ignorieren, die von diesem'
say left('', 39) '* oder frueheren Jobs geAlterT wurden'
say left(' mgmtClas ' m.mgmtClas, 39) '* auf diese class alterN'
ddaa = dsnAlloc(ddCop)
dd = word(ddaa, 1) /* der ddName sitzt im ersten Wort */
call readDDBegin dd /* lesen initialisieren */
outAl = dsnAlloc(ddAlt)
out = word(outAl, 1)
call writeDDBegin out
call mCut o, 0
z = 0
cDb = 0
cTs = 0
cPa = 0
old = ''
keys = 'NN WN WW ON OW OO TOT'
/*--------------------------------------------------------------
hier finden wir heraus, welche copies geAltert werden sollen
1) es gibt eine neuere fullcopy
2) die VorgaengerJob haben es noch nicht geAltert
wir lesen die Syscopies gruppiert nach TS-Partition ein
und timestamp Desc ein
also können mit einer kleine StateMachine arbeiten:
the states of the state machine
NN WN WW ON OW OO
the state consists of two characters
staT time:
N = new timestamp > curr
W = window curr >= timestamp > last
O = old last >= timestamp
staM migration: when was the next fullCopy found
N = new tst fullC > curr ==> on disk
W = window curr >= tst fullC > last ==> migrate
O = old last >= tst fullC ==> archived
--------------------------------------------------------------*/
staTxt.n = 'keines'
staTxt.W = 'nach VorgaengerJob'
staTxt.O = 'vor VorgaengerJob'
do kx=1 to words(keys)
ky = word(keys, kx)
m.s.ky.f.By = 0 /* full bytes */
m.s.ky.f.cn = 0 /* full count */
m.s.ky.i.By = 0 /* incremental bytes */
m.s.ky.i.cn = 0 /* incremental count */
end
do while readDD(dd, i., 1000) /* einen Block lesen */
do y=1 to i.0 /* jede Zeile des Blocks */
z = z + 1
if wordPos(length(i.y), 116 124) < 1 then /* bad input */
call err 'inp len' length(i.y) '<> 116,124:' z i.y
/* hin und wieder zeigen, dass wir noch arbeiten */
if z // 10000 = 0 then
say 'gelesen:' z 'copies,' cDb 'db,' cTs 'ts,' ,
cPa 'pa:' db'.'ts':'pa
/* Gruppenbrueche */
if old ^== left(i.y, 20) then do /* new partition */
if old ^== '' & staM ^== 'O' then
say 'warnung' db'.'ts':'pa,
'letzes copy' staTxt.staT',' ,
'letzes FULLcopy' staTxt.staM
if left(old, 8) ^== left(i.y, 8) then do
cDb = cDb+1
db = strip(left(i.y, 8))
end
if left(old, 16) ^== left(i.y, 16) then do
cTs = cTs+1
ts = strip(substr(i.y, 9, 8))
end
cPa = cPa + 1
pa = c2d(substr(i.y, 17, 4))
old = left(i.y, 20)
staM = 'N'
lastTst = '9999-99'
end
parse var i.y 21 tst 47 tp 48 dsn . 92 bytes .
if tst >> lastTst then
call err 'timestamp >> last' lastTst':' z i.y
if tst <= last then
staT = 'O'
else if tst <= curr then
staT = 'W'
else
staT = 'N'
if staM == 'W' then
call mAdd o, ' ALTER' dsn 'MGMTCLAS('m.mgmtClas')'
sta = staT || staM
/* say sta tp tst dsn */
m.s.sta.tp.cn = m.s.sta.tp.cn + 1
m.s.sta.tp.by = m.s.sta.tp.by + bytes
if tp = 'F' then
staM = staT
end /* jede Zeile des Blocks */
if m.o.0 > 1000 then do /* output schreiben */
call writeDD out, 'M.O.'
call mCut o, 0
end
end /* einen Block lesen */
call mAdd o, ' IF MAXCC > 4 -' ,
, ' THEN IF MAXCC <= 12 -' ,
, ' THEN SET MAXCC=4'
if m.o.0 > 00 then
call writeDD out, 'M.O.'
call writeDDend out
interpret subWord(outAl, 2)
call readDDEnd dd
interpret subWord(ddAa, 2)
say ''
say myTime() 'gelesen:' z 'copies,' cDb 'db,' cTs 'ts,' cPa 'pa'
return
endProcedure genAlter
/*--- print statistics and insert it into %.TADM62A1 ----------------*/
insertStatistics: procedure expose m.
parse arg curr, last
alCn = m.s.WW.f.cn + m.s.WW.i.cn + m.s.OW.f.cn + m.s.OW.i.cn
alBy = m.s.WW.f.by + m.s.WW.i.by + m.s.OW.f.by + m.s.OW.i.by
say 'Alter generiert fuer' alCn 'copies mit' alBy 'bytes'
call statsFmt 'auf Disk > ' curr, NN
call statsFmt 'auf Disk' , WN
call statsFmt 'Alter ' , WW
call statsFmt 'auf Disk <=' last, ON
call statsFmt 'Alter <=' last, OW
call statsFmt 'archiviert <=' last, OO
call sqlExImm "insert into" m.crTb,
"(TIMESTAMP, STATUS, newCount, newSize," ,
"altCount, altSize, oldCount, oldSize)",
"values('"curr"', 'G',",
(m.s.WN.f.cn + m.s.WN.i.cn + m.s.ON.f.cn + m.s.ON.i.cn) ",",
(m.s.WN.f.by + m.s.WN.i.by + m.s.ON.f.by + m.s.ON.i.by) ",",
alCn"," alBy ",",
(m.s.OO.f.cn + m.s.OO.i.cn ) ",",
(m.s.OO.f.by + m.s.OO.i.by ) ,
")"
call sqlCommit
return
endProcedure insertStatistics
/*--- print, format one statistics line, sum it up -------------------*/
statsFmt:
parse arg tit, ky
if m.s.title ^== 1 then do
say ''
say left('', 40) left('full.copies', 9+1+8, '.') ,
left('incremental.copies', 9+1+8, '.')
say left('', 40) right('Anzahl', 9) right('Bytes', 8) ,
right('Anzahl', 9) right('Bytes', 8)
m.s.title = 1
end
say left(tit, 40) right(m.s.ky.f.cn, 9),
format(m.s.ky.f.by, 1, 2, 2, 0),
right(m.s.ky.i.cn, 9) ,
format(m.s.ky.i.by, 1, 2, 2, 0)
if ky <> 'TOT' then do
m.s.tot.f.cn = m.s.tot.f.cn + m.s.ky.f.cn
m.s.tot.f.by = m.s.tot.f.by + m.s.ky.f.by
m.s.tot.i.cn = m.s.tot.i.cn + m.s.ky.i.cn
m.s.tot.i.by = m.s.tot.i.by + m.s.ky.i.by
end
return
endProcedure statsFmt
/*-- count the alters in the ouput and compare to statistics ---------*/
checkAlterOutput: procedure expose m.
parse arg ddOut
inpAA = dsnAlloc(ddOut)
dd = word(inpAA, 1)
call readDDBegin dd
cAlt = 0
do while readDD(dd, i.)
do x= 1 to i.0
cAlt = cAlt + (word(substr(i.x, 2), 1) = 'ALTER')
end
end
call readDDEnd dd
interpret subword(inpAA, 2)
say cAlt 'Alter gefunden in AlterOutput'
if cAlt <> m.s.altCount then
call err 'Alter' cAlt 'in AlterOuput <>' ,
m.s.altCount 'in Statistik Table'
return 1
endProcedure checkAlterOutput
/*-- distribution ermitteln:--------------------------------------------
analog wie in genAlter lesen wir den sql Ouput und bestimmen
welche Copies archiviert werden dürfen,
das vergleichen wir mit aktuellen Zustand des Copies
indem wir im MVS Catalog abfragen, ob das Copy
auf Disk, archiviert, auf Tape oder verschwunden ist
Die generierte Statistik gruppiert die copies
nach der Stunde des vorherigen full copies
und zeigt was da auf disk, archiviert, auf tape
oder nicht vorhanden ist
Vorher geben wir bei jedem Datenbankwechsel
die kumulierten Groessen pro Managmentklasse aus
----------------------------------------------------------------------*/
genDistribution: procedure expose m.
parse arg curr, subSys, ddCop, ddDist, jobAfter .
parse var curr y '-' m '-' d '-' h '.'
futu = left(curr, 13)
if m > 1 then
strt = overlay(right(m-1, 2, 0), futu, 6)
else
strt = overlay((y-1)'-12', futu)
futu = left(futu, 11)right(h+1, 2, 0)
drop y m d
say myTime() 'generiere distribution'
say ' future ' futu
say ' von ' curr
say ' nach ' strt
say ' managementClass' m.mgmtClas
ddaa = dsnAlloc(ddCop)
dd = word(ddaa, 1)
call readDDBegin dd
call mapReset claC, 'K'
call mapReset claB
call mapReset jobs, 'K'
m.o.0 = 0
call mAdd o, futu 'future'
call mAdd o, curr 'current'
call mAdd o, strt 'start'
call mAdd o, date(s)'-'time() 'runtime'
call mAdd o, '-- kumulierte Groessen pro MgmtClas nach jeder DB'
call mAdd o, claSum()
laDb = ''
z = 0
cTs = 0
cPa = 0
old = ''
cBef = 0
cIn = 0
cAft = 0
cFNC = 0
cFMi = 0
/* sql output lesen */
do while readDD(dd, i., 1000) /* einen block lesen */
do y=1 to i.0 /* jeder record des Blocks */
if wordPos(length(i.y), 116 124) < 1 then /* bad input */
call err 'inp len' length(i.y) '<> 116,124:' z i.y
if z // 1000 = 0 then
call distCountSay
z = z + 1
if old ^== left(i.y, 20) then do /* new partition */
if left(i.y, 16) ^== laTs then do /* new ts */
drop csi.
laTs = left(i.y, 16)
cTs = cTs + 1
/* Optimierung: CSI Abfrage für alle
copies dieses TS mit standard namen */
csiPref = subsys'.'strip(left(i.y, 8)),
|| '.'strip(substr(i.y, 9, 8))'.'
call csiOpen cc, csiPref'**',
, 'volSer mgmtClas devTyp'
do while csiNext(cc, c)
coNa = strip(m.c.dsn)
csi.coNa = csiArcTape(m.c.volser, m.c.mgmtClas,
, m.c.devTyp, m.c.dsn)
end
end
if left(i.y, 8) ^== laDb then do /* new db */
if laDb <> '' then /* mgmtClas total schreiben */
call mAdd o, claSum(laDb)
laDb = left(i.y, 8)
end
laFu = futu
cPa = cPa + 1
old = left(i.y, 20)
end
parse var i.y 21 tst 47 tp 48 coNa . 92 bytes . 117 job .
if abbrev(coNa, csiPref) then do
/* csi Abfrage für standard Namen schon gemacht */
if symbol('csi.coNa') = 'VAR' then
cl = csi.coNa
else
cl = 'no'
end
else do
/* Namen nicht standard: csi Abfrage */
call csiOpen cc, coNa, 'volSer mgmtClas devTyp'
if ^ csiNext(cc, c) then
cl = 'no'
else if coNa <> m.c.dsn then
call err 'coNa' coNa '<> dsn' m.c.dsn
else
cl = csiArcTape(m.c.volser, m.c.mgmtClas,
, m.c.devTyp, m.c.dsn)
end
if tst >> curr then do
cAft = cAft + 1
say z cAft 'after' tst coNa
iterate
end
if wordPos(cl, 'arcive tape no') > 0 then
fu = translate(left(cl, 1))
else if wordPos(cl, m.mgmtClas 'A000Y001 SUB#ADB1') > 0 then
fu = 'M'
else
fu = 'D'
if tst << strt then do
cBef = cBef + 1
end
else do
cIn = cIn + 1
IF laFu ^== futu then do
END
else if fu == 'N' then do
say 'future not in catalog' job coNa
cFNC = cFNC + 1
end
else if fu == 'M' then do
cFMi = cFMi + 1
end
end
if symbol('dist.laFu.fu.c') ^== 'VAR' then
call distZero laFu
/* kumulieren unter lastFullCopy und copy zustand */
dist.laFu.fu.c = dist.laFu.fu.c + 1
dist.laFu.fu.b = dist.laFu.fu.b + bytes
/* kumulieren unter Management class */
if ^ mapHasKey(claC, cl) then do
call mapPut claC, cl, 1
call mapPut claB, cl, bytes
end
else do
call mapPut claC, cl, 1 + mapGet(claC, cl)
call mapPut claB, cl, bytes + mapGet(claB, cl)
end
/* falls fullCopy wird er zum neuen LastFullCopy */
if laFu = futu & fu <> 'D' & tst >>= jobAfter then do
jj = job'.'cl
if mapHasKey(jobs, jj) then
call mapPut jobs, jj, bytes + mapGet(jobs, jj)
else
call mapPut jobs, jj, bytes
end
if tp = 'F' then do
laFu = left(tst, 13)
if laFu << strt then
laFu = strt
end
end /* jeder record des Blocks */
end /* einen block lesen */
if laDb <> '' then
call mAdd o, claSum(laDb)
call distCountSay
call mAdd o, '-- Syscopies (Anahl Bytes)',
'gruppiert nach letztem FullCopy Zeitpunkt'
call mAdd o, distFmt() /* titel */
hh = futu
call distZero tot
do while hh >= strt
if symbol('dist.hh.d.c') == 'VAR' then do
call mAdd o, distFmt(hh) /* stats line ausgeben */
end
/* eine Stunde zurück rechnen */
if substr(hh, 12) > 0 then
hh = left(hh, 11)right(substr(hh, 12) - 1, 2, 0)
else if substr(hh, 9, 2) > 1 then
hh = left(hh, 8)right(substr(hh, 9, 2) - 1, 2, 0)'-24'
else if substr(hh, 6, 2) > 1 then
hh = left(hh, 5)right(substr(hh, 6, 2) - 1, 2, 0)'-31-24'
else
hh = (left(hh, 4) - 1)'-12-31-23'
end
call mAdd o, distFmt(tot) /* total ausgeben */
say distFmt()
say distFmt(tot)
call jobSum jobAfter
call writeDsn ddDist, 'M.'o'.', ,1
call readDDend dd
interpret subWord(ddAa, 2)
call distCountSay
return
endProcedure genDistribution
/*--- kumulierte Zahlen pro MgmtClass in eine Zeile konkatinieren ----*/
claSum: procedure expose m.
parse arg db
if db = '' then
return '-- DB mgmtClass count bytes ...'
w = 8
t = left(db, 8)
kk = mapKeys(claC)
do kx=1 to m.kk.0
c = m.kk.kx
t = t left(c, 8) right(mapGet(claC, c), w) ,
format(mapGet(claB, c), 1, 2, 2, 0)
end
return t
endProcedure claSum
/*--- laufende Kumulationen anzeigen,
damit das warten auf das Programmende unterhaltsamer wird ------*/
distCountSay:
say myTime() 'copies' z', ts' cTs', pa' cPa csiPref
say right('before', 24) cBef', in' cIn', after' cAft,
|| ', futNoCat' cFNC', futToMig' cFMi
return
end distCountSay
jobSum: procedure expose m.
parse arg jobAfter
call mAdd o, "-- jobs nach '"jobAfter"'" ,
"mit zuschnell archivierenden mgmtClasses"
call mAdd o, '-- job bytes mgmtclasses'
cc = mapKeys(claC)
jj = mapKeys(jobs)
do jx=1 to m.jj.0
joCl = m.jj.jx
parse var joCl jo '.' cl
if done.jo = 1 then
iterate
done.jo = 1
m = ''
by = 0
do cx=1 to m.cc.0
if mapHasKey(jobs, jo'.'m.cc.cx) then do
by = by + mapGet(jobs, jo'.'m.cc.cx)
m = m m.cc.cx
end
end
call mAdd o, left(jo, 9) format(by, 1, 4, 2, 0) m
end
return
endProcedure jobSum
/*--- print, format one statistics line, sum it up -------------------*/
distFmt:
parse arg ky
w = 8
v = w + 9
if ky = '' then
return left('-- lastFullCopy', 17) left('onDiskOrig', v) ,
left('onDiskToArc', v) left('archived', v) ,
left('tape', v) left('notinCat', v)
if ky ^== tot then
do tx=1 to words(dist.keys)
tt = word(dist.keys, tx)
dist.tot.tt.C = dist.tot.tt.C + dist.ky.tt.C
dist.tot.tt.B = dist.tot.tt.B + dist.ky.tt.B
end
return left(ky, 13) ,
right(dist.ky.d.c, w) format(dist.ky.d.b, 1, 2, 2, 0) ,
right(dist.ky.m.c, w) format(dist.ky.m.b, 1, 2, 2, 0) ,
right(dist.ky.a.c, w) format(dist.ky.a.b, 1, 2, 2, 0) ,
right(dist.ky.t.c, w) format(dist.ky.t.b, 1, 2, 2, 0) ,
right(dist.ky.n.c, w) format(dist.ky.n.b, 1, 2, 2, 0)
endProcedure distFmt
/*--- Statistik Eintrag auf Null setzen -----------------------------*/
distZero: procedure expose m. dist.
parse arg ky
dist.keys = 'D M A T N'
do tx=1 to words(dist.keys)
tt = word(dist.keys, tx)
dist.ky.tt.C = 0
dist.ky.tt.B = 0
end
return
endProcedure distZero
myTime: procedure
return time()
/* Programm Ende
ab hier kommen nur noch allgemeine Unterfunktionen ************/
/* copy csi begin ***************************************************
csi interface: see dfs managing catalogs appendix c
returncode/reason see message IDC3009I
**********************************************************************/
/*--- specify dsn mask and fields to start a csi catalog search --------
arguments:
m objectPointer
dsnMask specifies the dsns with wildcards:
% 1 character
* 0 - n character in one level
** 0 - n levels
fields a (space separated) list of field names -------------*/
csiOpen: procedure expose m.
parse arg m, dsnMask, fields
m.m.fld.0 = words(fields)
ffix = d2c(m.m.fld.0, 2)
do x=1 to m.m.fld.0
m.m.fld.x = translate(word(fields, x))
ffix = ffix || left(m.m.fld.x, 8)
end
m.m.filt = left(dsnMask, 149) ,
|| left('Y', 3) , /* resume offset 149 */
|| ffix /* csiNumEn offset 152 */
WORKLEN = 1024 * 64
m.m.work = D2C(WORKLEN,4) || COPIES('00'X,WORKLEN-4)
m.m.pos = workLen + 1
return
endProcedure csiOpen
/*--- put the next dsn into m.o.dsn and m.o.* (for other fields)
return 1 if next dsn exists 0 otherwise ------------------------*/
csiNext: procedure expose m.
parse arg m, o
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET AMOUNT OF WORK AREA USED */
px = m.m.pos
do forever
if px > usedL then do
if substr(m.m.filt, 150, 1) ^== 'Y' then do
m.m.pos = px
m.o.dsn = ''
return 0
end
reason = left('', 4)
ADDRESS LINKPGM 'IGGCSI00 reason m.'m'.filt m.'m'.work'
if rc == 0 & substr(reason, 3, 2) == '0000'x then
nop
else if rc == 4 & substr(reason, 3, 2) == '0464'x then
say 'data set entry with error'
else
call err 'call csi returns' rc,
'rc' c2d(substr(reason, 4,1)),
'reason' c2d(substr(reason, 3,1)),
'module' substr(reason, 1,2)
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET WORK AREA USED */
numFD = C2D(SUBSTR(m.m.work,13,2)) /* no flds + 1 */
if numFd <> m.m.fld.0 + 1 then
call err 'csiNumFd' numFd 'not' m.m.fld.0 '+' 1
px = 15
iterate
end
eType = substr(m.m.work, px+1, 1)
m.o.dsn = substr(m.m.work, px+2, 44)
flag = substr(m.m.work, px, 1)
/* say 'eType' eType m.o.dsn 'flag' c2x(flag) */
if eType == '0' then do
if flag ^== '00'x & flag ^== '40'x then
call err 'flag' c2x(flag) 'for catalog' m.o.dsn
px = px + 50 /* length of catalog entry */
iterate
end
else do
if ^ abbrev(x2b(c2x(flag)), '101') then
call err 'call csi entry flag' x2b(c2x(flag)),
'rc' c2d(substr(m.m.work, px+49,1)),
'reason' c2d(substr(m.m.work, px+48,1)),
'module' substr(m.m.work, px+46, 2),
'for entry' m.o.dsn,
'see qw IDC3009I'
py = px + 46
tl = c2d(substr(m.m.work, py, 2))
pl = py + 4
pf = py + m.m.fld.0 * 2 + 4
do fx = 1 to m.m.fld.0
fi = m.m.fld.fx
fl = c2d(substr(m.m.work, pl, 2))
m.o.fi = substr(m.m.work, pf, fl)
if fi = 'MGMTCLAS' then
m.o.fi = substr(m.o.fi, 3, c2d(left(m.o.fi ,2)))
else if wordPos(fi, 'COMUDSIZ NOBYTTRK') > 0 then
m.o.fi = c2d(m.o.fi)
pf = pf + fl
pl = pl + 2
end
if py + tl <> pf then
call err 'length mismatch for entry' m.o.dsn
m.m.pos = pf
return 1
end
end
endProcedure csiNext
/*--- if dsn is arcived return 'arcive'
if dsn is tape return 'tape'
otherwise return managment class ------------------------------*/
csiArcTape: procedure expose m.
parse arg vo, cl, dt, dsn
if vo = '' then
say err '||| no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl <> '' then
res = cl
else if abbrev(vo, 'SHR') then
res = 'SHR'
else
res = 'tape'
if res = 'arcive' then
return res
/*if abbrev(res, 'ar') ^= abbrev(dt, '00'x) , */
if abbrev(res, 'ta') ^= abbrev(c2x(left(dt, 1)), '7') ,
| (left(res, 1) >= 'A') ^= abbrev(dt, '30'x) then
say '||| mismatch cl' cl 'vo' vo 'dt' c2x(dt) 'dsn' dsn
return res
endProcedure csiArcTape
/* copy csi end ******************************************************/
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure
parse arg ggSys, ggRetCon
call sqlIni
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call sqlExec "connect" ggSys, ggRetCon ,1
return
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql 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(s005y000) 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 map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = ''
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
if abbrev(a, 'MAP.') then do
do kx=1 to m.map.loKy.a.0
drop m.map.loKy.a.kx m.map.loVa.a.kx
end
m.map.loKy.a.0 = 0
end
return a
endProcedure mapClear
/*--- return a stem of all keys (including removed ones) -------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
if mapValAdr(a, ky) ^== '' then
call err 'duplicate key in mAdd('a',' ky',' val')'
if length(ky) < 200 then do
m.a.ky = val
end
else do
kx = mInc('MAP.LOKY.'a'.0')
m.map.loKy.a.kx = ky
m.map.loVa.a.kx = val
end
if m.map.keys.a ^== '' then
return mAdd(m.map.keys.a, ky)
return
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky)
if vv ^== '' then
m.vv = val
else
call mapAdd a, ky, val
return val
endProcedure mapPut
/*--- return the value pointer for a key, '' if non existang ---------*/
mapValAdr: procedure expose m.
parse arg a, ky
if length(ky) < 200 then do
if symbol('m.a.ky') == 'VAR' then
return a'.'ky
end
else if ^ abbrev(a, 'MAP.') then do
call err 'key too long mapValAdr('a',' ky')'
end
else do
do kx=1 to m.map.loKy.a.0
if m.map.loKy.a.kx == ky then
return 'MAP.LOVA.'a'.'kx
end
end
return ''
endProcedure mapValAdr
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if abbrev(vv, 'MAP.LOVA.') then
call err 'not implemented mapRemove('a',' ky')'
drop m.a.ky
return val
endProcedure mapRemove
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a,
fail if it does not exist ----------------------------------*/
mapGet: procedure expose m.
parse arg a, ky, noKey
vv = mapValAdr(a, ky)
if vv == '' then
call err 'missing key in mapGet('a',' ky')'
return m.vv
endProcedure mapGet
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(DB2COARX) cre=2008-04-17 mod=2008-07-14-10.39.50 F540769 ---
parse arg susy
if susy = '' then
susy = 'DBOF'
dsn = 'DSN.QMW1000.'susy'.DIST(D0417060)'
dsn = 'DSN.QMW1000.'susy'.DIST'
out = '~wk.texv(dist'susy')'
ouDb = '~wk.texv(diDb'susy')'
m.liOW1 = 35
m.lioWi = 9
m.lioEn = 1
m.lims = '6 6 6 6 6 6 6 6 24 24 24 24 24 168 168'
m.lims = '24 24 24 96 168 168'
m.dbs = 'BE01A1P'
m.o.1 = liTit()
m.o.0 = 1
m.clix.0 = 0
m.dbo.1 = '-- db Groessen'
m.dbTi = '-- db mbr no tape arcive toArc ' ,
'disk SUB#ADB1 A000Y001 A008Y001 '
m.dbo.0 = 2
call anaPds dsn
call writeDsn out, 'M.O.', ,1
m.dbo.2 = m.dbTi
call writeDsn ouDb, 'M.DBO.', ,1
exit
anaPds: procedure expose m.
parse arg pds
id = lmmBegin(pds)
ox = m.o.0
do forever
mbr = lmmNext(id)
if mbr = '' then
leave
call anaMbr pds'('mbr')'
ox = ox+1
m.o.ox = m.line.di
ox = ox+1
m.o.ox = m.line.ar
end
m.o.0 = ox
return
endProcedure anaPds
anaMbr: procedure expose m.
parse arg dsn
mbr = dsnGetMbr(dsn)
call readDsn dsn, i.
if word(i.1, 2) = 'future' then
fut = word(i.1, 1)
else
call err 'no future in line 1' dsn i.1
if word(i.2, 2) = 'current' then
cur = word(i.2, 1)
else
call err 'no current in line 1' dsn i.2
m.line.di = cur 'disk'
m.line.ar = cur 'arch'
do i=3 to i.0 while ^abbrev(i.i, 'lastFullCo') ,
& ^abbrev(i.i, '-- lastFullCo')
if wordPos(word(i.i, 1), m.dbs) > 0 then do
j1 = i - 1
call addDbBy mbr, i.i, i.j1
end
end
if i > 10 then do
do j1=i-1 by -1 while abbrev(i.j1, '--')
end
call addDbBy mbr, overlay('total ', i.j1)
end
if space(subword(strip(i.i, 'l', '-'), 2, 2)),
<> 'onDiskOrig onDiskToArc' then
call err 'bad title line' dsn i i.i
limx = -1
li = 99
do i=i+1 to i.0
ti = word(i.i, 1)
if ti = 'TOT' then
leave
do while ti << li
limx = limx + 1
if limx = 0 then do
li = fut
end
else if limx > words(m.lims) then do
call liOut limx, diB, arB
li = '0000'
end
else do
call liOut limx, diB, arB
ll = word(m.lims, limx)
parse var li y '-' m '-' d '-' h
if ll < 24 then do
h = h - ll
dm = 0
if h < 0 then do
dm = 1
h = h + 24
end
end
else
dm = ll % 24
d = d - dm
if d < 1 then do
m = m - 1
d = substr('313232332323', m, 1) + 28 + d
end
li = y'-'right(m, 2, 0)'-'right(d,2,0)'-'right(h,2,0)
end
diB = 0
arB = 0
end
diB = diB + word(i.i, 3) + word(i.i, 5)
arB = arB + word(i.i, 7)
end
if limX >= 0 then
call liOut limX+1, diB, arB
return m.line
endProcedure anaMbr
liOut: procedure expose m.
parse arg limX, diB, arB
m.line.di = overlay(format(diB, 1, 2, 2, 0),
, m.line.di, m.liOW1 + m.liOwi * m.liOEn * (limx-1))
m.line.ar = overlay(format(arB, 1, 2, 2, 0),
, m.line.ar, m.liOW1 + m.liOwi * m.liOEn * (limx-1))
return
endProcedure liOut
liTit: procedure expose m.
entries = ''
t = overlay(liTitEE('new', entries), '', m.liOW1)
su = 0
do lx=1 to words(m.lims)
w = word(m.lims, lx)
su = su + w
if w < 24 then
e = liTitEE(su'h', entries)
else
e = liTitEE((su % 24)'d', entries)
t = overlay(e, t, m.liOW1 + m.liOWi * m.liOEn * lx)
end
t = overlay(liTitEE('9999y', entries), t, m.liOW1 + m.liOWi * lx)
return t
endProcedure liTit
liTitEE: procedure expose m.
parse arg e, entries
t = ''
do ex=1 to m.liOEn
t = t || left(e word(entries, ex), m.liOWi)
end
return t
addDbBy: procedure expose m.
parse arg mbr, li, bef
o = left(word(li, 1), 8) mbr
do wx=2 by 3
cl = word(li, wx)
if cl = '' then
leave
by = word(li, wx+2)
if word(bef, wx) = cl then
by = by - word(bef, wx+2)
if by <> 0 then do
px = pos(' 'cl' ', m.dbTi) + 1
if px <= 1 then do
px = length(m.dbTi) + 1
m.dbTi = m.dbTi || left(cl, 10)
end
o = overlay(format(by, 1, 2, 2, 0), o, px)
end
end
call mAdd dbo, o
return
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m end *********************************************************/
/* 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 -------------------------------------------*/
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 = '' & ^ abbrev(disp, 'SYSO') then
return 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 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
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(DB2RCEST) cre=2008-01-31 mod=2008-01-31-13.17.11 F540769 ---
/*---------------------REXX-------------------------------------------*/
/* DB2RCEST DB2 Recovey Estimator */
/* Dises Programm gibt eine Schätzung, wie lange der Recovery eines */
/* Pagesets etwa laufen wird. */
/* */
/* Für die folgenen Spaces sind die ermittelten Zeiten sicher falsch */
/* (zu kurz): */
/* DSNDB01.DBD01, DSNDB01.SPT01, DSNDB01.SCT02, DSNDB01.SYSLGRNX, */
/* DSNDB01.SYSUTILX, DSNDB06.SYSCOPY, DSNDB06.SYSGROUPS */
/* Diese Spaces müssen alle Logs in ihrer ganzen Länge seit der */
/* letzten Image Copy lesen. */
/* */
/* Input: -Output aus dem DB2 REPORT Utility */
/* -BSDS aller Group Members (StartRBA Activlog, highest */
/* written RBA) */
/* */
/* Output: approximative Recoveryzeit */
/* */
/* 04.08.2004 erstellt durch B.Dudle */
/* 13.08.2004 BDU div. Anpassungen */
/* 18.10.2005 BDU Anpassung an PT/A */
/* 21.02.2006 BDU total überarbeitet */
/*--------------------------------------------------------------------*/
/*--- initialisieren -------------------------------------------------*/
numeric digits 15;
z1=0; z2=0; z3=0;
cc=0;
out.=""; out.0=0; o=0;
group=left("",4);
dat=translate(date('E'),".","/");
dat=insert("20",dat,pos(".",dat,4));
tim=time('N');
rz=sysvar(sysnode);
select;
when (rz = 'RZ0'); then do;
mount=150; /* tape mount: Sek. */
resto=2.00E+05; /* restore: Pages / 60 Sek. */
logap=8.00E+08; /* logappl: Bytes / 60 Sek. */
end;
when (rz = 'RZ1'); then do;
mount=150; /* tape mount: Sek. */
resto=2.00E+05; /* restore: Pages / 60 Sek. */
logap=8.00E+08; /* logappl: Bytes / 60 Sek. */
end;
when (rz = 'RZ2'); then do;
mount=90; /* tape mount: Sek. */
resto=2.00E+05; /* restore: Pages / 60 Sek. */
logap=8.00E+08; /* logappl: Bytes / 60 Sek. */
end;
when (rz = 'RZ4'); then do;
mount=90; /* tape mount: Sek. */
resto=2.00E+05; /* restore: Pages / 60 Sek. */
logap=8.00E+08; /* logappl: Bytes / 60 Sek. */
end;
when (rz = 'RR2'); then do;
rz='RZ2'; /* change für PT/A */
mount=90; /* tape mount: Sek. */
resto=2.00E+05; /* restore: Pages / 60 Sek. */
logap=8.00E+08; /* logappl: Bytes / 60 Sek. */
end;
when (rz = 'RR4'); then do;
rz='RZ4'; /* change für PT/A */
mount=90; /* tape mount: Sek. */
resto=2.00E+05; /* restore: Pages / 60 Sek. */
logap=8.00E+08; /* logappl: Bytes / 60 Sek. */
end;
otherwise; nop;
end;
/*--- Output aus Report Utility einlesen und in Tablellen speichern --*/
address tso "execio * diskr REPORT (stem rpt. open finis";
do r=1 to rpt.0;
select;
when (pos("DSNU050I",rpt.r) > 0); then do; /* DSNUM request */
p=pos("REPORT RECOVERY TABLESPACE",rpt.r)+26;
do while (substr(rpt.r,p,1) = " "); p=p+1; end;
p1=p;
do while (substr(rpt.r,p1,1) <> " "); p1=p1+1; end;
space=substr(rpt.r,p,p1-p);
p=pos("DSNUM",rpt.r); part=0;
if (p > 0); then do;
p=p+5;
do while (substr(rpt.r,p,1) = " "); p=p+1; end;
do while (substr(rpt.r,p,1) <> " ");
part=part*10+substr(rpt.r,p,1); p=p+1;
end;
end;
else nop;
end;
when ((pos("DSNU054I",rpt.r)>0) | (pos("DSNU007I",rpt.r)>0));
then do; /* TS not found */
o=o+1; out.o=group right(dat tim,75);
o=o+1; out.o=left("",80,"-");
o=o+1; out.o=" "; out.0=o;
address tso "execio * diskw PRINT (stem out. open";
address tso "execio * diskw PRINT (stem rpt. finis";
cc=8;
exit cc;
end;
when (pos("IC TYPE =",rpt.r) > 0); then do; /* image copies */
r1=r; z1=z1+1;
p=pos("IC TYPE =",rpt.r1);
ictype.z1=substr(rpt.r1,p+11,1);
if (ictype.z1 = "F" | ictype.z1 = "I"); then do;
p=pos("DSNUM =",rpt.r1);
p=p+10; dsnum.z1=0;
do while (substr(rpt.r,p,1) = " "); p=p+1; end;
do while (substr(rpt.r,p,1) <> ",");
dsnum.z1=dsnum.z1*10+substr(rpt.r,p,1); p=p+1;
end;
if (dsnum.z1 = part | dsnum.z1 = 0); then do;
p=pos("START LRSN =",rpt.r1);
slrsn.z1=x2d(substr(rpt.r1,p+12,12));
r1=r1+1;
p=pos("IC BACK =",rpt.r1);
icback.z1=substr(rpt.r1,p+10,2);
p=pos("DEV TYPE =",rpt.r1);
devtyp.z1=substr(rpt.r1,p+12,4);
r1=r1+2;
p=pos("COPYPAGESF =",rpt.r1);
copypage.z1=0;
copypage.z1=trunc(strip(substr(rpt.r1,p+13,14)));
r1=r1+2;
p=pos("DSNAME =",rpt.r1);
group=strip(substr(rpt.r1,p+12,4)); /* group name */
p=pos("MEMBER NAME =",rpt.r1);
memb=strip(substr(rpt.r1,p+14,4)); /* member name */
end;
else do;
z1=z1-1;
end;
end;
else do;
z1=z1-1;
end;
end;
when (pos("UCDATE ",rpt.r) > 0); then do; /* log ranges */
r2=r+1;
do while (substr(rpt.r2,24,12) <> " ");
z2=z2+1;
srba.z2=x2d(substr(rpt.r2,24,12),14);
erba.z2=x2d(substr(rpt.r2,39,12),14);
slrsns.z2=x2d(substr(rpt.r2,54,12),14);
elrsns.z2=x2d(substr(rpt.r2,69,12),14);
mbid.z2=x2d(substr(rpt.r2,99,4),4);
if (srba.z2 = erba.z2); then do; /* not a range */
z2=z2-1;
end;
else nop;
r2=r2+1;
end;
end;
otherwise nop;
end;
end;
slrsn.0=z1; srba.0=z2;
/* say "---copy table";
do z1=1 to slrsn.0;
say right(d2x(slrsn.z1),12) devtyp.z1 copypage.z1;
end;
say "---syslgrnx table";
do z2=1 to srba.0;
say right(d2x(srba.z2),12),
right(d2x(erba.z2),12),
right(d2x(slrsns.z2),12),
right(d2x(elrsns.z2),12),
right(d2x(mbid.z2),12);
end;
*/
/*--- Image Copies Set selektieren -----------------------------------*/
do z1=1 to slrsn.0-1; /* sortieren */
do z11=z1+1 to slrsn.0;
select;
when (slrsn.z1 > slrsn.z11); then do;
sl=slrsn.z1; slrsn.z1=slrsn.z11; slrsn.z11=sl;
it=ictype.z1; ictype.z1=ictype.z11; ictype.z11=it;
ib=icback.z1; icback.z1=icback.z11; icback.z11=ib;
dv=devtyp.z1; devtyp.z1=devtyp.z11; devtyp.z11=dv;
ds=dsnum.z1; dsnum.z1=devtyp.z11; dsnum.z11=dv;
cp=copypage.z1; copypage.z1=copypage.z11; copypage.z11=cp;
end;
when (slrsn.z1 = slrsn.z11); then do;
if (icback.z1 <> " "); then do;
sl=slrsn.z1; slrsn.z1=slrsn.z11; slrsn.z11=sl;
it=ictype.z1; ictype.z1=ictype.z11; ictype.z11=it;
ib=icback.z1; icback.z1=icback.z11; icback.z11=ib;
dv=devtyp.z1; devtyp.z1=devtyp.z11; devtyp.z11=dv;
ds=dsnum.z1; dsnum.z1=devtyp.z11; dsnum.z11=dv;
cp=copypage.z1; copypage.z1=copypage.z11;
copypage.z11=cp;
end;
else nop;
end;
otherwise nop;
end;
end;
end;
z1=1; /* Duplikat eliminieren */
do z11=z1+1 to slrsn.0;
if (slrsn.z1 <> slrsn.z11); then do;
z1=z1+1;
slrsn.z1=slrsn.z11;
ictype.z1=ictype.z11;
icback.z1=icback.z11;
devtyp.z1=devtyp.z11;
dsnum.z1=devtyp.z11;
copypage.z1=copypage.z11;
end;
else nop;
end;
slrsn.0=z1;
/* say "---copy table sortiert";
do z1=1 to slrsn.0;
say right(d2x(slrsn.z1),12),
devtyp.z1,
copypage.z1;
end;
*/
/*--- highest written RBAs, oldest RBAs Active Log ermitteln ---------*/
loadlib="DB2@."rz".P0.DSNLOAD";
callmod="call '"loadlib"(DSNJU004)'"; upper callmod;
cntl.1="MEMBER *"; cntl.0=1; upper cntl.1;
bsds="'"group"."memb".BSDS01'"; upper bsds;
address tso "alloc dd(SYSIN) new space(1,1) tracks
unit(VIO) dsorg(PS) blksize(800) lrecl(80) recfm(F B) reuse";
address tso "execio * diskw SYSIN (stem cntl. open finis";
address tso "alloc dd(SYSPRINT) new space(15,15) tracks
unit(VIO) dsorg(PS) blksize(27875) lrecl(125) recfm(F B A) reuse";
allcbsds="alloc f(GROUP) da("bsds") shr";
address tso allcbsds;
address tso callmod;
address tso "free f(GROUP)";
address tso "free f(SYSIN)";
address tso "execio * diskr SYSPRINT (stem bsdslst. open finis";
address tso "free f(SYSPRINT)";
h2=0; z3=0; z1=slrsn.0; highlrsn=0;
do h1=1 to bsdslst.0;
select;
when (pos("HIGHEST RBA WRITTEN",bsdslst.h1) > 0); then do;
p=pos("HIGHEST RBA WRITTEN",bsdslst.h1);
h2=h2+1; highrba.h2=x2d(substr(bsdslst.h1,p+26,12),14);
end;
when (pos("HOST MEMBER NAME:",bsdslst.h1) > 0); then do;
h3=h1+1; p=pos("MEMBER ID:",bsdslst.h3);
do h4=p+10 to 133 while (substr(bsdslst.h3,h4,1) = " ");
end;
himemb.h2=0;
do while (substr(bsdslst.h3,h4,1) <> " ");
himemb.h2=himemb.h2*10+substr(bsdslst.h3,h4,1);
h4=h4+1;
end;
end;
when (pos("ACTIVE LOG COPY 1",bsdslst.h1) > 0); then do;
p=pos("ACTIVE LOG COPY 1",bsdslst.h1); h3=h1+3;
do while (pos("EMPTY DATA SET",bsdslst.h3) > 0);
h3=h3+3;
end;
h4=h3+1; z1=slrsn.0;
activrba.h2=x2d(substr(bsdslst.h3,p+3,12),14);
activlrsn.h2=x2d(substr(bsdslst.h4,p+5,12),14);
do while(substr(bsdslst.h4,p+28,12) <> "............");
elrsn=x2d(substr(bsdslst.h4,p+28,12),14);
if (elrsn >= slrsn.z1);
then do;
z3=z3+1;
srbalog.z3=x2d(substr(bsdslst.h3,p+3,12),14);
erbalog.z3=x2d(substr(bsdslst.h3,p+26,12),14);
slrsnlog.z3=x2d(substr(bsdslst.h4,p+5,12),14);
elrsnlog.z3=elrsn;
unitlog.z3="DISK";
memblog.z3=himemb.h2;
logtyp.z3="ACTIV";
end;
h3=h3+3; h4=h3+1;
end;
z3=z3+1;
srbalog.z3=x2d(substr(bsdslst.h3,p+3,12),14);
erbalog.z3=x2d(substr(bsdslst.h3,p+26,12),14);
slrsnlog.z3=x2d(substr(bsdslst.h4,p+5,12),14);
elrsnlog.z3=max(slrsnlog.z3+1,slrsn.z1);
unitlog.z3="DISK";
memblog.z3=himemb.h2;
logtyp.z3="ACTIV";
highlrsn=max(highlrsn,elrsnlog.z3);
h3=h3+3; h4=h3+1;
end;
when (pos("ARCHIVE LOG COPY 1",bsdslst.h1) > 0); then do;
h0=h1+1; z1=slrsn.0;
if (pos("NO ARCHIVE DATA SETS",bsdslst.h0) = 0); then do;
p=pos("ARCHIVE LOG COPY 1",bsdslst.h1); h3=h1+3;
do while(pos("ACTIVE LOG COPY",bsdslst.h3) = 0);
h4=h3+1;
elrsn=x2d(substr(bsdslst.h4,p+28,12),14);
if (elrsn >= slrsn.z1 & elrsn <= activlrsn.h2);
then do;
z3=z3+1;
srbalog.z3=x2d(substr(bsdslst.h3,p+3,12),14);
erbalog.z3=x2d(substr(bsdslst.h3,p+26,12),14);
slrsnlog.z3=x2d(substr(bsdslst.h4,p+5,12),14);
elrsnlog.z3=x2d(substr(bsdslst.h4,p+28,12),14);
u=pos("UNIT=",bsdslst.h4);
unitlog.z3=strip(substr(bsdslst.h4,u+5,6));
memblog.z3=himemb.h2;
logtyp.z3="ARCHIV";
end;
h3=h3+4;
end;
end;
else nop;
end;
otherwise nop;
end;
end;
highrba.0=h2; srbalog.0=z3;
/* say "---Logs";
do z3=1 to srbalog.0
say right(d2x(srbalog.z3),12) right(d2x(erbalog.z3),12),
right(d2x(slrsnlog.z3),12) right(d2x(elrsnlog.z3),12),
unitlog.z3 right(memblog.z3,2) logtyp.z3;
end;
say "---highest LRSN:" d2x(highlrsn,12);
say "---highest written RBA";
do h2=1 to highrba.0;
say "highest:" right(d2x(highrba.h2,12),12) right(himemb.h2,2);
end;
*/
/*--- highest written RBAs nachführen in Logapply Ranges -------------*/
z1=slrsn.0;
do z2=1 to srba.0;
if (erba.z2 = 0); then do; /* SYSLGRNX open ? */
do h2=1 to highrba.0;
if (mbid.z2 = himemb.h2); then do;
erba.z2=highrba.h2;
elrsns.z2=max(slrsns.z2+1,highlrsn,slrsn.z1);
end;
else nop;
end;
end;
else nop;
end;
/* say "---syslgrnx table ergänzt";
do z2=1 to srba.0;
say right(d2x(srba.z2),12),
right(d2x(erba.z2),12),
right(d2x(slrsns.z2),12),
right(d2x(elrsns.z2),12),
right(d2x(mbid.z2),12);
end;
*/
/*--- Logapply Ranges ermitteln --------------------------------------*/
do z3=1 to srbalog.0; /* archlog ranges berechnen */
range.z3=0;
do z2=1 to srba.0;
if (mbid.z2 = memblog.z3); then do;
select;
when (elrsnlog.z3 < slrsns.z2);
then nop;
when (slrsnlog.z3 < slrsns.z2 & ,
elrsnlog.z3 <= elrsns.z2);
then do;
if (unitlog.z3 = "DISK"); then do;
range.z3=range.z3 + erbalog.z3 - srba.z2;
end;
else do;
range.z3=range.z3 + erbalog.z3 - srbalog.z3;
end;
end;
when (slrsnlog.z3 < slrsns.z2 & ,
elrsnlog.z3 > elrsns.z2);
then do;
if (unitlog.z3 = "DISK"); then do;
range.z3=range.z3 + erba.z2 - srba.z2;
end;
else do;
range.z3=range.z3 + erba.z2 - srbalog.z3;
end;
end;
when (slrsnlog.z3 >= slrsns.z2 & ,
elrsnlog.z3 <= elrsns.z2);
then do;
range.z3=range.z3 + erbalog.z3 - srbalog.z3;
end;
when (slrsnlog.z3 >= slrsns.z2 & ,
slrsnlog.z3 <= elrsns.z2 & ,
elrsnlog.z3 > elrsns.z2);
then do;
range.z3=range.z3 + erba.z2 - srbalog.z3;
end;
otherwise; nop;
end;
end;
end;
end;
/* say "---LOGS mit Ranges";
do z4=1 to srbalog.0;
say "srbalog:" d2x(srbalog.z4,12) ,
"erbalog:" d2x(erbalog.z4,12) ,
memblog.z4 unitlog.z4 logtyp.z4 range.z4;
end;
*/
z4=0; /* Reduktion no ranges */
do z3=1 to srbalog.0;
if (range.z3 > 0); then do;
z4=z4+1;
srbalog.z4=srbalog.z3; erbalog.z4=erbalog.z3;
slrsnlog.z4=slrsnlog.z3; elrsnlog.z4=elrsnlog.z3;
memblog.z4=memblog.z3; unitlog.z4=unitlog.z3;
logtyp.z4=logtyp.z3; range.z4=range.z3;
end;
else nop;
end;
srbalog.0=z4;
/* say "---benötigte Logs";
do z3=1 to srbalog.0
say right(d2x(srbalog.z3),12) right(d2x(erbalog.z3),12),
right(d2x(slrsnlog.z3),12) right(d2x(elrsnlog.z3),12),
unitlog.z3 right(memblog.z3,2) logtyp.z3 range.z3;
end;
*/
/*--- Bestimmen erforderliche Anzahl Cart Units ----------------------*/
icunit=0; lgunit=0;
do z1=1 to slrsn.0;
if (devtyp.z1 <> 3390); then do;
icunit=icunit+1;
end;
end;
do z3=1 to srbalog.0;
if (unitlog.z3 <> "DISK"); then do;
lgunit=lgunit+1;
end;
end;
lgvts=lgunit;
lgunit=min(2,lgunit);
cartunit=max(icunit,lgunit);
/*--- Berechnung der Recoverytime ------------------------------------*/
icmount=icunit*mount;
pages=0;
do z1=1 to slrsn.0;
pages=pages+copypage.z1;
end;
tmresto=icmount+trunc(pages*60/resto,0);
apply=0;
lgmount=min(1,lgunit)*mount;
do z3=1 to srbalog.0;
if (unitlog.z3 = "DISK"); then do;
apply=apply+range.z3*60/logap;
end;
else do;
apply=apply+max(mount,range.z3*60/logap);
end;
end;
tmlgapp=trunc(apply,0);
tmtot=tmresto+tmlgapp;
tmtotmm=trunc(tmtot/60,0);
tmtotss=tmtot-tmtotmm*60;
/*--- Print Resultate ------------------------------------------------*/
z1=slrsn.0;
o=o+1; out.o=group right(dat tim,75);
o=o+1; out.o=left("",80,"-");
o=o+1; out.o=" ";
o=o+1; out.o="Annahmen:";
o=o+1; out.o=left(" mounts:",20) mount "Sek. / mount";
o=o+1; out.o=left(" restore:",20) format(resto,,,,2) ,
"Pages / Min.";
o=o+1; out.o=left(" logapply:",20) format(logap,,,,2) ,
"Bytes / Min.";
o=o+1; out.o=" ";
o=o+1; out.o="Pageset: " space", PART/DSNUM:" part;
o=o+1; out.o="benötige Card Units:" format(cartunit,12,0);
o=o+1; out.o="Imagecopies: " format(slrsn.0,12,0);
o=o+1; out.o=" Pages: " format(pages,12,0);
o=o+1; out.o=" LRSN: " right(d2x(slrsn.z1,12),12);
o=o+1; out.o="SYSLGRNX: " format(srba.0,12,0);
o=o+1; out.o="Arch- und Activlogs:" format(srbalog.0,12,0);
o=o+1; out.o="Archlogs auf VTS: " format(lgvts,12,0);
o=o+1; out.o="Recovery:";
o=o+1; out.o=" Restore: " format(tmresto,17) "Sek.";
o=o+1; out.o=" Logapply: " format(tmlgapp,17) "Sek.";
o=o+1; out.o=left(" ",36,"-");
o=o+1; out.o=" total: " ,
right(tmtotmm,16)":"right(tmtotss,2,"0") "Min.";
o=o+1; out.o=copies("-",80);
o=o+1; out.o=" ";
o=o+1; out.o="SYSLGRNX Tabelle";
o=o+1; out.o="MEMBER" left("STARTRBA",12) left("ENDRBA",12) ,
left("STARTLRSN",12) left("ENDLRSN",12);
do z2=1 to srba.0;
o=o+1; out.o=right(mbid.z2,6) ,
d2x(srba.z2,12) d2x(erba.z2,12) ,
d2x(slrsns.z2,12) d2x(elrsns.z2,12);,
end;
o=o+1; out.o=" ";
o=o+1; out.o="Log Tabelle";
o=o+1; out.o="MEMBER" left("STARTRBA",12) left("ENDRBA",12) ,
left("STARTLRSN",12) left("ENDLRSN",12) ,
left("UNIT",4) left("LOGTYP",6);
do z3=1 to srbalog.0;
o=o+1; out.o=right(memblog.z3,6) ,
d2x(srbalog.z3,12) d2x(erbalog.z3,12) ,
d2x(slrsnlog.z3,12) d2x(elrsnlog.z3,12) ,
unitlog.z3 logtyp.z3;
end;
o=o+1; out.o=left("",80,"=");
out.0=o;
address tso "execio * diskw PRINT (stem out. open";
/* address tso "execio * diskw PRINT (stem rpt.";
address tso "execio * diskw PRINT (stem bsdslst.";
*/ address tso "execio * diskw PRINT ( finis";
exit cc;
}¢--- A540769.WK.REXX.O08(DB2UT) cre=2008-07-07 mod=2008-12-22-17.39.32 F540769 ---
/* rexx ****************************************************************
db2Ut: Entwickler Interface für Db2 Utilites
dieses übernimmt verschiedene Funktionen von Db2Ut, typischerweise
in dieser Reihenfolge
* ohne parm: Aufruf von DB2Ut mit ispf newappl(DBUT)
* parm = panel: Anzeige des Panels und ausführen der Funktionen
* param = DB .... storedProcedure Db2UtilP aufrufen mit den
mitgegebenen Parametern
* rexxName = Db2UtilP Funktion der StoredProcedure Db2UtilP
************************************************************************
23.12.2008 W.Keller utTemplate mit m.explicitTempl
19.12.2008 F.Schuck REORG eingebaut
************************/ /* end help **********************************
09.12.2008 F.Schuck richtige Table fuer Load bzw. Fehlermeldung
04.12.2008 W.Keller fix uninitialisierte .delims variable
10.11.2008 W.Keller native jcl
17.10.2008 W.Keller delimited, help
17.09.2008 W.Keller neu
***********************************************************************/
m.self.version = '1.0 - 19.12.2008'
parse arg pArgs
parse upper var pArgs pA1 pA2 .
parse source s1 s2 s3 s4 s5
m.self.name = s3
m.out = 0
m.out.0 = 0
m.punch.0 = 0
m.debug = 0
m.maxRc = 0
call dbg 'db2Ut start' m.self.version 'args' pArgs
call dbg 'db2Ut start source' s1',' s2',' s3',' s4',' s5
call dbg 'db2Ut user' userid()
call catIni
call scanWinIni
m.id = userid()'.DB2UT'
m.cnf.procDb2Ut = 'DB2UTIL.DB2UTIL'
m.cnf.procSys = 'DB2ADMIN.DSNUTILS'
m.cnf.lf = '\'
m.cnf.eSt = '\' /* end of statement NO semicolon, lf */
m.mapTab = ''
m.templ.0 = 0
m.templ.copyD = "DSN('&SSID..&DB..&SN..P&PART..&UNIQ.')"m.cnf.lf,
"DATACLAS(ENN0X) MGMTCLAS(SUB#ADB1) STORCLAS(FAR$N)"m.cnf.lf,
"SPACE (100,10000) TRK"
m.templ.SYUTD = "DSN('&SSID..&DB..&SN..P&PART..&UNIQ..UT')"m.cnf.lf,
"DATACLAS(ENN0X) MGMTCLAS(COM#E001)"m.cnf.lf,
"SPACE (100,10000) TRK"
m.templ.SOUTD = "DSN('&SSID..&DB..&SN..P&PART..&UNIQ..SRT')"m.cnf.lf,
"DATACLAS(ENN0X) MGMTCLAS(COM#E001)"m.cnf.lf,
"SPACE (100,10000) TRK"
m.templ.srecd = ,
"DSN('&SSID..&DB..&SN..P&PART..D&YE(3).&MO.&DA..REC')"m.cnf.lf,
"DATACLAS(ENN0X) MGMTCLAS(COM#A032)"m.cnf.lf,
"SPACE (100,10000) TRK"
m.templ.new = ,
"DATACLAS(ENN0X) MGMTCLAS(COM#A041) STORCLAS(FAR$N)"m.cnf.lf,
"SPACE TRK MAXPRIME 600"
if s3 == 'DB2UTILP' then
call storedProcCall pArgs
else if pArgs = '' then
call switchIspfAppl
else if pA1 = 'PANEL' then
call doPanel
else if pA1 = 'DB' then
call sqlCallDb2Ut pA2, subWord(pArgs, 3)
else
call err 'bad pArgs' pArgs
mr = m.maxRc
call globalCleanup
exit mr
/*--- kleine Tests ---------------------------------------------------*/
exit testStoredProc('DBAF')
exit testmaptab()
exit testRebind()
call sqlCallDb2Ut
call testCopy1
exit
/*--- aufräumen am Ende des Programms --------------------------------*/
globalCleanup: procedure expose m.
if symbol('m.db') == 'VAR' & m.db <> '-' then do
call dbg 'committing in' m.db
call sqlCommit
call dbg 'disconnect from' m.db
call sqlDisconnect
end
do px=1 to m.punch.0
pu = m.punch.px
drop m.punch.pu
end
m.out.0 = 0
m.punch.0 = 0
m.maxRc = 0
drop m.db
return
endProcedure globalCleanup
/*--- set global variables -------------------------------------------*/
setGlobal: procedure expose m.
parse arg name, val
call dbg 'setting global' name '=' val
if name = 'DB' then do
if symbol('m.DB') == 'VAR' then
call err 'global db already set'
call sqlConnect val
end
m.name = val
return
endProcedure setGlobal
/***********************************************************************
panel Funktionen
***********************************************************************/
/*--- switch ispf application ----------------------------------------*/
switchIspfAppl: procedure expose m.
call adrIsp 'control errors return'
/* if we are in an edit macro, we must do a macro first */
call adrEdit 'macro (aa)', '*'
call adrIsp "select cmd(DB2UT panel) newappl(DBUT) passlib"
return
endProcedure switchIspfAppl
/*--- panel Verarbeitung ---------------------------------------------*/
doPanel: procedure expose m.
msg = ''
/* restart Punkt nach Fehlern */
doPanelRestart:
call adrIsp 'control errors return'
call errReset , 'signal doPanelErrHandler'
do forever
msg = doPanelOne(msg, errMsg)
call globalCleanup
if msg = 'end' then
exit /* nicht return wegen FehlerHandler | */
call doPanelErrMsg msg
end
/* error handler: Fehler anzeigen und wieder von vorn */
doPanelErrHandler:
call errReset 'h'
if ^ doPanelErrMsg(ggTxt) then do /* falls keine panel msg, */
call errSay ggTxt /* anzeigen im Tso */
msg = 'msg(dbut213)'
end
call globalCleanup
signal doPanelRestart
endProcedure doPanel
/*--- panelInfos aus FehlerMeldung rausholen -------------------------*/
doPanelErrMsg: procedure expose m. msg errmsg
parse arg txt
sx = pos('££', txt)
if sx < 1 then do
msg = ''
errMsg = ''
return 0
end
qq = substr(txt, sx+2)
ex = pos('££', qq)
if ex > 0 sx then
qq = left(qq, ex-1)
parse var qq msg '£' cur '£' errMsg
if msg = '' | length(msg) > 8 then
call err 'bad msg "'msg'" in' txt
msg = 'msg('msg')'
if cur <> '' then
msg = msg 'cursor('cur')'
return 1
endProcedure doPanelErrMsg
/*--- panel anzeigen und auf User reagieren --------------------------*/
doPanelOne: procedure expose m.
parse arg msg, errMsg
di = adrIsp('display panel(db2Ut)' msg, '*')
if di <> 0 then do
if di <> 4 & di <> 8 then
call out 'adrDisp rc' di
return 'end'
end
call mAdd mCut(st, 0), 'db' susy, 'id' id, t1 strip(obj1)
if t2 <> '' & obj2 <> '' then
call mAdd st, t2 strip(obj2)
if t3 <> '' & obj3 <> '' then
call mAdd st, t3 strip(obj3)
/* parameter für jede Utility Fun zusammenstellen */
do fx=1 to 3
fa = value('fu'fx)
if fa = '' then
iterate
if fa = 'LOA' | fa = 'UNL' then do
shr = 'SHRLEVEL' shr
if punch = '' then
punch = '-'
else
punch = dsn2jcl(punch)
if fa = 'UNL' then do
call mAdd st, fa dsn2jcl(loadf), punch, shr
if unli <> '' then
call mAdd st, 'LIMIT' unLi
if d = 'Y' then
call mAdd st, ' delimited' analyseDelimiter(delim)
end
else do
if punch = '' then do
if d = 'Y' then
oDelim = analyseDelimiter(delim)
else
oDelim = ''
end
else do
pn = loadPunch(punch)
if loadf ^== '' then
nop
else if pn ^== '' & m.pn.inDsn ^== '' then
loadf = m.pn.inDsn
oDelim = m.pn.delims
end
if loadf = '' then
return '££DBUT211£loadf££'
call mAdd st, fa dsn2jcl(loadf) shr 'resume' p
if oDelim <> '' then
call mAdd st, ' ' oDelim
if pn ^== '' then do
if t1 <> 'TB' | obj2 <> '' | obj3 <> '' ,
| verify(obj1, '*?,' , 'm') > 0 then
return '££DBUT218£t1££'
call mAdd st, ' into' obj1 m.pn.flds
end
end
end
else do
call mAdd st, fa
end
end
/* Funktion im gewählten runMode ausführen */
src = mCat(st, ' ')
call dbg 'panel db' susy 'src' src
call genJobcards mCut(jcl,0), jobCard1, jobCard2, jobCard3, jobCard4
if r = 'F' then do
call sqlCallDb2Ut susy, subword(src ,3)
end
else if r = 'V' then do
call genJcl jcl, susy, st
call outputSysprint jcl, 0
end
else if r = 'S' then do
call genJcl jcl, susy, st
call writeDsn 'SYSOUT(T) dd(ir) .WRITER(INTRDR)', 'M.JCL.', , 1
end
else if r = 'N' then do
call nativeJcl jcl, susy, subword(src ,3)
call outputSysprint jcl, 0
end
else do
return '££dbut212£r££'
end
return ''
endProcedure doPanelOne
/*--- delimiter syntax umformen:
wir erlauben nackte Zeichen, Strings oder hex Strings
und mehrere dürfen zusammengehängt sein
- Utility ist restriktiver -------------------------------------*/
analyseDelimiter: procedure expose m.
parse arg delim
de = ''
dc = 0
call scanReset ds
call scanSrc ds, delim
do while ^ scanAtEnd(scanSkip(ds))
hex = 0
if scanString(ds, ''' x'' X'' " x" X"') then do
d1 = m.ds.val
hex = pos(left(m.ds.tok, 1), 'xX') > 0
end
else do
call scanChar ds, 1
d1 = m.ds.tok
end
if ^ hex then do
do xx=1 by 1 to length(d1)
de = de quote(substr(d1, xx, 1), "'")
dc = dc + 1
end
end
else do
d1 = translate(m.ds.val)
if verify(d1, '0123456789ABCDEF') > 0 ,
| length(d1) // 2 <> 0 then
call scanErr ds, 'bad hex literal' ,
'££DBUT216£delim£'d1'££'
do xx=1 by 2 to length(d1)
de = de "X'"substr(d1, xx, 2)"'"
dc = dc + 1
end
end
end
if dc > 3 then
call err 'mehr als drei Delimiter' ,
'££DBUT217£delim£'de'££'
de = de subword("',' '""' '.'", dc+1)
if words(de) <> 3 then
call err 'delimiter not 3 words:' de
return de
endProcedure analyseDelimiter
/*--- punchfile einlesen und analysieren, falls nötig ----------------*/
loadPunch: procedure expose m.
parse arg pu
if pu = '-' then
return ''
if symbol('m.punch.pu') = 'VAR' then
nd = m.punch.pu
else do
nd = mAdd(punch, pu)
m.punch.pu = nd
call analysePunch nd, pu
end
return nd
endProcedure loadPunch
/*--- analyse a punchfile ----------------------------------------------
nd for punch info
puDsn: dsn of the punch file to analyse --------------------*/
analysePunch: procedure expose m.
parse arg nd, puDsn
if sysdsn("'"puDsn"'") <> 'OK' then
call err 'punch fehlt: ££DBut214£punch£' ,
|| puDsn':' sysdsn("'"puDsn"'")'££'
rdr = catMake('-r', puDsn)
sc = scanUtilSql(rdr)
call scanUtil sc
ld = 0
do while m.sc.utilType <> ''
if m.sc.utilType <> 'u' then do
call scanUtil sc
end
else if m.sc.val == 'TEMPLATE' then do
parse value analyseTemplate(sc) with nm templ.nm
end
else if m.sc.val == 'LOAD' then do
if ld then
call scanErr sc, 'more than one load'
ld = 1
call analyseLoad nd, sc
x = m.nd.inddn
if symbol('templ.x') = 'VAR' then
m.nd.inDsn = templ.x
else
m.nd.inDsn = ''
end
else do
call scanUtil sc
end
end
if ld < 1 then
call scanErr sc, 'no load'
call jClose rdr
return
endProcedure analysePunch
/*--- analyse a utility template statement
return <template name> <dsn> ----------------------------*/
analyseTemplate: procedure expose m.
parse arg sc
if scanUtil(sc) ^== 'n' then
call scanErr sc, 'template name expected'
res = m.sc.val
do while ^ (scanUtil(sc) = 'u' | m.sc.utilType = '')
if m.sc.utilType == 'n' & m.sc.utilBrackets = 0 then do
if m.sc.val = 'DSN' then
res = res scanUtilValue(sc, 1)
end
end
if words(res) > 2 then
call err 'to many dsns in template' res
return res
endProcedure analyseTemplate
/*--- analyse load put atts into stem nd -----------------------------*/
analyseLoad: procedure expose m.
parse arg nd, sc
if scanUtil(sc) ^== 'n' & m.sc.val ^== 'DATA' then
call scanErr sc, 'load data expected'
/* the load into syntax is too complex to analyse completely
we only catch the interesting (and disturbing) parts */
m.nd.inDdn = ''
m.nd.part = ''
m.nd.flds = ''
m.nd.tb = ''
m.nd.delims = ''
intos = 0
do while 'u' ^== scanUtil(sc) & m.sc.utilType ^== ''
if m.sc.utilType ^= 'n' | m.sc.utilBrackets ^= 0 then do
if m.sc.utilType = '(' then do
if m.sc.utilBrackets ^== 1 | intos ^== 1 then
call scanErr 'bad brackets for fields'
call scanBack sc, '('
m.nd.flds = '('scanUtilValue(sc, 0, m.cnf.lf)')'
end
iterate
end
opt = m.sc.val
if wordPos(opt, 'INDDN PART') > 0 then do
m.nd.opt = scanUtilValue(sc)
end
else if wordPos(opt, 'WHEN CCSID') > 0 then do
vv = scanUtilValue(sc) /* skip over brackets */
end
else if opt = 'INTO' then do
intos = intos+1
if intos > 1 then
call scanErr sc, 'more than one into not implemented'
if scanUtil(sc) ^== 'n' | m.sc.val ^== 'TABLE' then
call scanErr sc, 'into table expected'
if ^ scanSqlQuId(scanSkip(sc)) then
call scanErr sc, 'table name expected'
m.nd.tb = m.sc.val
m.nd.tbQu = m.sc.tok
end
else if opt = 'FORMAT' then do
if scanUtil(sc) ^== 'n' then
call scanErr sc, 'format type expected'
if m.sc.val = 'UNLOAD' then
iterate
else if m.sc.val ^== 'DELIMITED' then
call scanErr sc, 'format' m.sc.val 'not supported'
parse value "',' '""', '.'" with d.col d.cha d.dec
do while scanUtil(sc) == 'n' ,
& wordPos(m.sc.val, 'COLDEL CHARDEL DECPT') > 0
ky = left(m.sc.val, 3)
if ^ scanString(scanSkip(sc), "' x' X'") then
call scanErr sc, 'delimiter string expected'
d.ky = m.sc.tok
if ^abbrev(d.ky, "'") then
upper d.ky
end
m.nd.delims = 'DELIMITED' d.col d.cha d.dec
end
end
return
endProcedure analyseLoad
/*--- jcl generieren für Run mit db2ut -------------------------------*/
genJobcards: procedure expose m.
parse arg oo
do ax=2 to arg()
if arg(ax) <> '' then
call mAdd oo, arg(ax)
end
return
endProcedure genJobcards
genJcl: procedure expose m.
parse arg oo, susy, st
call mAdd jclTso(oo, 'db2Ut', 'S1', 1), "%DB2UT -"
do ix = 1 to m.st.0
line = strip(m.st.ix)
sx = 1
of = 4 - 2 * (wordPos(translate(word(line, 1)),
, 'ID DB COP RUN REB LOA UNL' ) > 0)
do forever
px = pos(m.cnf.lf, line, sx)
if px = 0 then do
call mAdd oo, left('', of)substr(line, sx) '-'
leave
end
call mAdd oo, left('', of)substr(line, sx, px-sx) '-'
of = 4
sx = px + 1
end
end
ox = m.oo.0
m.oo.ox = left(m.oo.ox, length(m.oo.ox)-1)
do ox=1 to m.oo.0
if length(m.oo.ox) >= 72 then
call err 'genJcl line overflow ('length(m.oo.ox)'):' m.oo.ox
end
return
endProcedure genJcl
/***********************************************************************
sql call auf db2UtilP und Ausgabe Output
***********************************************************************/
/*--- connect und sql call auf db2UtilP ------------------------------*/
sqlCallDb2Ut: procedure expose m.
parse arg db, src
if db <> '' then
call sqlConnect db
rst = 'NO'
retcode = -9876
e = ''
z = 0
call debugSqlCurrent 'before sql call'
call dbg "call" m.cnf.procDb2Ut "("src", ...)"
call sqlExec "call" m.cnf.procDb2Ut "(:src, :rst)", 0 +466
call dbg 'after call src='src
call debugSqlCurrent 'after sql call'
call outputSysprint , 1
return 0
endProcedure sqlCallDb2Ut
/*--- session sysprint oder stem ausgeben ----------------------------*/
outputSysprint: procedure expose m.
parse arg stem, summ
if m.out & m.out.0 > 0 & stem = '' then do
call sysPrintInsert out /* restlichen Output einfügen */
m.out.0 = 0
end
/* outputfile utilPrt allozieren */
if listDsi('utilPrt' file) <= 4 then
listDsi = 0
else
listDsi = sysReason
call dbg 'listDsi(utilPrt file)' listDsi sysMsgLvl2
if sysVar('sysISPF') = 'ACTIVE' then do
ty = 1
call adrTso 'alloc reuse dd(utilPrt)',
'recfm(v b) lrecl(136) block(32760) dsorg(PS)'
end
else if listDsi <> 2 then do
ty = 0 /* bereits alloziert */
end
else if SYSVAR('SYSENV') = 'FORE' then do
ty = 2
call adrTso 'alloc reuse dd(utilPrt) dsName(*)',
'recfm(v b) lrecl(136) block(32760) dsorg(PS)'
end
else if adrTso( 'alloc reuse sysout(*) dd(utilPrt)',
'recfm(v b) lrecl(136) block(32760) dsorg(PS)',
, '*') = 0 then do
ty = 3
end
else do
ty = -1
say '--- sysprint output'
end
if ty >= 0 then
call writeDDBegin utilPrt
if stem = '' then do /* daten aus session.sysprint */
Call sqlPreOpen 2, 'SELECT SEQNO, TEXT' ,
'FROM SESSION.SYSPRINT ORDER BY 1'
call dbg 'utility output sysprint'
stem = mCut(qq, 0)
do while sqlExec('fetch c2 into :seq, :txt', 0 100) = 0
call mAdd stem, strip(substr(txt, 2), 't')
end
call sqlClose 2
end
bb = mCut(bb, 0)
if summ == 1 then do
do ox=1 to m.stem.0
if abbrev(m.stem.ox, '+++') then do
call mAdd bb, m.stem.ox
r = word(m.stem.ox, words(m.stem.ox))
if datatype(r, 'n') then
m.maxRc = max(m.maxRc, r)
end
end
call mAdd bb, '+++' myTime() 'max rc' m.maxRc, ''
end
aa = mCut(aa, 0)
all = bb stem
ox = 0
do ax=1 to words(all)
st = word(all, ax)
do sx = 1 to m.st.0
txt = strip(m.st.sx, 't')
if ty < 0 then do
say txt
end
else do
do cx=1 by 132 while cx+132 <= length(txt)
ox = ox + 1
out.ox = substr(txt, cx, 132)
end
ox = ox + 1
out.ox = substr(txt, cx)
if ox > 100 then do
call writeDD utilPrt, out., ox
ox = 0
end
end
end
end
call writeDD utilPrt, out., ox
call writeDDEnd utilPrt
call dbg 'utilprt type' ty 'end output'
if ty = 1 then do /* view ouput */
call adrIsp "LMINIT DATAID(vwId) DDNAME(utilPrt) ENQ(SHRW)"
call dbg 'dataid' vwId
call adrIsp "VIEW DATAID("vwId")", 0 4
call adrIsp "LMFREE DATAID("vwId")"
end
if ty >= 1 then
call adrTso 'free dd(utilPrt)', '*'
return 0
endProcedure outputSysprint
myTime: procedure
return time() 'cpu' strip(sysvar('syscpu'))
/*--- say the contents of session.sysprint ---------------------------*/
showSysPrint: procedure expose m.
p = ':m.st.sx.'
call sqlPreAllCl 12, 'select seqNo, text',
'from session.sysPrint order by seqNo asc', st,
, p'sq,' p'tx'
say '-- sysprint has' m.st.0 'records'
do sx=1 to m.st.0
say right(m.st.sx.sq, 3) strip(m.st.sx.tx, 't')
end
return
endProcedure showSysprint
/*--- insert the lines sysibm.sysprint or stem oo (if not '')
into session.sysprint with prefix pref
if opt='b' before existing rows, otherwise after ---------------*/
sysprintInsert: procedure expose m.
parse arg oo, pref, opt
call sqlPreAllCl 12, 'select count(*), min(seqNO), max(seqNo)',
'from session.sysPrint', spr,
, ':cnt, :min :minI, :max :maxI'
call dbg 'sysprint count' cnt 'min' min minI 'max' max maxI
if oo <> '' then do
call sqlPrepare 5,"insert into session.sysPrint values (?, ?)"
if opt = 'b' then
sf = min - m.oo.0
else
sf = max + 1
sq = sf
do ix=1 to m.oo.0
tx = '?'pref || m.oo.ix /* printer vorschub auf pos 1 ||?*/
if length(tx) > 254 then
tx = left(tx, 251)'...'
call sqlExecute 5, sq, tx
sq = sq + 1
end
call dbg 'sysprint insert' oo'.'m.oo.0 'from' sf 'to' (sq-1)
end
else do
call sqlPreAllCl 12, 'select count(*), min(seqNO), max(seqNo)',
'from sysIbm.sysPrint', spr,
, ':sCn, :sMi :sMiI, :sMa :sMaI'
call dbg 'sysibm count' sCn 'min' sMi sMiI 'max' sMa sMaI
if sCn < 1 then
call out 'sysibm.sysprint is empty'
else
call sqlExec "insert into session.sysPrint" ,
"select seqno +" (max+1-sMi) ", text" ,
"from sysibm.sysprint"
end
return
endProcedure sysprintInsert
/***********************************************************************
stored procedure call:
scan parms generate utility and rebind statements
and call dsnUtilU to execeute them
***********************************************************************/
/*--- scan parms, do the work, put output into session.sysprint ------*/
storedProcCall: procedure expose m.
parse arg args
call activateErrHandler
call dbg 'stored Proc call'
res = scanStringRun('-', args)
call errReset 'h'
call globalCleanup
return res
endProcedure storedProcCall
/*--- activate the error handler for the stored proc -----------------*/
activateErrHandler: procedure expose m.
call dbg 'activating err handler'
m.out = 1
call errReset 'h', 'exit(errHandler(ggTxt))'
return
endProcedure activateErrHandler
/*--- stored proc error handler insert error messages
into session.sysprint ----------------------------*/
errHandler: procedure expose m.
parse arg msg
call errReset 'h'
call errSay msg, st, 'e'
do sx=1 to m.st.0
call out m.st.sx
end
say '| inserting output into session.sysprint'
call sysprintInsert out
m.out.0 = 0
/* keine gute Idee, es kommt nur Schrott vom letzten Mal||| ???
say '| insert sysibm.sysprint into session.sysprint'
call sysprintInsert */
say '| globalCleanup'
call globalCleanup
call out '||| error' msg
call out '+++' myTime() 'error exit 12'
say '| inserting output into session.sysprint'
call sysprintInsert out
m.out.0 = 0
say '||| exit(12) |||'
exit(12)
endProcedure errHandler
/*--- connect to pDb, scan src, do the work and
insert output into session.sysprint ---------------------*/
scanStringRun: procedure expose m.
parse arg pDb, src
if pDb <> '' then
call setGlobal 'DB', pDb
if sqlExImm('declare global temporary table sysprint',
'(SEQNO INTEGER NOT NULL,',
'TEXT VARCHAR(254))', -601) = -601 then
call sqlExec 'DELETE FROM SESSION.SYSPRINT', 100
call sqlExec 'set :us = user'
m.superUser = us = 'A695189'
m.explicitTempl = 1
call sqlExec "insert into session.SYSPRINT values",
"(1, '?--- "m.self.name" start'",
"|| ' at" myTime()"'",
"|| ', version " m.self.version"'",
"|| ', db2 member ' || current member)"
call sqlExec "insert into session.SYSPRINT values",
"(2,' sqlUser" strip(us) m.superuser"'",
"|| ', osUser " userid()"')"
call debugSqlCurrent 'scanStringRun db' m.db
call genStatements mCut(gen, 0), src
if m.mapTab ^== '' then
/* das muessen wir vor dem PackageSwitch machen, weil
create statements nur fuer ein Package mit
mit DYNAMICRULES(RUN) erlaubt (sonst SQL -549)
fehlt dem Benutzer die Berechtigung
bekommt er eine Fehlermehldung */
call createMapTab m.mapTab
if pDb = '-' then do
call debugSqlCurrent 'before switch pkg'
call sqlExec "set current packageset = 'DB2ADMIN'"
call debugSqlCurrent 'after switch pkg'
end
cnt = 0
succ = 0
do gx=1 to m.gen.0
if abbrev(m.gen.gx, 'REBIND ') then do
parse var m.gen.gx st '-- ' info
call out '---' st
call out '-- ' info
cnt = cnt + 1
succ = succ + bindCommand(st)
end
else do
call runUtility m.id, m.gen.gx
end
end
if cnt <> succ then
call out '+++' cnt 'rebinds,' (cnt-succ) 'unsuccessful, rc 4'
else if cnt <> 0 then
call out '+++' cnt 'rebinds, all successful, rc 0'
call out "---" myTime() m.self.name "stop"
call sysPrintInsert out
return 0
endProcedure scanStringRun
/*--- connect to pDb, scan src, do the work and
insert output into session.sysprint ---------------------*/
nativeJcl: procedure expose m.
parse arg oo, pDb, src
if pDb <> '' then
call setGlobal 'DB', pDb
call debugSqlCurrent 'nativeJcl db' m.db
m.superuser = -1
m.explicitTempl = 0
call genStatements mCut(gen, 0), src
inReb = 0
step = 0
do gx=1 to m.gen.0
if abbrev(m.gen.gx, 'REBIND ') then do
parse var m.gen.gx st '-- ' info
if ^inReb then do
inReb = 1
step = step + 1
call jclTso oo, "db2 rebind", 'S'step, 0
call mAdd oo, "DSN SYS("m.db")"
end
call mAdd oo, st '-', ' /*' info '*/'
end
else do
inReb = 0
step = step + 1
call mAdd oo,
, left("//*", 50, '-') "db2 utility",
, "//S"step " EXEC PGM=DSNUTILB,REGION=0M,",
|| "PARM=("m.db",'"m.id"')" ,
, "//DSSPRINT DD SYSOUT=*" ,
, "//SYSPRINT DD SYSOUT=*" ,
, "//SYSUDUMP DD SYSOUT=*" ,
, "//UTPRINT DD SYSOUT=*" ,
, "//STPRIN01 DD SYSOUT=*" ,
, "//DUMMY DD DUMMY " ,
, "//SYSTEMPL DD DISP=SHR," ,
|| "DSN="m.db".DBAA.LISTDEF(TEMPL)" ,
, "//SYSIN DD *"
call utilityFormat oo, m.gen.gx
end
end
return 0
endProcedure nativeJcl
jclTso: procedure expose m.
parse arg oo, tit, step, proc
call mAdd oo ,
, left("//*", 50, '-') tit ,
, "//"left(step,9) "EXEC PGM=IKJEFT01,DYNAMNBR=200" ,
, "//SYSTSPRT DD SYSOUT=*" ,
, "//SYSPRINT DD SYSOUT=*"
if proc then
call mAdd oo, "//SYSPROC DD DISP=SHR,DSN=TSO.RZ1.P0.USER.EXEC"
call mAdd oo, "//SYSTSIN DD *"
return oo
endProcedure jclTso
genStatements: procedure expose m.
parse arg gen, src
call mCut c, 0
m.c.list = mCut(l, 0)
call utScanString c, src
call expandLists c
util = utGen(c)
if util = '' then
call out '--- no utility statements generated'
else
call mAdd gen, util
rebCnt = genRebinds(gen, c)
if util = '' & rebCnt = 0 then
call out "+++ nothing to do rc 4"
return
endProcedure genStatements
/*--- scan src, build tasks into stem u ------------------------------*/
utScanString: procedure expose m.
parse arg u, src
call scanSqlReset sc, , 0
call scanSrc sc, src
return utScan(u, sc)
endProcedure ut ScanString
/*--- build tasks into stem u by scanning with sc --------------------*/
utScan: procedure expose m.
parse arg u, sc
m.sc.utilBrackets = 0
utilAll = 'COPY RUNSTATS REBIND LOAD UNLOAD REORG'
gloAll = 'DB ID'
laLi = ''
call scanSqlType sc
do while m.sc.sqlType ^== ''
if utScanList(m.u.list, sc) then do
l = m.u.list
laLi = l'.'m.l.0
call dbg 'new list' laLi 'len' m.laLi.0
do x=1 to m.laLi.0
call dbg x m.laLi.x m.laLi.x.ts
end
end
else if m.sc.sqlType = 'i' ,
& wordPos(m.sc.val, gloAll) > 0 then do
g = m.sc.val
if scanSqlQuId(sc) then
call setGlobal g, m.sc.val
else if scanLit(sc, '-') then
call setGlobal g, '-'
else
call scanErr sc, 'qual id excpected after' g
call scanSqlType sc
end
else if m.sc.sqlType = 'i' ,
& pos(' 'm.sc.val, ' 'utilAll) > 0 then do
uw = word(substr(utilAll, pos(' 'm.sc.val, ' 'utilAll)), 1)
nd = mAdd(u, uw)
m.nd.util = uw
m.nd.shrlevel = 'C'
m.nd.delims = ''
m.nd.limit = ''
m.nd.list = laLi
if laLii = '' then
call scanErr sc, m.nd.util 'without list'
if uw = 'LOAD' | uw = 'UNLOAD' then do
if ^ scanVerify(scanSkip(sc), ' ', 'm') then
call scanErr sc, 'load file dsn expected'
m.nd.loadfile = m.sc.tok
m.nd.0 = 0
end
if uw = 'UNLOAD' then do
if ^ scanVerify(scanSkip(sc), ' ', 'm') then
call scanErr sc, 'punch file dsn expected'
m.nd.punchfile = m.sc.tok
end
call scanSqlType scanSkip(sc)
call utScanOpts nd, sc
end
else if m.sc.sqlType = 'i' & m.sc.val = 'INTO' then do
if m.nd.util <> 'LOAD' then
call scanErr sc, 'into must be in LOAD'
if ^ scanSqlQuID(sc) then
call scanErr 'table name expected'
in = mAdd(nd, m.sc.val)
m.in.tbQu = m.sc.tok
nx = scanUtil(sc)
call scanBack sc, m.sc.tok
m.in.flds = ''
if nx = '(' then do
m.in.flds = '(' scanUtilValue(sc, 0) ')'
call scanSqlType sc
end
end
else if m.sc.sqlType = 'i' & m.sc.val = 'DELIMITED' then do
if m.nd.util <> 'LOAD' & m.nd.util <> 'UNLOAD' then
call scanErr sc, 'delimited must be in LOAD or UNLOAD'
call scanSqlType sc
m.nd.delims = 'DELIMITED COLDEL' delWo(sc) ,
'CHARDEL' delWo(sc) 'DECPT' delWo(sc)
end
else do
call scanErr sc, 'list or' utilAll 'excpected'
end
end
return 1
endProcedure utScan
/*--- scan a word for delimiter syntax -------------------------------*/
delWo: procedure expose m.
parse arg sc
if m.sc.sqlType ^== 's' then
call scanErr sc, "delimiter expected (',' or x'25')"
res = m.sc.tok
call scanSqlType sc
return res
endProcedure delWo
/*--- if the scanner is at a list, scannit and add it to l -----------*/
utScanList: procedure expose m.
parse arg l, sc
listAll = 'TB TS VW'
if m.sc.sqlType ^== 'i' | wordPos(m.sc.val, listAll) < 1 then
return 0
nl = mCut(mAdd(l, 'list'), 0)
do while m.sc.sqlType == 'i' & wordPos(m.sc.val, listAll) > 0
ty = m.sc.val
do forever
if ^ quMask(sc) then
call scanErr sc, 'qualified id for' ty 'expected'
name = m.sc.val
call scanSqlType sc
pa = ''
if m.sc.sqlType = '*' then do
pa = '*'
call scanSqlType sc
end
else do while m.sc.sqlType = 'n'
pa = pa m.sc.val
call scanSqlType sc
if m.sc.sqlType = '-' then do
call scanSqlType sc
if m.sc.sqlType ^== 'n' then
call scanErr sc, 'number expected after -'
pa = pa'-'m.sc.val
call scanSqlType sc
end
else if m.sc.sqlType = 'n' & abbrev(m.sc.val,'-')then do
pa = pa || m.sc.val
call scanSqlType sc
end
end
n1 = mAdd(nl, ty)
m.n1.ts = name
m.n1.parts = pa
if m.sc.sqlType ^== ',' then
leave
end
end
return 1
endProcedure utScanList
/*--- scan a qualifier with mask characters (* ?) --------------------*/
quMask: procedure expose m.
parse arg sc
old1 = m.sc.scanName1
oldR = m.sc.scanNameR
m.sc.scanName1 = old1'*?%_\'
m.sc.scanNameR = oldR'*?%_\'
res = scanSqlQuId(sc)
m.sc.scanName1 = old1
m.sc.scanNameR = oldR
return res
endProcedure quMask
/*--- scan options an put them into u --------------------------------*/
utScanOpts: procedure expose m.
parse arg u, sc
optsAll = ' SHRLEVEL LIMIT RESUME '
do forever
px = pos(' 'm.sc.val, optsAll)
if m.sc.sqlType ^== 'i' | px < 1 then
return 0
if px = pos(' 'm.sc.val, optsAll, px+2) > 0 then
call scanErr sc, 'abbreviation not unique' m.sc.val
att = word(substr(optsAll, px), 1)
if ^ scanSqlType(sc) & pos(m.sc.sqlType, 'in') < 1 then
call scanErr sc, 'value expected for' att
m.u.att = m.sc.val
call scanSqlType sc
end
return
endProcedure utScanOpts
/***********************************************************************
expand lists. query db2Catalog to expand wildcards
***********************************************************************/
/*--- expand all lists -----------------------------------------------*/
expandLists: procedure expose m.
parse arg c
lstLst = m.c.list
do cx = 1 to m.c.0
src = m.c.cx.list
if symbol('st.src') = 'VAR' then do
m.src.list = st.src
iterate
end
trg = mCut(mAdd(lstLst, 'expList' src), 0)
st.src = trg
m.src.list = trg
if m.explicitTempl then
call out ' list' cx
do sx=1 to m.src.0
call expandAdd trg, m.src.sx, m.src.sx.ts, m.src.sx.parts
end
end
return
endProcedure expandLists
/*--- expand one list entry and add the results to lst ---------------*/
expandAdd: procedure expose m.
parse arg lst, ty, qu '.' na, pa
if m.explicitTempl then
call out ' expanding' ty qu'.'na pa
/* build the sql */
sqS = 'select distinct strip(t.creator), strip(t.name),',
'strip(t.dbName), strip(t.tsName),',
's.partitions, s.nTables' ,
'from sysIbm.sysTables t, sysIbm.sysTablespace s'
sqW = 'where t.tsName = s.name and t.dbName = s.dbName',
"and t.type = 'T'"
if ty = 'TS' then
sq = sqS sqW 'and t.dbName' sqlClause(qu) ,
'and t.tsName' sqlClause(na)
else if ty = 'TB' then
sq = sqS sqW 'and t.creator' sqlClause(qu) ,
'and t.name' sqlClause(na)
else if ty = 'VW' then
sq = "with pa (cre, nam, typ, lev) as" ,
"( select bCreator, bName, bType, 1" ,
"from sysibm.sysViewDep" ,
"where dType = 'V'" ,
"and dCreator" sqlClause(qu) ,
"and dName" sqlClause(na) ,
"union all select d.bCreator, d.bName," ,
"d.bType, p.lev+1" ,
"from sysibm.sysViewDep d, pa p" ,
"where d.dcreator = p.cre and d.dName = p.nam" ,
"and d.dType = p.Typ and p.lev < 1000" ,
")" sqS ", pa p" sqW ,
"and p.typ = 'T' and p.cre = t.creator" ,
"and p.nam = t.name"
else
call err 'bad list type' ty 'for' qu'.'na pa
call dbg 'exp sql' sq
call sqlPreOpen 1, sq
xOld = m.lst.0
do x=xOld+1 by 1 /* fetch the result rows */
z = lst'.' || x
y = ':m.'z'.'
if ^ sqlFetchInto(1, y'CR,' y'TB,',
y'db,' y'ts,' y'paCnt,' y'tbCnt') then
leave
ky = m.z.cr'.'m.z.tb
/* check authorization */
if m.superuser == -1 then do
m.auth.ky = ''
end
else if symbol('m.auth.ky') ^== 'VAR' then do
aa = 'delete from' ky
if sqlExec('prepare s9 from :aa', '0 -551') = 0 then do
m.auth.ky = 'w'
end
else do
m.auth.ky = 'r' sqlMsg()
call dbg 'no auth w' ky m.auth.ky
aa = 'select 1 from' ky
if sqlExec('prepare s9 from :aa', '0 -551') = -551 then
m.auth.ky = '-' sqlMsg()
end
end
m.z.auth = m.auth.ky
if m.explicitTempl | m.debug then
call out ' ts' m.z.db'.'m.z.ts',' m.z.paCnt 'parts,' ,
m.z.tbCnt 'tables:' ky', auth' m.z.auth
m.z.parts = pa
call dbg 'llll' z m.z.auth parts m.z.parts
end
m.lst.0 = x-1
call sqlClose 1
call dbg 'fetched' m.lst.0 - xOld
return
endProcedure expandAdd
/*--- return a sql clause = val, like val, like val escape -----------*/
sqlClause: procedure expose m.
parse arg val
if verify(val, '*?', 'm') < 1 then
return '=' quote(val, "'")
else if verify(val, '_%', 'm') < 1 then
return 'like' quote(translate(val, '%_', '*?'), "'")
call dbg 'sql val before' val
cx = -1
do while cx < length(val)
cx = verify(val, '\_%', 'm', cx+2)
if cx < 1 then
leave
val = left(val, cx-1)'\'substr(val, cx)
end
val = translate(val, '%_', '*?')
call dbg 'sql val after ' val
return 'like' quote(val, "'") "escape '\'"
endProcedure sqlClause
/***********************************************************************
generate utility statements
***********************************************************************/
/*--- generate all utility statements --------------------------------*/
utGen: procedure expose m.
parse arg utSt
st = ''
do ux=1 to m.utSt.0
u = utSt'.'ux
if m.u.util = 'COPY' then
st = st utCopy(u)
else if m.u.util = 'LOAD' then
st = st utLoad(u)
else if m.u.util = 'RUNSTATS' then
st = st utRunstats(u)
else if m.u.util = 'UNLOAD' then
st = st utUnload(u)
else if m.u.util = 'REORG' then
st = st utReorg(u)
else if wordPos(m.u.util, 'REBIND') < 1 then
call err 'utility' m.u.util 'not implemented (yet)'
end
return st
endProcedure utGen
/*--- generate copy --------------------------------------------------*/
utCopy: procedure expose m.
parse arg u
listDef = utListDef(m.u.list, 1, 'r')
if listDef = '' then do
call out '+++ copy on empty list, rc 4'
return ''
end
tCo = utTemplate('COPYD')
st = subword(tCo, 2)
st = st subword(listdef, 2) ,
'COPY LIST' word(listdef, 1),
'COPYDDN('word(tCo, 1)') FULL YES PARALLEL' m.cnf.lf,
'SHRLEVEL' word('REFERENCE CHANGE',
, 2 - abbrev(m.c.shrLevel, 'R'))
return st m.cnf.eSt
endProcedure utCopy
/*--- generate runstats ----------------------------------------------*/
utRunstats: procedure expose m.
parse arg u
listDef = utListDef(m.u.list, 0, 'w')
if listDef = '' then do
call out '+++ runstats on empty list, rc 4'
return ''
end
st = subword(listdef, 2) ,
'RUNSTATS TABLESPACE LIST' word(listdef,1),
'INDEX(ALL) UPDATE(ALL) SHRLEVEL CHANGE'
return st m.cnf.eSt
endProcedure genRunstats
/*--- generate unload ------------------------------------------------*/
utUnload: procedure expose m.
parse arg u
ll = m.u.list
listDef = utListDef(ll, 0, 'w', 'tbCnt')
ll = m.ll.list
if m.ll.0 < 1 then do
call out '+++ unload on empty list, rc 4'
return ''
end
tLo = utTemplate('LOAD', m.u.loadFile)
tPu = utTemplate('PUNCH', m.u.punchFile)
st = subword(tLo,2) subword(tPu, 2)
do lx = 1 to m.ll.0
st = st 'UNLOAD DATA FROM TABLE' m.ll.lx.cr'.'m.ll.lx.tb
if m.u.limit <> '' then
st = st 'LIMIT' m.u.limit
st = st m.cnf.lf,
'UNLDDN' word(tLo, 1) m.cnf.lf,
'PUNCHDDN' word(tPu, 1) m.cnf.lf,
m.u.delims utShr(m.u.shrlevel) m.cnf.eSt
end
return st
endProcedure utUnload
/*--- generate load --------------------------------------------------*/
utLoad: procedure expose m.
parse arg u
ll = m.u.list
listDef = utListDef(ll, 1, 'w', 'tbCnt')
ll = m.ll.list
if m.ll.0 < 1 then do
call out '+++ load on empty list, rc 4'
return ''
end
tCo = utTemplate('COPYD')
tLo = utTemplate('LOAD', m.u.loadFile)
tWo = utTemplate('WORKDDN')
st = subword(tLo, 2) subword(tCo, 2) subword(tWo, 2)
if abbrev('YES', m.u.resume) then
rere = 'RESUME YES' utshr(m.u.shrlevel)
else if abbrev('NO', m.u.resume) then
rere = 'RESUME NO REPLACE COPYDDN' word(tCo, 1)m.cnf.lf,
'STATISTICS INDEX ALL UPDATE ALL'
else
call err 'bad resume' m.u.resume
do lx = 1 to m.ll.0
st = st 'LOAD INDDN' word(tLo, 1) rere m.cnf.lf ,
word(tWo, 1) m.cnf.lf
if m.u.delims <> '' then
st = st 'FORMAT' m.u.delims
crTb = m.ll.lx.cr'.'m.ll.lx.tb
do ix = 1 to m.u.0 until m.u.ix = crTb
end
if ix > m.u.0 then do
st = st 'INTO TABLE' crTb
end
else do
in = u'.'ix
st = st 'INTO TABLE' m.in.tbQu
if m.in.flds <> '' then
st = st m.cnf.lf m.in.flds
end
st = st m.cnf.eSt
end
return st
endProcedure utLoad
/*--- generate Reorg -------------------------------------------------*/
utReorg: procedure expose m.
parse arg u
listDef = utListDef(m.u.list, 0, 'w')
mt = m.id
if pos('.', mt) > 0 then
mt = left(mt, pos('.', mt) - 1)
if mt = '' then
call err 'bad utility id' m.id 'gives empty mapTab'
m.mapTab = 'S100447.'mt
if listDef = '' then do
call out '+++ reorg on empty list, rc 4'
return ''
end
st = ''
tCo = utTemplate('COPYD')
tRe = utTemplate('SRECD')
tWo = utTemplate('WORKDDN')
st = subword(tCo, 2) subword(tRe, 2) subword(tWo, 2)
st = st subword(listdef, 2) ,
'REORG TABLESPACE LIST' word(listdef, 1) m.cnf.lf,
'LOG NO SORTDATA NOSYSREC SORTKEYS' m.cnf.lf,
'COPYDDN('word(tCo, 1)')'m.cnf.lf,
'SHRLEVEL CHANGE' m.cnf.lf,
'DRAIN_WAIT 1800 RETRY 0 RETRY_DELAY 300'm.cnf.lf,
'MAPPINGTABLE' m.mapTab m.cnf.lf,
'MAXRO 120 DRAIN WRITERS LONGLOG CONTINUE' m.cnf.lf,
'DELAY 1200 TIMEOUT TERM' m.cnf.lf,
'UNLDDN('word(tRe, 1)')' m.cnf.lf,
word(tWo, 1) 'SORTDEVT DISK SORTNUM 48' m.cnf.lf,
'STATISTICS INDEX ALL KEYCARD REPORT NO' m.cnf.lf,
'UPDATE ALL HISTORY NONE FORCEROLLUP NO'
return st m.cnf.eSt
endProcedure utReorg
/*--- Create Mappingtable für Reorg if necessary
Mappintable heisst S100447.name in DB2MAPUT.name -------*/
createMaptab: procedure expose m.
parse upper arg cr '.' name
if sqlPreAllCl(5,'SELECT 1',
'FROM SYSIBM.SYSTABLES' ,
"WHERE CREATOR = '"cr"'" ,
"AND NAME = '"NAME"' AND TYPE = 'T'",
, st , ':haha') > 0 then
return cr'.'name
call sqlCommit /* sonst ist nach rollback session.sysprint weg */
call debugSqlCurrent 'before switch sql'
sc = sqlExec("set current sqlid = 'S100447'", '*')
call debugSqlCurrent 'after switch sql'
if sc = 0 then
if sqlExec('CREATE DATABASE DB2MAPUT',
'BUFFERPOOL BP2',
'INDEXBP BP1',
'CCSID EBCDIC',
'STOGROUP GSMS',
, '*') = -601 then /* wenn vorhanden, dann ok */
sc = 0
/* Tablespace für Maptab */
if sc = 0 then
sc = sqlExec('CREATE TABLESPACE' name,
'IN DB2MAPUT',
'USING STOGROUP GSMS',
'PRIQTY 12 SECQTY 48',
'ERASE NO ',
'FREEPAGE 0 PCTFREE 5',
'GBPCACHE CHANGED',
'TRACKMOD YES ',
'SEGSIZE 64 ',
'BUFFERPOOL BP2 ',
'LOCKSIZE ANY ',
'LOCKMAX SYSTEM ',
'CLOSE YES ',
'COMPRESS NO ',
'CCSID EBCDIC',
'DEFINE YES ',
'MAXROWS 255',
, '*')
/* Mappingtable anlegen */
if sc = 0 then
sc = sqlExec( 'CREATE TABLE' cr'.'name,
'("TYPE" CHAR(1) FOR SBCS DATA NOT NULL,',
'SOURCE_RID CHAR(5) FOR SBCS DATA NOT NULL,',
'TARGET_XRID CHAR(9) FOR SBCS DATA NOT NULL with default,',
'LRSN CHAR(6) FOR SBCS DATA NOT NULL)',
'IN DB2MAPUT.'name ' audit none ccsid ebcdic not volatile',
, '*')
if sc = 0 then
sc = sqlExec('CREATE UNIQUE INDEX' cr'.I'name,
'ON' cr'.'name,
'(SOURCE_RID ASC,',
' "TYPE" ASC,',
'TARGET_XRID ASC,',
'LRSN ASC)',
'USING STOGROUP GSMS',
'PRIQTY -1 SECQTY -1',
'ERASE NO',
'FREEPAGE 0 PCTFREE 10',
'GBPCACHE CHANGED',
'NOT CLUSTER',
'CLOSE YES',
'COPY NO',
'DEFINE YES',
'PIECESIZE 2 G',
, '*')
if sc = 0 then do
call sqlCommit
return cr'.'name
end
call out ' '
call out '+++ Sie haben keine Berechtigung,'
call out '+++ die Mappingtable' cr'.'name 'zu erstellen'
call out '+++ bitte wenden Sie sich an die Db2 Administration'
call out ' '
call out sqlMsg()
call sqlExec 'rollback'
call err 'Berechtigung fuer MappgingTable'
endProcedure createMaptab
/*--- generate listdef -----------------------------------------------*/
utListDef: procedure expose m.
parse arg l, allParts, necAuth, checks
call dbg 'utListDef' l '-->' m.l.list
l = m.l.list
if m.l.0 = 0 then
return ''
if symbol('m.listdef') == 'VAR' then
m.listdef = m.listdef + 1
else
m.listdef = 1
st = 'LIST'm.listdef
st = st 'LISTDEF' st
if pos('tbCnt', checks) > 0 then do
do x=1 to m.l.0
if m.l.x.tbCnt <> 1 then
call err 'nur 1 table unterstuetzt, nicht' m.l.x.tbCnt,
'in ts' m.l.x.db'.'m.l.x.ts,
'mit table' m.l.x.cr'.'m.l.x.tb
end
end
do x=1 to m.l.0
aa = word(m.l.x.auth, 1)
if m.superUser == -1 then
nop
else if wordPos(necAuth || aa, 'ww rw rr') > 0 then
call dbg 'auth' necAuth 'allowed for' ,
m.l.x.cr'.'m.l.x.tb 'in' m.l.x.db'.'m.l.x.ts aa
else if m.superUser == 1 then
call out 'ignoring authorization' necAuth 'for',
m.l.x.cr'.'m.l.x.tb 'in' m.l.x.db'.'m.l.x.ts m.l.x.auth
else
call err 'authorization' necAuth 'error for',
m.l.x.cr'.'m.l.x.tb 'in' m.l.x.db'.'m.l.x.ts m.l.x.auth
st = st m.cnf.lf 'INCLUDE TABLESPACE' m.l.x.db'.'m.l.x.ts
if ^ abbrev('*', m.l.x.parts) then
st = st 'PARTLEVEL' m.l.x.parts
else if allParts then
st = st 'PARTLEVEL'
end
return st m.cnf.eSt
endProcedure utListDef
/*--- generate shrlevel ----------------------------------------------*/
utShr: procedure expose m.
parse arg lv, opt
if abbrev('CHANGE', lv) then
return 'SHRLEVEL CHANGE'
if abbrev('REFERENCE', lv) then
return 'SHRLEVEL REFERENCE'
if ^ abbrev('NONE', lv) then
call err 'bad shrLevel' lv
if opt = 1 then
return 'SHRLEVEL NONE'
else
return ''
endProcedure utShr
/*--- generate template ----------------------------------------------*/
utTemplate: procedure expose m.
parse upper arg ty, dsn
nm = 'T'ty
if dsn = '' then do
if m.templ.gen.nm == 1 then
return nm
if ty = 'WORKDDN' then do
u = utTemplate('SYUTD')
s = utTemplate('SOUTD')
return 'WORKDDN('word(u, 1)','word(s, 1)')' ,
subword(u, 2) subword(s, 2)
end
m.templ.gen.nm = 1
end
else if dsn = 'DUMMY' then do
return DUMMY
end
else do
dsn = "DSN('"dsn"')"m.cnf.lf
nm = nm || mInc(templ.0)
end
m.templ.name = nm
if wordPos(ty, 'COPYD SYUTD SOUTD SRECD') < 1 then
return nm 'TEMPLATE' nm dsn m.templ.new m.cnf.eSt
else if m.explicitTempl then
return nm 'TEMPLATE' nm dsn m.templ.ty m.cnf.eSt
else
return nm
endProcedure utTemplate
/*--- run utility with the given stamtents and write output ----------*/
runUtility: procedure expose m.
parse arg utId, st
call scanUtilReset xxx
call out ''
call out '--- utility statements'
call utilityFormat , st
st = translate(st, ' ', m.cnf.lf)
call dbg 'util st' length(st)':' st
rst = 'NO'
retcode = -9876
e = ''
z = 0
call out
call out '---' myTime() "exec sql call" m.cnf.procSys "("utId",...)"
src = "call" m.cnf.procSys"( :utId, :rst,",
":st,:retcode, :ANY" copies(',:e,:e,:z',12) ")"
if m.debug == 1 then do
call debugSqlCurrent 'before sql' src
call dbg ' with utId' utId
call dbg ' with rst' rst
call dbg ' with st' st
call dbg ' with e' e
call dbg ' with z' z
end
call sqlExec src, 0 +466
call out '---' myTime() 'utility retCode' retCode
call out '--- utility output'
call sysPrintInsert out
m.out.0 = 0
call sysPrintInsert
call out '--- end utility output'
call out '+++' myTime() 'utility retCode' retCode
call sysPrintInsert out
m.out.0 = 0
return
endProcedure runUtility
/*--- write the utility statements in st
formated in lines to stem oo -------------------------------*/
utilityFormat: procedure expose m.
parse arg oo, st
call scanUtilReset xxx
x = 0
cont = 0
do while x < length(st)
y = pos(m.cnf.lf, st, x+1)
if y = 0 then
y = length(st) + 1
li = strip(substr(st, x+1, y-x-1))
cont = wordPos(word(li, 1), m.scanUtil) < 1
if oo = '' then
call out left('', 4 * cont)li
else
call mAdd oo, left('', 4 * cont)li
x = y
end
return
endProcedure utilityFormat
/***********************************************************************
rebinds
***********************************************************************/
/*--- all rebinds ----------------------------------------------------*/
doRebind: procedure expose m.
parse arg utSt
oldDb = ''
sel = ''
do ux=1 to m.utSt.0
u = utSt'.'ux
if m.u.util ^= 'REBIND' then
iterate
gotRebind = 1
l = m.u.list
listDef = utListDef(l, 0, 'w') /* check authorization */
call dbg 'list' l m.l.0
l = m.l.list
do lx=1 to m.l.0
call dbg 'rebind tb' m.l.lx.cr'.'m.l.lx.tb
if oldDb <> m.l.lx.DB then do
oldDb = m.l.lx.DB
sel = sel ")) or (bQualifier='"oldDb"' and bName in ('"
end
else do
sel = sel", '"
end
sel = sel || m.l.lx.ts"'"
call dbg 'sel +' sel
end
end
if sel = '' then do
if gotRebind = 1 then
call out '+++ no rebinds for empty object list, rc 4'
return 0
end
sel = substr(sel, 7)'))'
call dbg 'sel =' sel
p = ':m.pk.sx.'
call sqlPreOpen 8,
, "select distinct dCollid, dName, dContoken, version, p.type,",
"p.bindTime, p.valid, p.operative",
"from sysibm.sysPackDep d, sysibm.sysPackage p" ,
"where bType in ('P', 'R')" ,
"and d.dLocation = p.location" ,
"and d.dCollid = p.collid" ,
"and d.dName = p.name" ,
"and d.dConToken = p.conToken" ,
"and ("sel")" ,
"order by 2, 4, 1"
succ = 0
do sx=1 while sqlFetchInto(8, ':col, :nam, :cTo, :ver, :typ,' ,
':bTi, :val, :ope')
call dbg sx col nam c2x(cTo) ver typ bTi 'vo' val ope
st = 'PACKAGE('strip(col)'.'strip(nam)
if typ = 'T' then
st = 'REBIND TRIGGER' st')'
else
st = 'REBIND' st'.('strip(ver)'))'
call out '---' st
call out '-- valid='val', op='ope', lastBind='bTi
succ = succ + bindCommand(st)
end
call sqlClose 8
sx = sx-1
if sx = succ then
call out '+++' sx 'rebinds, all successful, rc 0'
else
call out '+++' sx 'rebinds,' (sx-succ) 'unsuccessful, rc 4'
return sx
endProcedure doRebind
genRebinds: procedure expose m.
parse arg gen, utSt
oldDb = ''
sel = ''
do ux=1 to m.utSt.0
u = utSt'.'ux
if m.u.util ^= 'REBIND' then
iterate
gotRebind = 1
l = m.u.list
listDef = utListDef(l, 0, 'w') /* check authorization */
call dbg 'list' l m.l.0
l = m.l.list
do lx=1 to m.l.0
call dbg 'rebind tb' m.l.lx.cr'.'m.l.lx.tb
if oldDb <> m.l.lx.DB then do
oldDb = m.l.lx.DB
sel = sel ")) or (bQualifier='"oldDb"' and bName in ('"
end
else do
sel = sel", '"
end
sel = sel || m.l.lx.ts"'"
call dbg 'sel +' sel
end
end
if sel = '' then do
if gotRebind = 1 then
call out '+++ no rebinds for empty object list, rc 4'
return 0
end
sel = substr(sel, 7)'))'
call dbg 'sel =' sel
p = ':m.pk.sx.'
call sqlPreOpen 8,
, "select distinct dCollid, dName, dContoken, version, p.type,",
"p.bindTime, p.valid, p.operative",
"from sysibm.sysPackDep d, sysibm.sysPackage p" ,
"where bType in ('P', 'R')" ,
"and d.dLocation = p.location" ,
"and d.dCollid = p.collid" ,
"and d.dName = p.name" ,
"and d.dConToken = p.conToken" ,
"and ("sel")" ,
"order by 2, 4, 1"
succ = 0
do sx=1 while sqlFetchInto(8, ':col, :nam, :cTo, :ver, :typ,' ,
':bTi, :val, :ope')
call dbg sx col nam c2x(cTo) ver typ bTi 'vo' val ope
st = 'PACKAGE('strip(col)'.'strip(nam)
if typ = 'T' then
st = 'REBIND TRIGGER' st')'
else
st = 'REBIND' st'.('strip(ver)'))'
call mAdd gen, st '-- valid='val', op='ope', lastBind='bTi
end
call sqlClose 8
return sx - 1
endProcedure genRebinds
/*--- one bindstatement ----------------------------------------------*/
bindCommand: procedure expose m.
parse arg stmt
/****** use undocumented DSNESM71 programm,
as it is used in DSNTBIND ***********************************/
'NEWSTACK'
queue "DSNE"
queue stmt
queue "END"
x = outtrap('m.bm.')
ADDRESS ATTCHMVS "DSNESM71" /* call "pre" bind */
bind_rc = rc /* set rc to DSNESM71 call */
x = outtrap('OFF')
'DELSTACK'
call dbg 'bind rc' bind_rc D2X(ABS(bind_rc)) 'msgs' m.bm.0
call sysPrintInsert out
m.out.0 = 0
if m.debug then do x=1 to m.bm.0
call dbg m.bm.x
end
call sysPrintInsert bm
do bx = 1 to m.bm.0
if pos(' SUCCESSFUL REBIND ', m.bm.bx) > 0
then return 1
end
return 0
endProcedure bindCommand
/***********************************************************************
small helper functions
***********************************************************************/
/*--- one output message ---------------------------------------------*/
out: procedure expose m.
parse arg 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
say substr(msg, bx+2, ex-bx-2)
if m.out then
call mAdd out, substr(msg, bx+2, ex-bx-2)
bx = ex
end
return
endProcedure out
/*--- one debug message ----------------------------------------------*/
dbg: procedure expose m.
parse arg msg
if m.debug then
call out '???' msg
return
endProcedure dbg
/***********************************************************************
old test functions
***********************************************************************/
autTest: procedure expose m.
call setGlobal 'DB', 'DBAF'
call sqlExec 'set :oldPkgSet = current packageset'
call out '*** autTest oldPkgSet =' oldPkgSet
call autTestOne 'DSNREXX'
call autTestOne 'DSNREXCS'
call autTestOne 'DSNREXRR'
call autTestOne 'DSNREXRS'
call autTestOne 'DSNREXUR'
call autTestOne 'DB2ADMIN'
call sqlExec 'set current packageset = :oldPkgSet'
call sqlExec 'set :act = current packageset'
call out '*** autTest switche back to PkgSet =' act
return 0
endProcedure autTest
autTestOne: procedure expose m.
parse arg pkgSet
call sqlExec 'set current packageset = :pkgSet'
call sqlExec 'set :act = current packageset'
call out '*** autTestOne with pkgSet' pkgSet '=' act
se = 'select WK011CH20 from A540769A.TWK011A'
call autTestSel se
call autTestSel se 'where 1 = 0'
up = "update A540769A.TWK011A set WK011CH2 = 'q'"
call autTestUpd up
call autTestUpd up 'where 1 = 0'
return
endProcedure autTestOne
autTestSel: procedure expose m.
parse arg sel
msg = ''
if sqlExec('prepare s7 from :sel', '*') < 0 then
msg = 'prepare' sqlMsg()
if sqlExec('declare c7 cursor for s7', '*') < 0 & msg = '' then
msg = 'declare' sqlMsg()
if sqlExec('open c7', '*') < 0 & msg = '' then
msg = 'open' sqlMsg()
v=''
fet = sqlExec('fetch c7 into :v', '*')
if fet < 0 msg = '' then
msg = 'fetch v='v sqlMsg()
if sqlExec('close c7', '*') < 0 then
msg = 'close' sqlMsg()
if msg = '' then
msg = 'sel ok fet' fet 'v' v
else
msg = 'sel err fet' fet
call out msg sel
return
endTestSel
autTestSelOld: procedure expose m.
parse arg sel
call out 'autTestSel' sel
call sqlExec 'prepare s7 from :sel', '*'
call out ' prepare' sqlMsg()
call sqlExec 'declare c7 cursor for s7', '*'
call out ' declare' sqlMsg()
call sqlExec 'open c7', '*'
call out ' open' sqlMsg()
v=''
call sqlExec 'fetch c7 into :v', '*'
call out ' fetch v='v sqlMsg()
call sqlExec 'close c7', '*'
call out ' close' sqlMsg()
return
endTestSelOld
autTestUpd: procedure expose m.
parse arg upd
msg = ''
if sqlExec('prepare s1 from :upd', '*') < 0 then
msg = 'prep' sqlMsg()
if sqlExec('execute s1', '*') < 0 & msg = '' then
msg = 'exec' sqlMsg()
if msg = '' then
msg = 'ok'
call out 'upd' msg
return
endTestUpd
autTestUpdOld: procedure expose m.
parse arg upd
call out 'autTestUpd' upd
call sqlExec 'execute immediate :upd', '*'
call out ' execute immediate' sqlMsg()
return
endTestUpdOld
debugSqlCurrent: procedure expose m.
parse arg pr, always
if m.debug ^== 1 & always ^== 1 then
return
call sqlPreAllCl 5,'SELECT current sqlid, user, current packageset',
'from sysibm.sysDummy1' , st , ':id, :us, :pa'
if m.st.0 <> 1 then
call err 'sysDummy1 <> 1'
call out pr 'sqlCurrent sqlId' id 'user' us 'pkgSet' pa
return
endProcedure debugSqlCurrent
/*--- return current collection --------------------------------------*/
testAnaPunch: procedure expose m.
call errReset 'h'
call analysePunch p1, 'DBAF.TMP.TST.DA540769.A418A.PUN3'
say 'tb' m.p1.tb '*' m.p1.tbQu
say ' inDsn' m.p1.inDsn
say ' flds' m.p1.flds
return 0
endProcedure testAnaPunch
testmaptab: procedure expose m.
call errReset 'h'
call sqlconnect dbaf
call sqlExec "set current sqlid = 'S100447'"
call createMaptab 's100447.Walter2'
call sqldisconnect
return 0
endProcedure testmaptab
testCopy1: procedure expose m.
call activateErrHandler
call setGlobal 'DB', 'DBAF'
m.l.1.ts = 'DGDB9998.A422A'
m.l.1.parts = '*'
m.l.0 = 1
m.c.0 = 1
c = 'C.1'
m.c.util = 'COPY'
m.c.list = l
c = 'C'
call runUtility m.id, utGen(c)
/* call err 'test errhandler\nline2\nline3 |' */
call outputSysprint
m.c.1.util = 'RUNSTATS'
call runUtility m.id, utGen(c)
call outputSysprint
call globalCleanup
return 0
endProcedure testCopy1
testCopy2: procedure expose m.
call activateErrHandler
call scanStringRun 'DBAF', 'ts DGDB9998.A422A 4 - 8 11 12 -18',
'id A540769.test2 copy shr r'
call outputSysprint
call globalCleanup
return 0
endProcedure testCopy2
testCopy3: procedure expose m.
call activateErrHandler
call scanStringRun 'DBAF', 'ts DGDB9998.A202A ',
'id A540769.test2 copy shr r run'
call outputSysprint
call globalCleanup
return 0
endProcedure testCopy2
testRebind: procedure expose m.
c = 'REBIND PACKAGE(DB.DBWK3.(DB2J000003))'
c = '-DIS DATABASE(DA540769)'
b = 'REBIND PACKAGE(DB.DBWK1.(DB2J000003))'
c = 'REBIND PACKAGE(DB.DBWK3.(DB2J000003))'
d = 'REBIND PACKAGE(DB.DBWK411.(DB2J000003))'
call bindCommand b
return 0
db2Command: procedure expose m.
parse arg cmd
call dbg 'db2Command' cmd
len = length(cmd)
e = ''
cCmd = -99
iRet = -99
iRes = -99
xsBy = -99
gRea = -99
gXs = -99
cRc = -99
cMsg = left('', 6000)
cMsgI = -123
sql = "CALL SYSPROC.ADMIN_COMMAND_DB2(" ,
":cmd," ,/* DB2_CMD P 1 VARCHAR */
":len," ,/* LEN_CMD P 2 INTEGER */
":e," ,/* PARSE_TYPE P 3 VARCHAR */
":e," ,/* DB2_MEMBER P 4 VARCHAR */
":cCmd," ,/* CMD_EXEC O 5 INTEGER */
":iRet," ,/* IFCA_RET O 6 INTEGER */
":iRes," ,/* IFCA_RES O 7 INTEGER */
":xsBy," ,/* XS_BYTES O 8 INTEGER */
":gRea," ,/* IFCA_GRES O 9 INTEGER */
":gXs," ,/* GXS_BYTES O 10 INTEGER */
":cRc," ,/* RETURN_CODE O 11 INTEGER */
":cMsg :cMsgI" ,/* MSG O 12 VARCHAR */
")"
call dbg 'db2Cmd sql' sql
sc = sqlExec(sql, 466)
call dbg 'cmd sqlCode' sc 'cCmd' cCmd 'ret' iRet
call dbg 'msg ind' cMsgI 'len' length(cMsg) length(strip(cMsg))
call sqlPreOpen 1, 'select rowNum, text' ,
'from sysibm.db2_cmd_output' ,
'order by 1 asc'
do while sqlFetchInto(1, ':rw, :tx', 100)
call dbg 'cmd' rw strip(tx, 't')
end
return 0
endProcedure db2Command
testStoredProc: procedure expose m.
parse arg conn
call errReset 'h'
m.out = 1
call scanStringRun conn, 'id A540769A tb gdb6663.TWK401A',
'reo '
/* call scanStringRun conn, 'id A540769.stoPr tb A540769.TWK418A' ,
' loa TSS.SKA.TMP.TST.&TS..UNL3',
' RESU n SHRLEVEL CHANGE LIMIT 89' ,
' delimited '','' X''7F'' ''.'' '
call scanStringRun conn, 'id A540769.stoPr tb OA1A01.TBE111A1 REB'
call scanStringRun conn, 'id A540769.stoPr tb A540769.TWK418A ',
'copy shr r reb'
' LOA DBAF.TMP.TST.DA540769.A418A.LOA3',
' SHRLEVEL CHA resume Y',
' into "A540769"."TWK418A" ( ',
' "WK418K1"',
'\POSITION( 00003:00008) CHAR(00006)',
'\, "WK418K2"',
'\POSITION( 00009:00012) CHAR(00004)',
'\, "WK418D1"',
'\POSITION( 00014:00015) CHAR(00002)',
"\ NULLIF(00013)=X'FF')"
'copy shr r rebi'
' tb *.AB?T_T* ' ,
' tb A540769.TWK411A1 TB OA1A.TMF716A1' ,
' vw GDB9998.VWK210A2 ' ,
' unl TSS.SKA.TMP.TST.&TS..UNL3',
' TSS.SKA.TMP.TST.&TS..PUN3',
' RESU n SHRLEVEL CHANGE LIMIT 89 RUN',
call scanStringRun conn, 'id A540769.stoPr tb A540769.TWK418A' ,
' unl TSS.SKA.TMP.TST.&TS..UNL3',
' TSS.SKA.TMP.TST.&TS..PUN3',
' RESU n SHRLEVEL CHANGE LIMIT 89',
' delimited '','' X''7F'' ''.'' '
*/
call showSysPrint
return 0
endProcedure testStoredProc
/* copy scanUtil begin *************************************************
scan db2 utility input statements using scan and a reader
**********************************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanUtilReader: procedure expose m.
parse arg m, inRdr
call scanReader m, inRdr
call scanOptions sc, , , '--'
call scanUtilReset m
return m
endProcedure scanUtilReader
scanUtilSql: procedure expose m.
parse arg inRdr
m = scanSql(inRdr)
call scanUtilReset m
return m
endProcedure scanUtilReader
scanUtilReset: procedure expose m.
parse arg m
m.m.utilBrackets = 0
m.scanUtil = 'BACKUP CATENFM CATMAINT CHECK' ,
'COPY COPYTOCOPY DIAGNOSE EXEC LISTDEF LOAD' ,
'MERGECOPY MODIFY OPTIONS QUIESCE REBUILD' ,
'RECOVER REORG REPAIR REPORT RESTORE' ,
'RUNSTATS STOSPACE TEMPLATE UNLOAD'
return
endProcedure scanUtilReset
/*--- scan next token and put its type in m.sc.utilType:
'u' a utility name
'n' a name
'"' a quoted name
"'" an apostroph'd string
'.' a .
',' a ,
'v' a value
'' at end
---------------------------------------------------------------*/
scanUtil: procedure expose m.
parse arg sc
m.sc.utilSpace = scanSpaceNl(sc)
ty = '?'
if scanLit(sc, '(') then do
m.sc.utilBrackets = m.sc.utilBrackets + 1
end
else if scanLIT(sc, ')') then do
m.sc.utilBrackets = m.sc.utilBrackets - 1
if m.sc.utilBrackets < 0 then
call scanErr sc, 'unmatched closing bracket )'
end
else if scanLit(sc, ',') then do
end
else if scanLit(sc, '.') then do
end
else if scanString(sc, "'") then do
end
else if scanString(sc, '"') then do
end
else if scanName(sc) then do
m.sc.val = translate(m.sc.tok)
if m.sc.utilBrackets > 0 then
ty = 'n'
else if 0 < wordPos(m.sc.val, m.scanUtil) then
ty = 'u'
else
ty = 'n'
end
else if scanVerify(sc, ' (),''"', 'm') then do
ty = 'v'
m.sc.val = translate(m.sc.tok)
end
else if ^scanAtEnd(sc) then do
call scanErr sc, 'scanUtil stopped before end'
end
else do
/* say 'scanUtil return atEnd' */
ty = ''
m.sc.val = ''
end
if ty == '?' then
m.sc.utilType = left(m.sc.tok, 1)
else
m.sc.utilType = ty
return m.sc.utilType
endProcedure scanUtil
/*--- scan a value or a bracketed list of values ---------------------*/
scanUtilValue: procedure expose m.
parse arg sc, remApo, nl
if remApo = '' | rempApo = 0 then
remApo = "nv"
else if rempApo = 1 then
remApo = "nv'"
if '(' ^== scanUtil(sc) then
return scanUtilValueOne(sc, remApo)
v = ''
brx = m.sc.utilBrackets
oLine = word(scanPos(sc), 1)
do forever
call scanUtil sc
one = scanUtilValueOne(sc, remApo)
if one == '' then
call scanErr sc, 'eof in brackets'
else if brx > m.sc.utilBrackets then
return v
nLine = word(scanPos(sc), 1)
if ^ m.sc.utilSpace then
v = v || one
else if nl ^== '' & oLine <> nLine then
v = v || nl || one
else
v = v' 'one
oLine = nLine
end
endProcedure scanUtilValue
scanUtilValueOne: procedure expose m.
parse arg sc, valTy
if m.sc.utilType == '' then
return ''
else if m.sc.utilType == 'u' then
call scanErr sc, 'util in scanUtilValueOne'
if pos(m.sc.utilType, valTy) > 0 then
return m.sc.val
else
return m.sc.tok
endProcedure scanUtilValueOne
/* copy scanUtil end **************************************************/
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm:
parse arg ggSrc, ggRet
return sqlExec('execute immediate :ggSrc', ggRet)
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure expose m.
parse arg ggSys, ggRetCon
call sqlIni
address tso "SUBCOM DSNREXX"
if rc <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
if ggSys = '-' then
return 0
return sqlExec("connect" ggSys, ggRetCon ,1)
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure expose m.
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
call address tso 'DSN SYSTEM('sys')'
rr = rc
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql end **************************************************/
/* copy scanSql begin *************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanSql: procedure expose m.
parse arg inRdr
return scanSqlReset(scanWin(inRdr), inRdr)
scanSqlReset: procedure expose m.
parse arg m, rdr, scanWin
if scanWin ^== 0 then
call scanWinReset m, rdr, 5, 2, 1, 72
else
m.m.read = rdr
return scanOpts(m, , '0123456789_' , '--')
scanSqlSeekId: procedure expose m.
parse arg m, lx, cmd, opts
if opts = '' then
opts = word
if adrEdit("cursor =" max(trunc(lx), 1), 12) = 12 then
return -1
do while adrEdit("seek" cmd opts, 4) = 0 /* find each command*/
call adrEdit "(fx) = cursor"
if m.debug then do
call adrEdit "(LI) = LINE" fx
call debug 'scanSqlSeekId after' lx 'found' cmd 'at' fx li
end
call editReadReset m.m.read, fx
call scanWinOpen es, fx
do while word(scanPos(m), 1) <= fx & scanSqlType(m)
if m.m.sqlType = 'i' & m.m.val == cmd then
return fx
end
end
return -1
endProcedure scanSqlSeekId
/*--- scan a sql token put type in m.sqltype:
'i': ordinary identifier e.g. Name
'd': delimited identifier e.g. "Delimited"
'q': qualified identifier e.g. abc."efg"
'u': integer units e.g. 8G
'n': number e.g. -234
's': string e.g. 'abc''ef'
'' : at end
: any other character e.g. ;
----------------------------------------------------------------*/
scanSqlType: procedure expose m.
parse arg m, retSpace
m.m.val = ''
if scanSpaceNl(m) & retSpace = 1 then do
m.m.sqlType = 'b'
return 1
end
c2 = scanLook(m ,2)
if scanString(m, "' x' X'") then do
m.m.sqlType = 's'
if ^abbrev(m.m.tok, "'") then
m.m.val = x2c(m.m.val)
end
else if scanSqlQuId(m) then do
if m.m.val.0 > 1 then
m.m.sqlType = 'q'
else if abbrev(m.m.tok, '"') then
m.m.sqlType = 'd'
else
m.m.sqlType = 'i'
end
else if scanSqlNum(m, 0, 1) then
m.m.sqlType = 'n'
else if scanChar(m, 1) then
m.m.sqlType = m.m.tok
else if scanAtEnd(m) then do
m.m.sqlType = ''
return 0
end
else
call scanErr m, 'cannot scan sql'
return 1
endProcedure scanSqlType
scanSqlSkipBrackets: procedure expose m.
parse arg m, br
if br ^== '' then
nop
else if scanLit(m, '(') then
br = 1
else
return 0
do while scanSqlType(m) & m.m.sqlType ^== ';'
if m.m.sqlType = '(' then br = br + 1
else if m.m.sqlType ^== ')' then iterate
else if br > 1 then br = br - 1
else return 1
end
call scanErr m, '; or eof, but' br 'closing ) expected'
endProcedure skipBrackets
/*--- scan an ordinary sql identifier e.g. abc, ef_12 ----------------*/
scanSqlId: procedure expose m.
parse arg m
if ^ scanName(m) then
return 0
m.m.val = translate(m.m.tok)
return 1
endProcedure scanSqlId
/*--- scan a delimited or ordinay sql identifier ---------------------*/
scanSqlDeId: procedure expose m.
parse arg m
if scanSqlId(m) then
return 1
if ^ scanString(m, '"') then
return 0
m.m.val = strip(m.m.val, 't')
return 1
endProcedure scanSqlDeId
/*--- scan a qualified sql identifier --------------------------------*/
scanSqlQuId: procedure expose m.
parse arg m
res = ''
rto = ''
do qx=1
if ^ scanSqlDeId(m) then do
if qx <> 1 then
call scanErr m, 'id expected after .'
return 0
end
m.m.val.qx = m.m.val
res = res'.'m.m.val
rto = rto'.'m.m.tok
if ^ scanLit(scanSkip(m), '.') then
leave
call scanSpaceNl m
end
m.m.val.0 = qx
m.m.val = substr(res, 2)
m.m.tok = substr(rto, 2)
return 1
endProcedure scanSqlQuId
/*--- scan a sql number ----------------------------------------------*/
scanSqlNum: procedure expose m.
parse arg m, checkEnd, noSp
n = ''
if scanLit(m, '+', '-') then do
n = m.m.tok
if noSp <> 1 then
call scanSpaceNl m
end
if scanLit(m, '.') then
n = n'.'
if scanVerify(m, '0123456789') then
n = n || m.m.tok
else if n == '' then
return 0
else if noSp = 1 then do
call scanBack m, n
return 0
end
else
call scanErr m, 'scanSqlNum bad number: no digits after' n
if pos('.', n) < 1 then
if scanLit(m, '.') then do
if scanVerify(m, '0123456789') then
n = n'.'m.m.tok
end
if scanLit(m, 'E', 'e') then do
n = n'E'
if scanLit(m, '+', '-') then
n = n || m.m.tok
if ^ scanVerify(m, '0123456789') then
call scanErr m, 'scanSqlNum bad number: no digits after' n
n = n || m.m.tok
end
if checkEnd ^= 0 then
if pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNum number' n 'bad end' ,
scanLook(m, 1)
m.m.val = n
return 1
endProcedure scanSqlNum
/*--- scan a sql number with a unit which may follow without space ---*/
scanSqlNumUnit: procedure expose m.
parse arg m, both, units
if ^ scanSqlNum(m, 0) then
return 0
nu = m.m.val
sp = scanSpaceNl(m)
if scanSqlId(m) then do
if units == '' | wordpos(m.m.val, units) > 0 then
nu = nu m.m.val
else if both | ^ sp then
call scanErr m, 'scanSqlNumUnit after' nu 'bad unit' m.m.val
else
call scanBack m, m.m.tok
end
else if both then
call scanErr m, 'scanSqlNumUnit no unit after' nu
else if ^sp & pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNumUnit bad number end after' nu
m.m.val = nu
return 1
endProcedure scanSqlNumUnit
/* copy scanSql end *************************************************/
/* copy scanWin begin *************************************************
scan the the concatenation of the lines of a reader
any token my be split over several line
except the end-of-line-comment-token
***********************************************************************/
scanWinIni: procedure expose m.
if m.scanWin.ini = 1 then
return
m.scanWin.ini = 1
call scanIni
call jIni
call oDecMethods oNewClass('ScanWin'),
, 'scanReadNl return scanWinNl(m, unCond)',
, 'scanSpaceNl scanWinSpaceNl(m)',
, 'scanClose call scanWinClose m ',
, 'scanInfo scanWinInfo(m)',
, 'scanPos scanWinPos(m)'
return
endProcedure scanReadIni
/*--- instanciate a new window scanner, open rdr ---------------------*/
scanWin: procedure expose m.
parse arg rdr, wiSz, wiBa, cuPo, cuLe
return scanWinReset(oNew('ScanWin'), rdr, wiSz, wiBa, cuPo, cuLe)
/*--- set the attributes of window scanner m, open rdr and start read*/
scanWinReset: procedure expose m.
parse arg m, rdr, wiSz, wiGa, cuPo, cuLe
call scanReset m
m.m.read = rdr
m.m.atEnd = 'still closed'
return scanWinOpts(m, wiSz, wiGa, cuPo, cuLe)
endProcedure scanWinReset
scanWinOpts: procedure expose m.
parse arg m, wiSz, wiGa, cuPo, cuLe
wiSz = word(wiSz 5, 1)
wiGa = word(wiGa 1, 1)
m.m.cutPos = word(cuPo 1, 1)
m.m.cutLen = word(cuLe 72, 1)
m.m.winTot = (wiSz * 2 + wiGa) * m.m.cutLen
m.m.posLim = (wiSz + wiGa) * m.m.cutLen
m.m.posOff = wiGa * m.m.cutLen
return scanWinOpen(m)
endProcedure scanWinReset
scanWinOpen: procedure expose m.
parse arg m, lx
m.m.atEnd = 0
if lx = '' then
m.m.lineX = 1
else
m.m.lineX = lx
m.m.pos = 1
m.m.src = ''
call jOpen m.m.read, 'r'
call scanWinRead m
return m
endProcedure scanWinOpen
scanWinClose: procedure expose m.
m.m.atEnd = 'still closed'
call jClose m.m.read
return
endProcedure scanWinClose
/*--- move the source window: cut left side and append at right side
return number of characters cut at left ------------------------*/
scanWinRead: procedure expose m.
parse arg m
dlt = 0
if m.m.atEnd then
return 0
if m.m.pos >= m.m.posLim then do /* cut left side */
dlt = m.m.pos - (m.m.pos // m.m.cutLen + m.m.posOff)
m.m.src = substr(m.m.src, dlt+1)
m.m.pos = m.m.pos - dlt
m.m.lineX = m.m.lineX + dlt % m.m.cutLen
end
do while length(m.m.src) < m.m.winTot /* read and fill to len */
if ^ jRead(m.m.read, m'.'one) then do
m.m.atEnd = 1
return dlt
end
m.m.src = m.m.src || substr(m.m.one, m.m.cutPos, m.m.cutLen)
end
call assert 'length(m.m.src) = m.m.winTot'
return dlt
endProcedure scanWinRead
/*--- return position of next line start -----------------------------*/
scanWinNLPos: procedure expose m.
parse arg m
return m.m.pos + m.m.cutLen - ((m.m.pos - 1) // m.m.cutLen)
/*--- scan over spaces and comments ----------------------------------*/
scanWinSpaceNL: procedure expose m.
parse arg m
res = 0
do forever
r1 = 0
if scanVerify(m, ' ') then do
r1 = 1
end
else if m.m.scanComment ^== '' ,
& abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
np = scanWinNlPos(m)
r1 = length(m.m.scanComment) <= np - m.m.pos
if r1 then
m.m.pos = np
end
if r1 then
res = 1
else if scanWinRead(m) = 0 then
return res
end
endProcedure scanWinSpaceNl
/*--- return current position in input ------------------------------*/
scanWinPos: procedure expose m.
parse arg m
if scanAtEnd(m) then
return 'E'
else
ps = m.m.pos - 1
return (m.m.lineX + (ps % m.m.cutLen)) (ps // m.m.cutLen + 1)
endProcedure scanWinPos
/*--- return a description of the current scan position --------------*/
scanWinInfo: procedure expose m.
parse arg m
p = scanWinPos(m)
if p == 'E' then do
res = 'atEnd after'
p = m.m.lineX - 1 + length(m.m.src) % m.m.cutLen
end
else do
res = 'pos' word(p, 2) 'in'
p = word(p, 1)
end
return res 'line' p':' strip(substr(m.m.src,
, 1 + (p - m.m.lineX) * m.m.cutLen, m.m.cutLen), 't')
endProcedure scanWinInfo
/* copy scanWin end *************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanRead??(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.m.tok ==> last token
m.m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.m.pos ==> scan position
m.m.src ==> scan source
***********************************************************************/
scanIni: procedure expose m.
if m.scan.ini == 1 then
return
m.scan.ini = 1
m.scan.alfLC = 'abcdefghijklmnopqrstuvwxyz'
m.scan.alfUC = translate(m.scan.alfLC)
m.scan.alfa = m.scan.alfLC || m.scan.alfUC
m.scan.alfNum = m.scan.alfa || '0123456789'
return
endProcedure scanIni
scanReset: procedure expose m.
parse arg m, n1, np, co
m.m.tok = ''
m.m.val = ''
m.m.key = ''
m.m.read = ''
return scanOpts(m, n1, np, co)
endProcedure scanReset
scanOpts: procedure expose m.
parse arg m, m.m.scanName1, namePlus, m.m.scanComment
call scanIni
if m.m.scanName1 == '' then
m.m.scanName1 = m.scan.alfa
if namePlus == '' then
m.m.scanNameR = m.m.scanName1 || '0123456789'
else
m.m.scanNameR = m.m.scanName1 || namePlus
return m
endProcedure scanReset
/*--- begin scanning a single line -----------------------------------*/
scanSrc: procedure expose m.
parse arg m, m.m.src
m.m.atEnd = 1
m.m.pos = 1
return m
endProcedure scanSrc
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
if len == '' then
return substr(m.m.src, m.m.pos)
else
return substr(m.m.src, m.m.pos,
, min(len, 1 + length(m.m.src) - m.m.pos))
endProcedure scanLook
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m
do ax=2 to arg()
if abbrev(substr(m.m.src, m.m.pos), arg(ax)) then do
m.m.tok = arg(ax)
m.m.pos = m.m.pos + length(arg(ax))
return 1
end
end
m.m.tok = ''
return 0
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.m.src)
if len ^= '' then
nx = min(m.m.pos + len, nx)
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanChar
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, prefs
m.m.tok = ''
bx = m.m.pos
if prefs = '' then do
qu = substr(m.m.src, bx, 1)
if pos(qu, "'""") < 1 then
return 0
ax = bx + 1
end
else do
do px=1 until abbrev(substr(m.m.src, bx), p1)
p1 = word(prefs, px)
if p1 = '' then
return 0
end
qu = right(p1, 1)
ax = bx + length(p1)
end
m.m.val = ''
do forever
qx = pos(qu, m.m.src, ax)
if qx < 1 then
return scanErr(m, 'ending Apostroph('qu') missing')
m.m.val = m.m.val || substr(m.m.src, ax, qx-ax)
if qx >= length(m.m.src) then
leave
else if substr(m.m.src, qx+1, 1) <> qu then
leave
ax = qx+2
m.m.val = m.m.val || qu
end
m.m.tok = substr(m.m.src, bx, qx+1-bx)
m.m.pos = qx+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.scanName1, rest in *.scanNameR ----*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.m.src, m.m.pos, 1),
, m.m.scanName1) <= 0 then do
m.m.tok = ''
return 0
end
return scanVerify(m, m.m.scanNameR)
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.m.src, alpha, , m.m.pos)
else
nx = verify(m.m.src, alpha, vOpt, m.m.pos)
if nx = 0 then
nx = length(m.m.src) + 1
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
scanNat: procedure expose m.
parse arg m, chEn
if ^ scanVerify(m, '0123456789') then
return 0
if chEn^==0 & pos(substr(m.m.src, m.m.pos,1), m.m.scanNameR)>0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
scanInt: procedure expose m.
parse arg m, chEn
if scanNat(m, chEn) then
return 1
ox = m.scan.m.pos
if pos(substr(m.scan.m.src, ox, 1) , '+-') < 1 then
return 0
m.scan.m.pos = ox + 1
if | scanNat(m) then do
m.scan.m.pos = ox
return 0
end
m.tok =substr(m.scan.m.src, ox, 1)|| m.tok
return 1
endProcedure scanInt
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m) then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.m.val = m.m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.m.pos - length(tok)
if substr(m.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.m.key = m.m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.m.val = def
m.m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.m.key '=')
return 1
endProcedure scanKeyValue
scanAtEnd: procedure expose m.
parse arg m
return m.m.atEnd & m.m.pos > length(m.m.src)
endProcedure scanAtEnd
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.m.tok
if m.m.read ^== '' then
interpret 'res = ' oObjMethod(m, 'scanSpaceNl')
else
res = scanSpaceCom(m)
m.m.tok = lastTok
return res
endProcedure scanSpaceNL
scanSpaceCom: procedure expose m.
parse arg m
res = scanVerify(m, ' ')
if m.m.scanComment ^== '' then
if abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
m.m.pos = 1 + length(m.m.src)
return 1
end
return res
endProcedure scanSpaceCom
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
m.m.err.0 = 0
call err 'scanErr' txt'\n'scanInfo(m, m'.ERR')
return 0
endProcedure scanErr
scanPos: procedure expose m.
parse arg m
if m.m.read ^== '' then
interpret 'return' oObjMethod(m, 'scanPos')
else if scanAtEnd(m) then
return E
else
return 1 m.m.pos
endProcedure scanPos
scanInfo: procedure expose m.
parse arg m
msg = 'last token' m.m.tok 'scanPosition' ,
strip(left(substr(m.m.src, m.m.pos), 40), 't')
if m.m.read == '' then
return msg'\npos' m.m.Pos 'in string' strip(m.m.src, 't')
else
interpret 'return msg"\n" ||' oObjMethod(m, 'scanInfo')
endProcedure scanInfo
/* copy scan end ****************************************************/
/* copy cat begin ****************************************************
***********************************************************************/
catOpt: procedure
parse arg opt, keep
if abbrev(opt, '<') then
o = 'r'substr(opt, 2)
else if abbrev(opt, '>>') then
o = 'a'substr(opt, 3)
else if abbrev(opt, '>') then
o = 'w'substr(opt, 2)
else if pos(left(opt, 1), 'rwa') > 0 then
o = opt
else
o = '?'opt
if keep ^== 1 then
o = translate(o, ' ', '£#')
return space(o, 0)
endProcedure catOpt
/*--- create and possibly open a reader or writer --------------------*/
catMake: procedure expose m.
parse arg opt, spec
o = catOpt(opt, 1)
if pos('£', o) > 0 then
return spec
else if pos('#', o) > 0 then do
if envhasKey(spec) then
return catMake(translate(opt, '£', '#'), envGet(spec))
else
return envPut(spec, jBuf())
end
else if pos('&', o) > 0 then
return catDsn('&'spec)
else
return catDsn(spec)
call err 'catMake implement' opt
if defDsn == '' then do
o = left(o, length(o)-1)
end
else if defDsn == '' then do
rw = catDsn(spec)
end
else do
rw = jReset(defDsn, spec)
end
if pos('-', o) < 1 then
call jOpen rw, o
return rw
endProcedure catMake
/*--- create a new cat -----------------------------------------------*/
cat: procedure expose m.
m = oNew('Cat')
m.m.catIx = -9
call catReset m
do ax=1 by 2 to arg()
call catWriteAll m, arg(ax), arg(ax+1)
end
return m
endProcedure cat
catReset: procedure expose m.
parse arg m
m.m.RWs.0 = 0
m.m.catWr = ''
m.m.catRd = ''
m.m.catToClose = ''
m.m.catIx = -9
call oSetTypePara m
do ax=2 by 2 to arg()
call catWriteAll m, arg(ax), arg(ax+1)
end
return m
endProcedure catReset
catClose: procedure expose m.
parse arg m
if m.m.catIx == -9 then
return
if m.m.catWr ^== '' then do
call jClose m.m.catWr
bx = mInc(m'.RWS.0')
m.m.opts.bx = ""
m.m.RWs.bx = m.m.catWr
m.m.catWr = ''
end
if m.m.catIx >= 0 then do
if m.m.catRd ^== '' then do
ix = m.m.catIx
if pos('-', m.m.opts.ix) < 1 then
call jClose m.m.catRd
m.m.catRd = ''
end
do wx = 1 to words(m.m.catToClose)
cl = word(m.m.catToClose, wx)
if cl ^== m then
call jClose cl
end
m.m.catToClose = ''
end
m.m.catIx = -9
return m
endProcedure catClose
catOpen: procedure expose m.
parse arg m, oo
call jClose m
if oo = 'r' then do
m.m.catIx = 0
m.m.catRd = catNextRdr(m)
m.m.jReading = 1
end
else if oo == 'w' | oo == 'a' then do
if oo == 'w' then
m.m.RWs.0 = 0
m.m.catIx = -7
m.m.jWriting = 1
end
else do
call err 'catOpen('m',' oo') bad opt'
end
return m
endProcedure catOpen
/*--- return and open next reader ------------------------------------*/
catNextRdr: procedure expose m.
parse arg m
cx = m.m.catIx
if cx > 0 & cx <= m.m.RWs.0 & pos('-', m.m.opts.cx) < 1 then
call jClose m.m.catRd
cx = cx + 1
m.m.catIx = cx
if cx > m.m.RWs.0 then
return ''
oo = overlay('r', m.m.opts.cx)
if pos('-', oo) < 1 then
call jOpen m.m.RWs.cx, oo
return m.m.RWs.cx
endProcedure catNextRdr
catRead: procedure expose m.
parse arg m, var
do while m.m.catRd ^== ''
if jRead(m.m.catRd, var) then
return 1
m.m.catRd = catNextRdr(m)
end
return 0
endProcedure catRead
catWrite: procedure expose m.
parse arg m, line
if m.m.catWr == '' then do
m.m.catWr = jOpen(jBuf(), 'w')
call oSetTypePara m.m.catWr, oGetTypePara(m)
end
call jWrite m.m.catWr, line
return
endProcedure catWrite
/*--- write contents of a reader to cat
or keep it for later reading -------------------------------*/
catWriteAll: procedure expose m.
parse arg m
if m.m.catIx >= 0 then
call err 'catWriteAll('m',' arg(2)',' arg(3)') but opened,',
'catIx='m.m.catIx
bx = m.m.RWs.0
if m.m.catWr ^== '' then do
call jClose m.m.catWr
bx=bx+1
m.m.opts.bx = ""
m.m.RWs.bx = m.m.catWr
m.m.catWr = ''
end
do ax=2 by 2 to arg()
bx=bx+1
m.m.opts.bx = catOpt(arg(ax))
m.m.RWs.bx = catMake(arg(ax), arg(ax+1))
call oSetTypePara m, oGetTypePara(m.m.RWs.bx)
end
m.m.RWs.0 = bx
return
endProcedure catWriteAll
/*--- store the list toClose to close them when closing cat ----------*/
catLazyClose: procedure expose m.
parse arg m, toClose
if m.m.catIx <> -7 then
call err 'catLazyClose with catIx' m.m.catIx
if m.m.RWs.0 = 0 then
return 0
if m.m.catToClose ^== '' then
call err 'catLazyClose with catToClose' m.m.catToClose
if m.m.catIx <> -7 | m.m.catToClose ^== '' then
m.m.catToClose = toClose
return 1
endProcedure catLazyClose
catSetTypePara: procedure expose m.
parse arg m, type
do ix=1 to m.m.RWs.0
call oSetTypePara m.m.RWs.ix, type
end
return
endProcedure catSetTypePara
/*--- create a reader/writer for a dsn -------------------------------*/
catDsn: procedure expose m.
parse arg spec
m = oNew('CatDsn')
m.m.readIx = 'c'
ix = mInc('CAT.BUF')
m.m.defDD = 'CAT'ix
m.m.buf = 'CAT.BUF'ix
call catDsnReset m, spec
return m
endProcedure catDsn
catDsnReset: procedure expose m.
parse arg m, sp
if symbol('m.m.defDD') ^== 'VAR' then
m.m.defDD = 'CDD' mInc('CAT.DEFDD')
m.m.spec = sp
return m
endProcedure catDsnReset
catDsnOpen: procedure expose m.
parse arg m, opt
call jClose m
buf = m.m.buf
if opt == 'r' then do
aa = dsnAlloc(m.m.spec, 'SHR', m.m.defDD)
if m.dsnAlloc.dsn <> '' then
if sysDsn("'"m.dsnAlloc.dsn"'") <> 'OK' then
call err 'cannot read' m.dsnAlloc.dsn':',
sysDsn("'"m.dsnAlloc.dsn"'")
call readDDBegin word(aa, 1)
m.m.jReading = 1
m.buf.0 = -1
m.m.readIx = 0
end
else do
if opt == 'w' then
aa = dsnAlloc(m.m.spec, 'OLD', m.m.defDD)
else if opt == 'a' then
aa = dsnAlloc(m.m.spec, 'MOD', m.m.defDD)
else
call err 'catDsnOpen('m',' opt') with bad opt'
call writeDDbegin word(aa, 1)
m.m.jWriting = 1
m.buf.0 = 0
m.m.readIx = 'w'
end
m.m.dd = word(aa, 1)
m.m.free = subword(aa, 2)
return m
endProcedure catDsnOpen
catDsnClose:
parse arg m
buf = m.m.buf
if m.m.readIx ^== 'c' then do
if m.m.readIx == 'w' then do
if m.buf.0 > 0 then
call writeDD m.m.dd, 'M.'BUF'.'
call writeDDend m.m.dd
end
else do
call readDDend m.m.dd
end
interpret m.m.free
end
m.buf.0 = 'closed'
m.m.readIx = 'c'
m.m.free = ''
m.m.dd = ''
return m
endProcedure catDsnClose
catDsnRead: procedure expose m.
parse arg m, var
ix = m.m.readIx + 1
buf = m.m.buf
if ix > m.buf.0 then do
res = readDD(m.m.dd, 'M.'buf'.')
if ^ res then
return 0
ix = 1
end
m.m.readIx = ix
m.var = m.buf.ix
return 1
endProcedure catDsnRead
catDsnWrite: procedure expose m.
parse arg m, var
buf = m.m.buf
ix = m.buf.0 + 1
m.buf.0 = ix
m.buf.ix = var
if ix > 99 then do
call writeDD m.m.dd, 'M.'buf'.'
m.buf.0 = 0
end
return
endProcedure catDsnWrite
catIni: procedure expose m.
if m.cat.ini == 1 then
return
m.cat.ini = 1
m.cat.buf = 0
call jIni
call oDecMethods oNewClass("Cat", "JRW"),
, "jOpen return catOpen(m, arg)",
, "jReset return catReset(m, '', arg)",
, "jClose call catClose m",
, "jWriteAll call err 'jWriteAll not opened w",
, "oSetTypePara call catSetTypePara m, type",
, "jRead return catRead(m, var)",
, "jWrite call catWrite m, line; return",
, "jWriteAll call catWriteAll m, opt, rdr; return"
call oDecMethods oNewClass("CatDsn", "JRW"),
, "jOpen return catDsnOpen(m, arg)",
, "jReset return catDsnReset(m, arg)",
, "jClose call catDsnClose m",
, "jRead return catDsnRead(m, var)",
, "jWrite call catDsnWrite m, line"
return
endProcedure catIni
/* copy cat end ****************************************************/
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jRead: procedure expose m.
parse arg m, var
if m.m.jReading then
interpret oObjMethod(m, 'jRead')
else
call err 'jRead('m',' var') but not opened r'
endProcedure jRead
jWrite: procedure expose m.
parse arg m, line
if m.m.jWriting then
interpret oObjMethod(m, 'jWrite')
else
call err 'jWrite('m',' line') but not opened w'
return
endProcedure jWrite
jWriteAll: procedure expose m.
parse arg m, opt, rdr
interpret oObjMethod(m, 'jWriteAll')
return
endProcedure jWriteAll
jWriteAllImpl: procedure expose m.
parse arg m, opt, rdr
if pos('-', opt) < 1 then
call jOpen rdr, catOpt(opt)
do while jRead(rdr, line)
call jWrite m, m.line
end
if pos('-', opt) < 1 then
call jClose rdr
return
endProcedure jWriteAll
jReset: procedure expose m.
parse arg m, arg
call jClose m
interpret oObjMethod(m, 'jReset')
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret oObjMethod(m, 'jOpen')
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
if m.m.jReading = 1 | m.m.jWriting = 1 then
interpret oObjMethod(m, 'jClose')
m.m.jReading = 0
m.m.jWriting = 0
return m
endProcedure jClose
/*--- analyze an option in oOpt and oVal -----------------------------*/
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jIni: procedure expose m.
if m.j.ini == 1 then
return
m.j.ini = 1
call oIni
call oDecMethods oNewClass("JRW"),
, "jRead call err 'jRead('m',' var') but not opened r'",
, "jWrite call err 'jWrite('m',' line') but not opened w'",
, "jWriteAll call jWriteAllImpl m, opt, rdr",
, "jRead drop m.arg; return 0",
, "jWrite say 'jOut:' line",
, "jReset ;",
, "jOpen ;",
, "jClose ;"
x = oNew("JRW")
m.j.jIn = x
m.x.jReading = 1
m.x.jWriting = 0
x = oNew("JRW")
m.j.jOut = x
m.x.jReading = 0
m.x.jWriting = 1
call oDecMethods oNewClass("Jbuf", "JRW"),
, "jOpen return jBufOpen(m, arg)",
, "jReset return jBufReset(m, arg)",
, "oSetTypePara call jBufSetTypePara m, type",
, "jRead return jBufRead(m, var)",
, "jWrite call jBufWrite m, line"
return
endProcedure jInit
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
/*--- jBuf: buffer read or write (supports datataypes) ---------------*/
jBuf: procedure expose m.
m = oNew('Jbuf')
call jBufReset m
do ax=1 to arg()
m.m.buf.ax = arg(ax)
end
m.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
m.m.stem = m'.BUF'
m.m.buf.0 = 0
call oSetTypePara m
do ax=1 to arg() - 1
m.m.buf.ax = arg(ax+1)
m.m.buf.0 = ax
end
return m
endProcedure jBufReset
jBufSetTypePara: procedure expose m.
parse arg m, type
if m.m.buf.0 <> 0 then
call err 'jBufSetTypePara but not empty'
return
endProcedure jBufSetTypePara
jBufOpen: procedure expose m.
parse arg m, opt
call jClose m
if opt == 'r' then do
m.m.readIx = 0
m.m.jReading = 1
return m
end
if opt == 'w' then
m.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
m.m.jWriting = 1
return m
endProcedure jBufOpen
jBufRead: procedure expose m.
parse arg m, var
nx = m.m.readIx + 1
if nx > m.m.buf.0 then
return 0
m.m.readIx = nx
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.var = m.m.buf.nx
else
call oTyCopy ty, var, m'.BUF.'nx
return 1
endProcedure jBufRead
jBufWrite: procedure expose m.
parse arg m, line
nx = mInc(m'.BUF.0')
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.m.buf.nx = line
else
call oTyCopy ty, m'.BUF.'nx, line
return 1
endProcedure jBufRead
/* copy j end *********************************************************/
/* copy o begin ********************************************************
object layer has three freatures
* an object may have a class which has methods
* an object may have a parmeterized type
* a class may contain field descriptions
***********************************************************************/
oClaMethod: procedure expose m.
parse arg cl, me
if symbol('m.o.cla.cl.met.me') = 'VAR' then
return m.o.cla.cl.met.me
else
call err 'no method' me 'in class' cl
endProcedure oClaMethod
oHasMethod: procedure expose m.
parse arg obj, me
cla = oGetClass(obj)
return symbol('m.o.cla.cl.met.me') = 'VAR'
endProcedure oHasMethod
oGetClass: procedure expose m.
parse arg Obj
if symbol('m.o.obj2cla.Obj') = 'VAR' then
return m.o.obj2cla.Obj
call err 'no class found for object' obj
endProcedure oGetClass
oObjMethod: procedure expose m.
parse arg obj, me
if symbol('m.o.obj2cla.obj') = 'VAR' then
return oClaMethod(m.o.obj2cla.obj, me)
if abbrev(obj, 'oCast:') then do
cx = pos(':', obj, 7)
return 'M="'substr(obj, cx+1)'";' ,
oClaMethod(substr(obj, 7,cx-7), me)
end
call err 'no class found for object' obj
endProcedure oObjMethod
oCast: procedure
parse arg obj, cl
if abbrev(obj, 'oCast:') then
obj = substr(obj, 1 + pos(':', obj, 7))
return 'oCast:'cl':'obj
endProcedure oCast
oNewClass: procedure expose m.
parse arg name, super
/* call oIni */
name = oFldNew(name)
neMe = 'O.CLA.'name'.MET'
neFi = 'O.CLA.'name'.FLD'
do sx=1 to words(super)
sup = word(super, sx)
if symbol('m.o.cla.sup') ^== 'VAR' then
call err 'superclass' sup 'is not defined'
if m.o.cla.sup.val ^== '' then
m.o.cla.name.val = m.o.cla.sup.val
if m.o.cla.sup.stem ^== '' then
m.o.cla.name.stem = m.o.cla.sup.stem
st = 'O.CLA.'sup'.MET'
do x=1 to m.st.0
olMe = m.st.x
call oPut neMe, olMe, m.st.olMe
end
st = 'O.CLA.'sup'.FLD'
do x=1 to m.st.0
olFi = m.st.x
call oPut neFi, olFi, m.st.olFi
end
end
call oMutate 'O.CLA.'name, 'Class'
return name
endProcedure oNewClass
oValStemFldsWKOLD: procedure expose m.
parse arg cl, m.o.cla.cl.val, m.o.cla.cl.stem, flds
st = 'O.CLA.'cl'.FLD'
do wx=1 by 2 to words(flds)
call oPut st, word(flds, wx), word(flds, wx+1)
end
return cl
endProcedure oValStemFlds
oNewTypeWKOLD: procedure expose m.
parse arg cl, va, st, flds
return oValStemFlds(oNewClass(cl), va, st, flds)
/*--- a field type has only fields of type '='
finds or creates a field Type with the fields of types tps
and the field list aFl.
if dup = 'e' duplicate field names are resolved ------------*/
oFiTypeWKOLD: procedure expose m.
parse arg tps, aFl, dup
if symbol('m.o.cla.fiType.tps.aFl.dup') = 'VAR' then
return m.o.cla.fiType.tps.aFl.dup
fs = ''
do wx=1 to words(tps)
t1 = oFlds(word(tps, wx))
do fx=1 to m.t1.0
fs = fs m.t1.fx
end
end
fs = fs aFl
fd = ''
do wx=1 to words(fs)
f1 = word(fs, wx)
if wordPos(f1, fd) < 1 then do
fd = fd f1
end
else if dup == 'e' then do
do dx=2 by 1 while wordPos(f1 || dx, fn fs) > 0
end
fd = fd f1 || dx
end
end
fd = space(fd aFl)
if symbol('m.o.cla.fiType.fd') = 'VAR' then do
res = m.o.cla.fiType.fd
end
else do
res = oNewClass("FiType*")
m.o.cla.fiType.fd = res
st = 'O.CLA.'res'.FLD'
do wx=1 to words(fd)
call oPut st, word(fd, wx), '='
end
end
m.o.cla.fiType.tps.aFl = res
return res
endProcedure oFiType
oDecMethods: procedure expose m.
parse arg cla
st = 'O.CLA.'cla'.MET'
do ax=2 to arg()
call oPut st, word(arg(ax), 1), subWord(arg(ax), 2)
end
return
endProcedure oDecMethods
oNew: procedure expose m.
parse arg cla
st = 'O.CLA.'cla
if symbol('M.st') ^== 'VAR' then
call err 'class' cla 'is not initialized'
nn = m.st.inst + 1
m.st.inst = nn
nn = 'O.C' || m.st || 'I' || nn
if symbol('m.o.obj2cla.nn') == 'VAR' then
call err 'oNew already defined:' nn
m.o.obj2cla.nn = cla
return nn
endProcedure oNew
oMutate: procedure expose m.
parse arg obj, class
if obj == 'O.C13I12' then do
end
if symbol('M.O.CLA.class') ^== 'VAR' then
call err 'class' class 'is not initialized'
m.o.obj2cla.obj = class
return obj
endProcedure oMutate
oSay: procedure expose m.
parse arg type, a, aPr, mPr
ty = 'O.CLA.'type
msg = mPr || substr(a, length(aPr)+1)
redir = 0
do forever
if type == '=' then do
say msg '=' m.a
return
end
else if abbrev(type, '=') then do
a = m.a
msg = msg '==>' a
redir = 1
type = substr(type, 2)
end
else if left(type, 2) = '<>' then do
k = m.a
a = left(a, lastPos('.', a))k
msg = msg '=<>' k
redir = 1
type = substr(type, 3)
end
else if left(type, 1) = '.' then do
if ^ datatype(m.a.0, 'n') then
call err 'type' type 'not stem but m.'a'.0 is' m.a.0
type = substr(type, 2)
if redir then do
say msg 'stem 1..'m.a.0':' type
end
else do
do y=1 to m.a.0
call oSay type, a'.'y, a'.', mPr' '
end
end
return
end
else if redir then do
say msg':' type
return
end
else do
leave
end
end
if m.ty.val = '=' then
say msg '=' m.a
else
say msg '=' m.a':' m.ty.val
/* call oSay m.ty.val, a,==>' m.a '(to' m.ty.val')' */
do y=1 to m.ty.fld.0
f = m.ty.fld.y
call oSay m.ty.fld.f , a'.'f, a'.', mPr' '
end
if m.ty.stem ^== '' then
call oSay '.'m.ty.stem, a, a, mPr
return
endProcedure oSay
oClear: procedure expose m.
parse arg type, a, val
if abbrev(type, '.') then do
m.a.0 = 0
end
else if abbrev(type, '<>') then do
m.a = val
call oClear substr(type, 3), left(a, lastPos('.', a))val, val
end
else if abbrev(type, '=') then do
m.a = ''
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.a = val
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oClear m.ty.fld.k, a'.'k, val
end
if m.ty.stem ^== '' then
call m.a.0 = 0
end
return a
endProcedure oClear
oCopy: procedure expose m.
parse arg t, f
if symbol('m.o.obj2cla.f') ^== 'VAR' then
call err f 'has no class'
cl = m.o.obj2cla.f
m.o.obj2cla.t = m.o.obj2cla.f
return oTyCopy(cl, t, f)
endProcedure oCopy
oTyCopy: procedure expose m.
parse arg type, t, f
if abbrev(type, '.') then do
do y=1 to m.f.0
call oTyCopy substr(type, 2), t'.'y, f'.'y
end
m.t.0 = m.f.0
end
else if abbrev(type, '<>') then do
k = m.f
m.t = k
call oTyCopy substr(type, 3), left(t, lastPos('.', t))k,
, left(f, lastPos('.', f))k
end
else if abbrev(type, '=') then do
m.t = m.f
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.t = m.f
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oTyCopy m.ty.fld.k, t'.'k, f'.'k
end
if m.ty.stem ^== '' then
call oTyCopy '.'m.ty.stem, t, f
end
return t
endProcedure oTyCopy
/*--- Run ------------------------------------------------------------*/
oRunner: procedure expose m.
parse arg code
return oRunnerReset(oNew('ORunner'), code)
oRunnerReset: procedure expose m.
parse arg m, pCode
m.m.code = pCode
return m
endProcedure oRunnerReset
oRun: procedure expose m.
parse arg m
interpret m.m.code
return
endProcedure oRun
oIni: procedure expose m.
if m.o.ini = 1 then
return
m.o.ini = 1
call oFldIni
call mapIni
m.o.paTy.0 = 0
call oFldNew '=', '='
call oDecMethods oNewClass('ORunner'), 'oRun call oRun m'
return
endProcedure oIni
/* copy o end *********************************************************/
/* copy oFld begin *****************************************************
defines classes with field names
is the base for the oo layer in copy o
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
oFldIni: procedure expose m.
if m.oFld.ini = 1 then
return
m.oFld.ini = 1
call mapIni
m.o.fldOnly = mapNew() /* map fields -> class */
m.o.cla.0 = 0 /* the stem for classes */
call oFldNew 'Class', '=', , , /* MetaClass definieren */
'INST = MET .<>= FLD .<>=Class STEM =Class'
return
endProcedure oFldIni
/*--- create a new class
name: name of new class, a star will be replaced by a number
va: type of value
st: type of stem
flds: pairs of field names and types
dup: duplicate resolver -----------------------------------*/
oFldNew: procedure expose m.
parse arg name, va, st, flds, dup
if pos('*', name) > 0 then
name = oPut('O.CLA', name, , '*')
else
call oPut 'O.CLA', name, , 'n'
m.o.cla.name.inst = 0
m.o.cla.name.val = va
m.o.cla.name.stem = st
m.o.cla.name.FLD.0 = 0
m.o.cla.name.MET.0 = 0
return oFldAdd(name, flds, dup)
endProcedure oFldNew
/*--- create or find a class with only simple fields fs --------------*/
oFldOnly: procedure expose m.
parse arg fs, dup
kk = space(fs '?'dup, 1)
if mapHasKey(m.o.fldOnly, kk) then
return mapGet(m.o.fldOnly, kk)
if dup ^== 'e' then do
ll = space(fs, 1)
end
else do
ll = ''
do wx=1 to words(fs)
w = word(fs, wx)
v = w
do x=2 while wordPos(v, ff) > 0
v = w || x
end
ll = space(ll v, 1)
end
end
if mapHasKey(m.o.fldOnly, ll) then do
nn = mapGet(m.o.fldOnly, ll)
end
else do
nn = oFldNew('FldType*')
st = 'O.CLA.'nn'.FLD'
do lx=1 to words(ll)
call oPut st, word(ll, lx), '=', dup
end
call mapPut m.o.fldOnly, ll, nn
end
call mapPut m.o.fldOnly, kk, nn
return nn
endProcedure oFldOnly
/*--- return the stem of flds of class type --------------------------*/
oFlds: procedure expose m.
parse arg type
return 'O.CLA.'type'.FLD'
/*--- return the concatenation of the fields of type ty in stem st
formated by fmt -------------------------------------------*/
oFldCat: procedure expose m.
parse arg ty, st, fmt
flds = oFlds(ty)
res = ''
do ix=1 to m.flds.0
f = m.flds.ix
if fmt == '' then
res = res m.st.f
else
res = res fmt(m.st.f, m.fmt.ix)
end
return substr(res, 2)
endProcedure oFldCat
/*--- add fields to class cl given as name type pairs in fs ----------*/
oFldAdd: procedure expose m.
parse arg cla, fs, dup
st = 'O.CLA.'cla'.FLD'
do ix=1 by 2 to words(fs)
call oPut st, word(fs, ix), word(fs, ix+1), dup
end
return cla
endProcedure oFldAdd
/*--- add/put key k with value v to stem st
duplicate handling dup:
* replace * in k by a number until it is new
e add a number in it is not new
o replace old value at existing key
= add a new key, fail if key exists and value is different
------------------------------------------------------------*/
oPut: procedure expose m.
parse arg st, k, v, dup
if dup = '*' then do
cx = pos('*', k)
if cx < 1 then
call err 'no * in key' k
k = oPutDupResolve(st, left(k, cx-1), 1)
end
else if symbol('m.st.k') = 'VAR' then do
if dup = '' | dup = 'o' then do
m.st.k = v
return k
end
if dup = '=' then do
if v <> m.st.k | ^ (v = '' & datatype(m.st.k, 'n')) then
call err 'not =: m.'st'.'k '=>' m.st.k '<>' v
return k
end
if dup = 'e' then
k = oPutDupResolve(st, k, 2)
else
call err 'key' k 'exists in' st 'but dup' dup
end
else if dup = 'o' then
call err 'old key' k 'does not exist in' st
if datatype(k, 'n') | words(k) <> 1 | pos('.', k) > 0 then
call err 'illegal name' k
x = m.st.0 + 1
m.st.0 = x
m.st.x = k
if v == '' then
m.st.k = x
else
m.st.k = v
return k
endProcedure oPut
oPutDupResolve: procedure expose m.
parse arg st, k, b
do ix=b
a = k || ix
if symbol('m.st.a') <> 'VAR' then
return a
end
endProcedure oPutDupResolve
/*--- parameterized types --------------------------------------------*/
oGetTypePara: procedure expose m.
parse arg m
if symbol('m.o.tyPa.m') == 'VAR' then
return m.o.tyPa.m
else
return '='
endProcedure oGetTypePara
oSetTypePara: procedure expose m.
parse arg m, type, noCall
if type = '' then
type = '='
if oGetTypePara(m) == type then
return
if noCall ^== 'noCall' then
interpret oObjMethod(m, 'oSetTypePara')
m.o.tyPa.m = type
return
endProcedure oSetTypePara
/* copy oFld end ***************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = ''
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
if abbrev(a, 'MAP.') then do
do kx=1 to m.map.loKy.a.0
drop m.map.loKy.a.kx m.map.loVa.a.kx
end
m.map.loKy.a.0 = 0
end
return a
endProcedure mapClear
/*--- return a stem of all keys (including removed ones) -------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
if mapValAdr(a, ky) ^== '' then
call err 'duplicate key in mAdd('a',' ky',' val')'
if length(ky) < 200 then do
m.a.ky = val
end
else do
kx = mInc('MAP.LOKY.'a'.0')
m.map.loKy.a.kx = ky
m.map.loVa.a.kx = val
end
if m.map.keys.a ^== '' then
return mAdd(m.map.keys.a, ky)
return
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky)
if vv ^== '' then
m.vv = val
else
call mapAdd a, ky, val
return val
endProcedure mapPut
/*--- return the value pointer for a key, '' if non existang ---------*/
mapValAdr: procedure expose m.
parse arg a, ky
if length(ky) < 200 then do
if symbol('m.a.ky') == 'VAR' then
return a'.'ky
end
else if ^ abbrev(a, 'MAP.') then do
call err 'key too long mapValAdr('a',' ky')'
end
else do
do kx=1 to m.map.loKy.a.0
if m.map.loKy.a.kx == ky then
return 'MAP.LOVA.'a'.'kx
end
end
return ''
endProcedure mapValAdr
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if abbrev(vv, 'MAP.LOVA.') then
call err 'not implemented mapRemove('a',' ky')'
drop m.a.ky
return val
endProcedure mapRemove
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a,
fail if it does not exist ----------------------------------*/
mapGet: procedure expose m.
parse arg a, ky, noKey
vv = mapValAdr(a, ky)
if vv == '' then
call err 'missing key in mapGet('a',' ky')'
return m.vv
endProcedure mapGet
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m end *********************************************************/
/* 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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
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 expose m.
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 by 1
alRc = adrTso(c rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for' c rest
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
endProcedure tsoAlloc
dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
bl = 32760
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
recfm='f b'
bl = bl - (bl // rl)
end
else do
if rl = '' then
rl = bl-4
recfm = substr(atts, 2, 1) 'B'
end
end
if pos('(', dsn) > 0 then
po = 'dsntype(library) dsorg(po)'
else
po = ''
dsn = dsnSetMbr(dsn)
if forCsm == 1 then
return "dataset('"dsn"')" po,
"recfm("space(recfm, 0)") lrecl("rl") blkSize("bl")" ,
"mgmtclas(s005y000) space(10, 1000) cylinder"
else
return "dsn('"dsn"')" po,
"recfm("recfm") lrecl("rl") block("bl")" ,
"mgmtclas(s005y000) 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
copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
call readDDBegin word(frDD, 1)
call writeDDBegin word(toDD, 1)
cnt = 0
do while readDD(word(frDD, 1), r.)
call writeDD word(toDD, 1), r.
cnt = cnt + r.0
end
call readDDEnd word(frDD, 1)
call writeDDEnd word(toDD, 1)
interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
if ggSay == 1 | m.debug == 1 then
say cnt 'records copied from' frSpec 'to' to toSpec
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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(DOPWEG) cre=2006-06-06 mod=2007-12-24-16.28.18 F540769 ---
/* REXX *************************************************************
dopweg ¢f!¢s!
doppelte Zeilen löschen (falls direkt hintereindander)
use q or qq lineCommand to select part of the file
f do not delete only find first pair of equal lines
s squash: map mulitple space to one (space(line, 1))
***********************************************************************/
/**** Test Data *******************************************************
1 jcl = abx(jclm) * sdf
2 jcl = abx(2clm) * sdf
3
4 abc(jclm) * sdf
5 abc 6 abc 7 abc 8 abc 9 abc
10 abc
**********************************************************************/
call errReset hi
call adrEdit('macro (args) NOPROCESS')
squash = verify(args, 'sS', 'm') > 0
find = verify(args, 'fF', 'm') > 0
say 'macro args' args 'squash='squash 'find='find
parse var args delta fnd
if left(args, 1) = '?' | translate(left(args, 4)) = 'HELP' then
exit help()
call adrEdit 'process range Q R', 4
call adrEdit '(lf) = linenum .zfrange'
call adrEdit '(lT) = linenum .zLrange'
say 'dopWeg from line' lf 'to' lt
lStop = lT
call adrEdit "(laLi) = line" lf
lnx = lf + 1
cnt = 0
do while lnx <= lStop
call adrEdit "(nxLi) = line" lnx
if squash then
dop = space(laLi, 1) == space(nxLi, 1)
else
dop = laLi == nxLi
if dop then do
if find then do
say 'doppelte Zeilen' (lnx-1) lnx
call adrEdit 'locate' (lnx-1)
exit
end
else do
call adrEdit 'delete' lnx
lStop = lSTop - 1
cnt = cnt + 1
end
end
else do
lnx = lnx + 1
laLi = nxLi
end
end
say 'deleted' cnt 'duplicate lines'
exit
/* 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 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, ggStem, ggOpt
drop err handler opt
if ggOpt == '' & symbol('m.err.handler') == 'VAR' then
interpret m.err.handler
say 'fatal error:' ggTxt
if ggOpt == '' | ggOpt == '*' then
ggOpt = translate(value('m.err.opt'), 'ht', 'HT')
if ggStem ^== '' then do
do ggXX=1 to m.ggStem.0
say ' ' m.ggStem.ggXX
end
if ggXX > 3 then
say 'fatal error in' ggS3':' ggTxt
end
parse source . . ggS3 . /* current rexx */
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
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, st, op
say 'fatal error:' msg
call help
call err msg, st, 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(EL) cre=2006-05-29 mod=2006-06-19-13.54.38 F540769 ---
/* REXX *************************************************************
jcl = abc(jclm) * sdf
mgmtClas = s005y000
load ts= wie punchFrom = A540769.WK.TEXT(UNLO1)
load punch=e.f.g.punch in=e.f.g.load
fun='copy unload load'
**********************************************************************/
call adrEdit('macro (args) NOPROCESS')
say 'macro args' args
if adrEdit('process range Q R', 4) = 4 then do
lF = 2
lT = 10
end
else do
call adrEdit '(lf) = linenum .zfrange'
call adrEdit '(lT) = linenum .zLrange'
end
say 'from' lf 'to' lT
ix = 0
do lx=lf to lT
call adrEdit('(line) = line' lx)
ix = ix + 1
m.inp.ix = translate(line)
end
m.inp.0 = ix
call mSay inp, 'input lines'
loadKeys = 'TS IN INFROM PUNCH PUNCHFROM RESUME'
optKeys = 'LOADNR FUN MGMTCLAS SUBSYS JCL'
call analyseInput optKeys, 'LOAD', loadKeys
do wx=1 to words(optKeys)
k = word(optKeys, wx)
say k '=' m.k
end
say m.loads 'loads'
do lx=1 to m.loads
do wx=1 to words(loadKeys)
k = word(loadKeys, wx)
if m.k.lx ^== '' then
say 'load' lx k '=' m.k.lx
end
say 'completing load infos'
call completeLoadInfo lx
do wx=1 to words(loadKeys)
k = word(loadKeys, wx)
if m.k.lx ^== '' then
say 'load' lx k '=' m.k.lx
end
end
exit
completeLoadInfo: procedure expose m.
parse arg lx
if wordPos('COPY', m.fun) > 0 then do
if m.punchFrom.lx = '' then
call err 'punchFrom missing'
call analysePunch lx, 1, dsnFromJcl(m.punchFrom.lx)
end
return
endProcedure completeLoadInfo
analysePunch: procedure expose m.
parse arg lx, from, dsn
call readDsn dsn, "M.PU."
do ix=1 to m.pu.0
m.pu.ix = translate(strip(left(m.pu.ix, 72), 't'))
end
call mSay pu, 'read' dsn
call scanStem ps, pu
do forever
call scanName scanSkip(ps)
w1 = m.tok
if w1 = template then do
call scanName scanSkip(ps)
na = m.tok
call scanName scanSkip(ps)
if m.tok ^= 'DSN' | then
call sa
say 'template' na 'then' m.tok
end
else
call scanErr ps, 'load statement expected'
end
return
endProcedure analysePunch
analyseInput: procedure expose m.
parse arg optKeys, load, loadKeys
call scanStem s, inp
call scanOptions s, , , '*'
do wx=1 to words(optKeys)
k = word(optKeys, wx)
m.k = ''
end
lx=0
k = ''
do forever
if k = '' then
if ^ scanKeyValue(s) then do
if scanAtEnd(s) then
leave
else
call scanErr s, 'key or key=value expected'
end
k = translate(m.key)
if k = load then do
lx = lx + 1
say 'load' lx
do wx=1 to words(loadKeys)
k = word(loadKeys, wx)
m.k.lx = ''
end
k = ''
do while scanKeyValue(s)
k = translate(m.key)
if wordPos(k, loadKeys) < 1 then
leave
m.k.lx = translate(m.val)
k = ''
end
end
else do
if wordPos(k, optKeys) < 1 then
call scanErr s, 'key' k 'not supported'
m.k = translate(m.val)
k = ''
end
end
m.loads = lx
return
endProckedure analyseInput
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line
scanStem(m,ln) : begin scanning all lines in a stem
scanAtEOL(m) : returns whether we reached end of line
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
scanNum(m) : scan integer (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
call scanStart m
return
endProcedure scanLine
/*--- begin scanning the lines of a stem -----------------------------*/
scanStem: procedure expose m.
parse arg m, inStem
call scanStart m
m.scan.m.stem = inStem
m.scan.m.stIx = 0
call scanNL m, 1
return
endProcedure scanStem
/*--- switch to next line if atEOF or argument unCond=1 --------------*/
scanNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then
m.scan.m.pos = 1 + length(m.scan.m.src)
else if m.scan.m.pos <= length(m.scan.m.src) then
return 0
st = m.scan.m.stem
if st == '' then
return 0
ix = m.scan.m.stIx + 1
if ix > m.st.0 then
return 0
m.scan.m.src = m.st.ix
m.scan.m.stIx = ix
m.scan.m.pos = 1
m.scan.m.tok = ''
return 1
endProcedure scanNL
/*--- initialize scanner for m --------------------------------------*/
scanStart: procedure expose m.
parse arg m
m.scan.m.pos = 1
m.tok = ''
m.val = ''
m.key = ''
m.scan.m.stem = ''
if symbol('m.scan.m.Name') ^== 'VAR' then do
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
end
return
endProcedure scanStart
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanStart
if nameOne ^== '' then do
m.scan.m.Name1 = nameOne
if namePlus = '' then
namePlus = '0123456789'
m.scan.m.name = nameOne || namePlus
end
m.scan.m.comment = comm
return
endProcedure scanBegin
/*--- return true/false whether we are at the end of the line --------*/
scanAtEOL: procedure expose m.
parse arg m
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEOL
/*--- return true/false whether we are at the end of the input -------*/
scanAtEnd: procedure expose m.
parse arg m
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
st = m.scan.m.stem
return st == '' | m.st.0 <= m.scan.m.stIx
endProcedure scanAtEnd
/*--- scan len characters --------------------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
m.tok = substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
if nx = m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a number --------------------------------------------------*/
scanNum: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure scanNum
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
/*--- scan a key = word phrase
put key into *.key and word into val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(scanSkip(m)) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.scan.m.tok
say ' charPos' m.scan.m.Pos':',
strip(substr(m.scan.m.src, m.scan.m.Pos), 't')
say ' in line:' strip(m.scan.m.src, 't')
st = m.scan.m.stem
if st ^== '' then
say 'stem' st 'line' m.scan.m.stIx 'of' m.st.0
call err 'scanErr' txt
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
res = 0
cc = m.scan.m.comment
do forever
if scanVerify(m, ' ') then nop
else if scanNL(m) then nop
else if cc == '' then
return res
else if ^ scanLit(m, cc) then
return res
else if ^scanNL(m, 1) then
return res
res = 1
end
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/* copy scan end ****************************************************/
/* copy mrw begin *****************************************************
interface m mRead and mWrite
mNew
convenience function to write to current output
***********************************************************************/
test: procedure
call mCopyArgs a, 0, 'eins ...', 'zwei ...', 'drei ... schluss'
call mIni
r = mNew()
s = mNew()
call mDefReadFromStem r, a
say 0 mReadLn(r,x) "'"m.x"'"
call mDefReadFromStem s, a
do i=1 to 5
say i mReadLn(r,x) "'"m.x"' read s" mReadLn(s, y) m.y
end
exit
endProcedure
/*--- initialize m ---------------------------------------------------*/
mIni: procedure expose m.
m.mrw.0 = 0
m.mrw.ini = 1
return
endProcedure mIni
mNew: procedure expose m.
m.mrw.0 = m.mrw.0 + 1
return m.mrw.0
endProcedure mNew
mDefRead: procedure expose m.
parse arg m, rexx
m.mrw.m.readLnIx = ''
m.mrw.m.read = rexx
return
endProcedure mDefRead
mRead: procedure expose m.
parse arg m, stem
interpret m.mrw.m.read
endProcedure mRead
/*--- put next line into m.line, return false at eof -----------------*/
mReadLn: procedure expose m.
parse arg m, line
if m.mrw.m.readLnIx == '' ,
| m.mrw.m.readLnIx >= m.mrw.m.readLnStem.0 then do
if ^ mRead(m, 'MRW.'m'.READLNSTEM') then do
m.line = ''
return 0
end
lx = 1
end
else do
lx = 1 + m.mrw.m.readLnIx
end
m.mrw.m.readLnIx = lx
m.line = m.mrw.m.readLnStem.lx
return 1
endProcedure readLn
mDefReadFromStem: procedure expose m.
parse arg m, stem
m.mrw.m.readFromStem = stem
call mDefRead m, 'if m.mrw.m.readFromStem == "" then return 0;' ,
'call mCopyStem stem, 0, m.mrw.m.readFromStem;' ,
'm.mrw.m.readFromStem = "";',
'return 1;'
return
endProcedure mDefReadStem
mReadFromStem: procedure expose m.
parse arg m, stem
si = m.mrw.m.readStem
ix = m.mrw.m.readStemIx + 1
m.mrw.m.readStemIx = ix
if ix <= m.si.0 then do
m.stem = m.si.ix
return 1
end
else do
m.stem = ''
return 0
end
endProcedure mReadFromStem
/**** simple convience function for stems *****************************/
/*--- fill stem st from index dx with lines from stem src ------------*/
mCopyStem: procedure expose m.
parse arg dst, dx, src
if dx == '' then
dx = m.dst.0
do ix = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.ix
end
m.dst.0 = dx
return dst
endProcedure mCopyStmm
/*--- fill stem dst from index dx with arguments ---------------------*/
mCopyArgs: procedure expose m.
parse arg dst, dx
if dx == '' then
dx = m.dst.0
do ix = 3 to arg()
dx = dx + 1
m.dst.dx = arg(ix)
end
m.dst.0 = dx
return dst
endProcedure mCopyArgs
mSay: procedure expose m.
parse arg stem, msg
l = length(m.stem.0)
if l < 3 then
l = 3
say left('', l, '-') msg 'mSay begin stem' stem m.stem.0
do ix = 1 to m.stem.0
say right(ix, l) strip(m.stem.ix, 't')
end
say left('', l, '-') msg 'mSay end stem' stem m.stem.0
return
endProcedure mSayem
/* copy mrw end ****************************************************/
/* copy adr begin ****************************************************/
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
/**********************************************************************
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 */
readDDall:
parse arg ggDD, ggSt
call adrTso 'execio * diskr' ggDD '(stem' ggSt' finis)'
return
endSubroutine readDDall
readDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(readDsn) shr dsn('dsn')'
call readDDall readDsn, ggSt
call adrTso 'free dd(readDsn)'
return
endSubroutine readDsn
/*--- 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 */
/*--- 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 */
/* copy adr end ****************************************************/
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
/**********************************************************************
adr*: address an environment
***********************************************************************/
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 'for' ggIspCmd
endSubroutine adrIsp
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 err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
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 zIspfRc
back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say 'help for rexx' s3
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
return 4
endProcedure help
/* copy err end *****************************************************/
}¢--- A540769.WK.REXX.O08(ENV) cre=2007-04-05 mod=2008-02-21-19.03.35 F540769 ---
/* copy env begin ******************************************************
***********************************************************************/
env: procedure expose m.
nn = oNew("Env")
m.nn.toClose = ''
call envReset nn
do ax=1 by 2 to arg()-1
call envAddIo nn, arg(ax), arg(ax+1)
end
return nn
endProcedure env
envReset: procedure expose m.
parse arg m
call envClose m
m.m.in = ''
m.m.out = ''
m.m.lastCat = ''
do ax=2 by 2 to arg()-1
call envAddIo m, arg(ax), arg(ax+1)
end
return m
endProcedure envReset
envClose: procedure expose m.
parse arg m
do wx=1 to words(m.m.toClose)
call jClose word(m.m.toClose, wx)
end
m.m.toClose = ''
return m
endProcedure envClose
envAddIO: procedure expose m.
parse arg m, opt, spec
contX = pos("+", opt)
if contX > 0 then do
opt = left(opt, contX-1)substr(opt,contX+1)
contX = 1
if m.m.lastCat == '' then
m.m.lastCat = cat()
end
if m.m.lastCat ^== '' then
call catWriteAll m.m.lastCat, opt, spec
else
oc = catMake(opt, spec)
if contX then
return
if m.m.lastCat ^== '' then do
oc = m.m.lastCat
m.m.lastCat = ''
opt = left(m.oc.opts.1, 1)
end
o1 = left(opt, 1)
if pos(o1, 'r<') > 0 then do
if m.m.in ^== '' then
call err 'envAddIo('opt',' spec') duplicate stdIn'
m.m.in = oc
end
else if pos(o1, 'wa>') > 0 then do
if m.m.out ^== '' then
call err 'envAddIo('opt',' spec') duplicate stdOut'
m.m.out = oc
end
if pos('-', opt) < 1 then do
call jOpen oc, catOpt(opt)
m.m.toClose = m.m.toClose oc
end
return m
endProcedure envAddIO
envLink: procedure expose m.
parse arg m, old
if m.m.lastCat ^== '' then
call err 'envLink with open cat'
if m.m.in == '' then
m.m.in = m.j.jIn
if m.m.out == '' then
m.m.out = m.j.jOut
return m
endProcedure envLink
envReadWrite: procedure expose m.
parse arg opt, rdr
if opt = '' then
call jWriteAll m.j.jOut, '-£', m.j.jIn
else
call jWriteAll m.j.jOut, opt, catMake(opt, rdr)
return
endProcedure envReadWrite
envRead2Buf: procedure expose m.
b = jBuf()
call envPush env('>£', b)
call envReadWrite
x = envPop()
return b
endProcedure envRead2Buf
envPreSuf: procedure expose m.
parse arg le, ri
do while jIn(v)
call jOut le || m.v || ri
end
return
endProcedure envPreSuf
envCatStr: procedure expose m.
parse arg mi, fo
res = ''
do while jIn(v)
res = res || mi || fmt(m.v)
end
return substr(res, length(mi))
endProcedure envCatStr
envIsDefined: procedure expose m.
parse arg na
return symbol('m.env.vars.na') == 'VAR'
endProcedure envIsDefined
envGet: procedure expose m.
parse arg na
return mapGet(env.vars, na)
envRead: procedure expose m.
parse arg na
return jIn('ENV.VARS.'na)
envHasKey: procedure expose m.
parse arg na
return mapHasKey(env.vars, na)
envVia: procedure expose m.
parse arg na
return mapVia(env.vars, na)
envPut: procedure expose m.
parse arg na, va
return mapPut(env.vars, na, va)
envRemove: procedure expose m.
parse arg na
return mapRemove(env.vars, na)
envIni: procedure expose m.
if m.env.ini == 1 then
return
m.env.ini = 1
call catIni
call oDecMethods oNewClass("Env", "JRW"),
, "jOpen call err 'envOpen('m', 'arg')'",
, "jReset return envReset(m, arg, arg(3), arg(4), arg(5))",
, "jClose call envClose m"
m.env.0 = 1
call mapReset env.vars
ex = env()
m.env.1 = ex
m.ex.in = m.j.jIn
m.ex.out = m.j.jOut
return
endProcedure envIni
envPush: procedure expose m.
parse arg e
ex = m.env.0
call envLink e, m.env.ex
ex = ex + 1
m.env.0 = ex
m.env.ex = e
m.j.jIn = m.e.in
m.j.jOut = m.e.out
return e
endProcedure envPush
envPop: procedure expose m.
ox = m.env.0
if ox <= 1 then
call err 'envPop on empty stack' ox
lazy = 0
if wordPos(oGetClass(m.j.jOut), 'Cat CatWrite CatRead') > 0 then do
e = m.env.ox
lazy = catLazyClose(m.j.jOut, m.e.toClose)
end
if lazy then
m.e.toClose = 'lazyDoNotClosePlease||||'
else
call envClose m.env.ox
ex = ox - 1
m.env.0 = ex
e = m.env.ex
m.j.jIn = m.e.in
m.j.jOut = m.e.out
return m.env.ox
endProcedure envPop
envBarBegin: procedure expose m.
call envPush env('>£', Cat())
return
endProcedure envBarBegin
envBar: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.oldEnv.out, '>£', Cat())
return
endProcedure envBar
envBarLast: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.oldEnv.out)
return
endProcedure envBarLast
envBarEnd: procedure expose m.
oldEnv = envPop()
return
endProcedure envBarEnd
/*--- return the output buffer of oRunner m --------------------------*/
envRun: procedure expose m.
parse arg m
b = jBuf()
call envPush env('>£', b)
call oRun m
x = envPop()
return b
endProcedure envRun
/* copy env end *******************************************************/
}¢--- A540769.WK.REXX.O08(ERR) cre=2008-01-07 mod=2008-09-15-09.17.01 F540769 ---
/* 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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(FMT) cre=2007-12-27 mod=2008-04-29-13.59.19 F540769 ---
/* copy fmt begin **************************************************/
/*--- format the first arg by the format in the second ---------------*/
fmt: procedure
parse arg v, f 2 l
if abbrev('-', f) then
return v
else if f = 'l' then
return left(v, l)
else if f = 'r' then
return right(v, l)
else if f = 's' then
if l = '' then
return strip(v, 't')
else
return strip(v, l)
else if f = 'w' then do
parse var l st ',' le
return substr(v, st, le)
end
else
call err 'bad format' f l 'for' v
endProcedure fmt
/*--- format special (title, null Value also for numbers) ------------*/
fmtS: procedure expose m.
parse arg v, f
return fmt(v, f)
endProcedure fmtS $
/* copy fmt end **************************************************/
}¢--- A540769.WK.REXX.O08(FMTF) cre=2008-02-21 mod=2008-02-21-18.45.50 F540769 ---
/* copy fmtF begin **************************************************/
fmtFldTitle: procedure expose m.
parse arg form
res = ''
fs = m.form.FLDS
do ix=1 to m.fs.0
res = res fmtS(m.fs.ix, m.form.ix)
end
return substr(res, 2)
endProcedure fmtFldTitle
fmtFld: procedure expose m.
parse arg form, st
res = ''
fs = m.form.FLDS
do ix=1 to m.fs.0
f = m.fs.ix
res = res fmt(m.st.f, m.form.ix)
end
return substr(res, 2)
endProcedure fmtData
fmtFldSquash: procedure expose m.
parse arg newFo, type, src
fs = oFlds(type)
do fx = 1 to m.fs.0
fd = m.fs.fx
lMi = 9e9
lMa = 0
rMi = 9e9
rMa = 0
len = 0
do sx = 1 to m.src.0
x = verify(m.src.sx.fd, ' ', 'n')
if x < 1 then
iterate
lMi = min(lMi, x)
lMa = max(lMa, x)
x = length(strip(m.src.sx.fd, 't'))
rMi = min(rMi, x)
rMa = max(rMa, x)
end
if rMa = 0 then
m.newFo.fx = 'w1,1'len
else
m.newFo.fx = 'w'lMi',' || (rMa+1-lMi)
end
m.newFo.0 = m.fs.0
m.newFo.flds = fs
return newFo
endProcedure fmtFldSquash
fmtFldRW: procedure expose m.
parse arg fo
ty = oGetTypePara(m.j.jIn)
call assert 'oFlds(ty) == m.fo.flds', 'fo different flds than type'
call jOut fmtFldTitle(fo)
do while jIn(ii)
call jOut fmtFld(fo, ii)
end
return
endProcedure fmtTypeRW
fmtFldSquashRW: procedure expose m.
parse arg in, opCl
if in = '' then
in = m.j.jIn
if opCl == 'opCl' then
call jOpen in, 'r'
ty = oGetTypePara(in)
flds = oFlds(ty)
st = 'FMT.TYPEAD'
do ix=1 while jRead(in, st'.'ix)
end
m.st.0 = ix - 1
fo = fmtFldSquash(sqFo, ty, st)
call jOut fmtFldTitle(fo)
do ix = 1 to m.st.0
call jOut fmtFld(fo, st'.'ix)
end
if opCl == 'opCl' then
call jClose in
return
endProcedure fmtFldSquashRW
/* copy fmtF end * **************************************************/
}¢--- A540769.WK.REXX.O08(FRANZ) cre=2006-10-24 mod=2006-12-15-10.36.49 F540769 ---
/***********************************************************************
***********************************************************************/
dPref = 'wk.frof'
call readDsn dPref'sr(ddnXXX)', m.new.
call partKey new, n
say m.n.0 'new partitions from' m.new.0 'lines from ddnXXX'
call readDsn dPref'sr(loadjsk)', m.sk.
say m.sk.0 'skeleton lines from loadJsk'
list = '244 241 242 259 260 261'
do listIx=1 to words(list)
tx = word(list, listIx)
call readDsn dPref'sr(ddo'tx')', m.old.
call partKey old, o
say m.o.0 'old partitions from' m.old.0 'lines from ddo'tx
call merge o, n
m.out.0 = 0
call readDsn dPref"sr(PUNCH"tx")", m.pun.
m.lod.1 = 'LOAD DATA LOG NO EBCDIC CCSID(00500,00000,00000)'
do px=1 by 1 to m.pun.0 while left(m.pun.px, 12) ^== ' INTO TABLE '
end
m.lod.2 = strip(left(m.pun.px, 72), 't') 'PART '
if left(m.lod.2, 12) ^== ' INTO TABLE ' then
call err 'into table not found in punch'tx
say 'punch'tx m.lod.2
m.lod.3 = ' RESUME NO REPLACE COPYDDN(TCOPYD) INDDN REC'
do px=px by 1 to m.pun.0 while left(m.pun.px, 6) ^== ' WHEN('
end
if px > m.pun.0 then
call err 'when not found in punch'tx
do lx = 4 by 1 while px <= m.pun.0
m.lod.lx = m.pun.px
if m.pun.px = ' )' then
leave
px = px + 1
end
m.lod.0 = lx
if px > m.pun.0 then
call err ') ending ) not found in punch'tx
/*
do x=1 to m.n.0
call out 'ALTER TABLE xyz.TNZ242A1'
if x <= m.o.0 then
call out ' ALTER PARTITION' x
else
call out ' ADD PARTITION --' x
call out " ENDING AT (X'"m.n.x"');"
end
*/
jobNo = 'j'
tabNo = 't'
jx = 0
do nx=1 by 3 to m.n.0
ny = nx + 2
if ny > m.n.0 then
ny = m.n.0
m.v.tabNo = tx
m.v.jobNo = right(nx, 2, '0')
jx = jx + 1
do sx=1 to m.sk.0
sl = strip(left(m.sk.sx, 72))
if sl == '$r' then do
do nz=nx to ny
li = '//REC'left(nz, 3)
do fx=m.n.nz.beg to m.n.nz.end
ff = format(fx, 5)
call out left(li,14)'DD DISP=SHR,',
|| 'DSN=&OLDPREF.'right(fx,5,0)'&OLDSUF'
li = '//'
end /* each old partition */
end /* each new partition */
end /* $r */
else if sl == '$l' then do
call out m.lod.1
do nz=nx to ny
call out m.lod.2 || nz
call out m.lod.3 || nz
do lx=4 to m.lod.0
call out m.lod.lx
end
end
end
else do
do forever
dx = pos('$', sl)
if dx < 1 then
leave
name = substr(sl, dx+1, 1)
if symbol('m.v.name') ^== 'VAR' then
call err 'undefined symbol $'name ,
'in sk.'sx m.sk.sx
sl = left(sl, dx-1) || m.v.name || substr(sl, dx+2)
end
call out sl
end
end /* each skeleton line */
end /* each job */
say 'generated' jx 'jobs' for 'tnz'tx
call writeDsn dPref'(load'tx')', m.out.
say 'written' m.out.0 'to' dPref'(load'tx')'
end
exit
partKey: procedure expose m.
parse arg i, o
nrLast = 0
do l=1 to m.i.0
line = translate(m.i.l)
pc = wordPos('PART', line)
if pc < 1 then
pc = wordPos('(PART', line)
if pc < 1 then
iterate
nrAct = word(line, pc+1)
val = word(line, pc+2)
if val = 'USING' then
iterate
if nrAct <> nrLast + 1 then
call err 'partition' (nrLast + 1) 'expected not:' line
if left(val, 9) <> "VALUES(X'" then
call err "VALUES(X' expected not:" line
ex = pos("'", val, 10)
if ex < 10 then
call err "ending Apostroph missing" line
m.o.nrAct = substr(val, 10, ex-10)
nrLast = nrAct
end
m.o.0 = nrLast
return
endProcedure partKey
merge: procedure expose m.
parse arg o, n
ox = 1
do nx = 1 to m.n.0
fbeg = ox
do ox=ox by 1 while ox <= m.o.0 & x2c(m.o.ox) < x2c(m.n.nx)
end
if ox > m.o.0 then
ox = m.o.0
fend = ox
m.n.nx.beg = fBeg
m.n.nx.end = fEnd
/* say 'new part' nx left(m.n.nx, 8) ,
'from old' fBeg left(m.o.fBeg, 8) 'to' fEnd left(m.o.fEnd, 8)
li = '//REC'left(nx, 3)
do fx=fBeg to fEnd
ff = format(fx, 5)
call out left(li,14)'DD DISP=SHR,',
|| 'DSN=&OLDPREF.'right(fx,5,0)'&OLDSUF'
li = '//'
end
*/ end
return
endProcedure merge
out: procedure expose m.
parse arg msg
/* say 'out:' strip(msg, 't')
*/ ox = m.out.0 + 1
m.out.0 = ox
m.out.ox = strip(msg, 't')
return
endProcedure out
err:
call errA arg(1), 1
endSubroutine err
/* 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 .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'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
dsn = strip(dsn)
if right(dsn, 1) = "'" then
dsn = strip(left(dsn, length(dsn) - 1))
bx = pos('(', dsn)
if bx > 0 then
dsn = strip(left(dsn, bx-1))
if mbr <> '' then
dsn = dsn'('strip(mbr)')'
if left(dsn, 1) = "'" then
dsn = dsn"'"
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), 't', "'")
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
if left(spec, 1) = '=' then
return strip(substr(spec, 1))
dsn = ''
do wx=1 to 3
w = word(spec, wx)
if w = '' then
leave
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if dsn = '' | left(w, 1) = "'" then
dsn = 'dsn('w')'
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
call adrTso 'alloc dd('dd')' disp dsn subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
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)
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(FRANZALT) cre=2006-10-24 mod=2006-10-24-14.32.03 F540769 ---
SET CURRENT SQLID='OA1P';
CREATE INDEX OA1P.INZ242A1
ON OA1P.TNZ242A1
(NZ242001 ASC,
NZ242003 ASC,
NZ242004 ASC,
NZ242005 ASC,
NZ242006 ASC,
NZ242007 ASC,
NZ242008 ASC)
USING STOGROUP GSMS
PRIQTY 324000 SECQTY 18000
FREEPAGE 10 PCTFREE 10
GBPCACHE CHANGED
CLUSTER
(PART 1 VALUES(X'0002FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 2 VALUES(X'0005FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 720 SECQTY 7200,
PART 3 VALUES(X'0009FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 21600,
PART 4 VALUES(X'0011FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 86400,
PART 5 VALUES(X'0015FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 6 VALUES(X'0019FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 28800,
PART 7 VALUES(X'001DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 720 SECQTY 7200,
PART 8 VALUES(X'0021FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 9 VALUES(X'0025FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 21600,
PART 10 VALUES(X'0029FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 11 VALUES(X'002DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 252000 SECQTY 14400,
PART 12 VALUES(X'0031FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 13 VALUES(X'0035FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 14 VALUES(X'0039FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 28800,
PART 15 VALUES(X'003DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 16 VALUES(X'0041FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 17 VALUES(X'0045FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 28800,
PART 18 VALUES(X'0049FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 21600,
PART 19 VALUES(X'004DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 21600,
PART 20 VALUES(X'0051FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 21 VALUES(X'0055FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 252000 SECQTY 14400,
PART 22 VALUES(X'0059FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 720 SECQTY 7200,
PART 23 VALUES(X'005DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 28800,
PART 24 VALUES(X'0061FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 28800,
PART 25 VALUES(X'0065FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 26 VALUES(X'0069FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 21600,
PART 27 VALUES(X'006DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 28 VALUES(X'0071FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 29 VALUES(X'0075FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 30 VALUES(X'0079FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 252000 SECQTY 14400,
PART 31 VALUES(X'007DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 32 VALUES(X'0081FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 21600,
PART 33 VALUES(X'0085FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 720 SECQTY 7200,
PART 34 VALUES(X'0089FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 252000 SECQTY 14400,
PART 35 VALUES(X'008DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 36 VALUES(X'0091FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 37 VALUES(X'0095FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 38 VALUES(X'0099FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 39 VALUES(X'009DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 40 VALUES(X'00A1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 41 VALUES(X'00A5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 42 VALUES(X'00A9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 43 VALUES(X'00ADFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 44 VALUES(X'00B1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 45 VALUES(X'00B5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 46 VALUES(X'00B9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 47 VALUES(X'00BDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 48 VALUES(X'00C1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 49 VALUES(X'00C5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 252000 SECQTY 14400,
PART 50 VALUES(X'00C9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 28800,
PART 51 VALUES(X'00CDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 52 VALUES(X'00D1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 252000 SECQTY 14400,
PART 53 VALUES(X'00D5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 54 VALUES(X'00D9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 21600,
PART 55 VALUES(X'00DDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 56 VALUES(X'00E1FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 18000,
PART 57 VALUES(X'00E5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 58 VALUES(X'00E9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 25200,
PART 59 VALUES(X'00EDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 21600,
PART 60 VALUES(X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF')
USING STOGROUP GSMS PRIQTY 360000 SECQTY 288000)
BUFFERPOOL BP1
CLOSE YES
COPY NO
DEFINE YES;
COMMIT;
}¢--- A540769.WK.REXX.O08(FRANZNEU) cre= mod= ----------------------------------
SET CURRENT SQLID='GDB0283';
CREATE INDEX GDB0283.INZ242A1
ON GDB0283.TNZ242A1
(NZ242001 ASC,
NZ242003 ASC,
NZ242004 ASC,
NZ242005 ASC,
NZ242006 ASC,
NZ242007 ASC,
NZ242008 ASC)
USING STOGROUP GSMS
PRIQTY 48 SECQTY 7200
FREEPAGE 10 PCTFREE 10
GBPCACHE CHANGED
CLUSTER
(PART 1 VALUES(X'0003FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 2 VALUES(X'0007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 3 VALUES(X'000BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 4 VALUES(X'000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 5 VALUES(X'0013FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 6 VALUES(X'0017FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 7 VALUES(X'001BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 8 VALUES(X'001FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 9 VALUES(X'0023FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 10 VALUES(X'0027FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 11 VALUES(X'002BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 12 VALUES(X'002FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 13 VALUES(X'0033FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 14 VALUES(X'0037FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 15 VALUES(X'003BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 16 VALUES(X'003FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 17 VALUES(X'0043FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 18 VALUES(X'0047FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 19 VALUES(X'004BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 20 VALUES(X'004FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 21 VALUES(X'0053FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 22 VALUES(X'0057FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 23 VALUES(X'005BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 24 VALUES(X'005FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 25 VALUES(X'0063FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 26 VALUES(X'0067FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 27 VALUES(X'006BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 28 VALUES(X'006FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 29 VALUES(X'0073FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 30 VALUES(X'0077FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 31 VALUES(X'007BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 32 VALUES(X'007FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 33 VALUES(X'0083FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 34 VALUES(X'0087FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 35 VALUES(X'008BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 36 VALUES(X'008FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 37 VALUES(X'0093FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 38 VALUES(X'0097FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 39 VALUES(X'009BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 40 VALUES(X'009FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 41 VALUES(X'00A3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 42 VALUES(X'00A7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 43 VALUES(X'00ABFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 44 VALUES(X'00AFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 45 VALUES(X'00B3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 46 VALUES(X'00B7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 47 VALUES(X'00BBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 48 VALUES(X'00BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 49 VALUES(X'00C3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 50 VALUES(X'00C7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 51 VALUES(X'00CBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 52 VALUES(X'00CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 53 VALUES(X'00D3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 54 VALUES(X'00D7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 55 VALUES(X'00DBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 56 VALUES(X'00DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 57 VALUES(X'00E3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 58 VALUES(X'00E7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 59 VALUES(X'00EBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 60 VALUES(X'00EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 61 VALUES(X'00F3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 62 VALUES(X'00F7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 63 VALUES(X'00FBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 64 VALUES(X'00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'),
PART 65 VALUES(X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'))
BUFFERPOOL BP1
CLOSE YES
COPY NO
DEFINE YES;
COMMIT;
}¢--- A540769.WK.REXX.O08(GB#V302) cre=2007-01-19 mod=2007-01-19-12.50.58 F540769 ---
/*REXX ****************************************************************/
/* OUTPUT ANPASSEN FüR MAILVERSAND */
/* */
/* ERSTELLT : 24.09.2004 */
/* OWNER : A754048 */
/* UPDATE : 24.09.2004 */
/**********************************************************************/
ADDRESS TSO
/* dsn einlesen --------------------------*/
"EXECIO * DISKr IN (STEM ln1. FINIS"
/* dsn selektieren -----------------------*/
y=0;yy=0;x=0;z=0
DO p=1 TO LN1.0
if pos('+',ln1.p)>0 | pos('|',ln1.p)>0 |,
pos('-- ',ln1.p)>0 | pos('SUCCESSFUL',ln1.p)>0 then do
y=y+1;x=X+1
select
when pos('-- ',ln1.p) > 0 then do
mail1.y=substr(ln1.p,pos('-- ',ln1.p),79)
end
when pos('+',ln1.p) > 0 then do
mail1.y=substr(ln1.p,pos('+',ln1.p),79)
end
when pos('|',ln1.p) > 0 then do
mail1.y=substr(ln1.p,pos('|',ln1.p),79)
end
when pos('SUCCESSFUL',ln1.p)>0 then do
parse var ln1.p v1 v2 v3 v4 v5 rest
if v4 = 0 then do
x=0
end
if v4 > 0 then do
y=y-x
do xx=1 to x-1
z=z+1;y=y+1
mail2.z=mail1.y
end
x=0
end
end
otherwise nop
end
end
end p
if z = 0 then mail2.1='ALLES IM GRüNEN BEREICH |||'
/* dsn schreiben -------------------------*/
"EXECIO * DISKW out (STEM mail2. FINIS"
exit
/* Programm Ende ---------------------------------------*/
/**********************************************************************/
}¢--- A540769.WK.REXX.O08(GB#V310) cre=2007-01-22 mod=2007-01-23-12.19.47 F540769 ---
/*REXX ****************************************************************/
/* OUTPUT ANPASSEN FüR MAILVERSAND */
/* */
/* ERSTELLT : 24.09.2004 */
/* OWNER : A754048 */
/* UPDATE : 22.01.2007, Walter Keller */
/**********************************************************************/
inDsn = dsn2jcl('TMP.GBLIMIT1')
mailin = dsn2jcl('wk.extent(mailIn)')
outDsn = dsn2jcl('TMP.GBLIMIT2')
inDsn = '=IN'
mailin = '=MAILIN'
outDsn = '=OUT'
subjextX = 0
text0X = 0
ox = 0
/* mailIn einlesen: mail Skeleton --------*/
call readDsn mailIn, ma.
do mx=1 to ma.0 /* jede skeleton Zeile */
ox = ox + 1
out.ox = left(ma.mx, 79)
if wordPos($SUB, ma.mx) > 0 then do
subjectX = ox
end
else if strip(ma.mx) = '$@TEXT' then do
text0X = ox
schwWe = sqlOutput()
end
end /* jede skeleton Zeile */
/* subjekt und text ergänzen -------------*/
if schwWe = 0 then do
sub = 'OK'
l0 = ' Alles im grünen Bereich |||'
end
else do
sub = ' 'schwWe 'Schwellen erreicht'
l0 = sub
end
out.text0x = l0 right('('time()',' date()',' sysvar(sysNode)',' ,
mvsVar('SYMDEF', 'JOBNAME')')', 78-length(l0))
if subjectX > 0 then
out.subjectX = left( ,
left(out.subjectX, pos('$SUB', out.subjectX) - 1) || sub,
|| substr(out.subjectX, pos('$SUB', out.subjectX) + 4) , 79)
/* output schreiben ----------------------*/
call writeDsn outDsn, out., ox ,1
exit
/*--- den SqlOuptut lesen und gefiltert in den Output schreiben ------*/
sqlOutput:
cnt = 0
cntLast = 0
cntSucc = 0
cntSpec = 0
special = 0
call readDsn inDsn, in.
lastSucc = ox
DO ix=1 TO in.0 /* every input line */
w1 = translate(word(substr(in.ix, 2), 1))
l3 = left(w1, 3)
x1 = pos(w1, in.ix, 2)
ox = ox + 1
select
when w1 == '--$SPECIAL' then do
special = 1
ox = ox - 1
end
when l3 = '--\' then do
out.ox = '*'substr(in.ix, x1+3, 78)
end
when l3 = '--*' | (l3 = '--/' & cntLast > 0) then do
out.ox = '*'substr(in.ix, x1+3, 78)
lastSucc = ox
end
when abbrev(w1, '+--') then do
out.ox = substr(in.ix, x1, 79)
end
when right(w1, 1) = '|' & right(w1, 2) <> '||' then do
out.ox = substr(in.ix, pos('|', in.ix), 79)
end
when w1 = 'SUCCESSFUL' then do
cntSucc = cntSucc + 1
parse upper var in.ix 2 suc ret of cntLast rw .
if ^ ( suc == 'SUCCESSFUL' & ret == 'RETRIEVAL',
& abbrev(rw, 'ROW') & datatype(cntLast, 'N')) then
call err 'bad SUCCESSFUL row' ix':' in.ix
if cntLast > 0 then do
ox = ox - 1
lastSucc = ox
if special then
cntSpec = cntSpec + cntLast
else
cnt = cnt + cntLast
special = 0
end
else do
ox = lastSucc /* do not output previous lines */
end
end
otherwise do
ox = ox - 1 /* do not output this line */
end
end /* select */
end /* every input line */
say in.0 'inputLines,' cntSucc 'selects,' cnt 'selected rows,' ,
cntSpec 'special rows'
return cnt
endProcedure sqlOutput
err:
call errA arg(1), 1
endSubroutine err
/* 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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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
m.dsnAlloc.dsn = ''
if left(spec, 1) = '=' then
return strip(substr(spec, 2))
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 to 3
w = word(spec, wx)
if w = '' then
leave
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if m.dsnAlloc.dsn = '' then
m.dsnAlloc.dsn = dsn2jcl(w, addPref)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if m.dsnAlloc.dsn <> '' then
disp = disp "dsn('"m.dsnAlloc.dsn"')"
call adrTso 'alloc dd('dd')' disp subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
/* Programm Ende ---------------------------------------*/
/**********************************************************************/
}¢--- A540769.WK.REXX.O08(GEOM) cre= mod= --------------------------------------
/* REXX *************************************************************
this editmacro moves points by different geometric maps
default
-f<xy> from point 0, 0
-g<xy> if set select only points in select all points
rectangle (-f, -g)
-r<a> rotate by a * 90 degrees 0
-d<a> rotate Direction values by a -r
-s<f> stretch by a factor f 1
-s<xy> stretch in x/y direction 1 1
-t<xy> to point -f
.<fr> from label .zf
.<to> to label .zl
<a> angle an integer
<f> a float, e.g 13 or 45.67
<xy> coordinatesgates eg 0,34.6
**********************************************************************/
call adrEdit('macro (args)')
say 'macro args' args
if args = '' then
args = '-f121.0,289.5 -t100,100 .a .b -r2'
call analyseArgs args
rst = rotStrTraArgs(optR optS optF optT)
say 'rst' rst '-f =>' rotStrTra(rst optF)
call adrEdit '(lnF) = linenum' labF
call adrEdit '(lnT) = linenum' labT
say 'labels' labF lnF labT lnT
selPos = 0
do lx=lnF to lnT
call adrEdit '(li) = line' lx
new = editPosition(lx, li)
if optD <> 0 & new <> '' then do
new = editDirection(lx, new)
end
if new <> '' then
call adrEdit "line" lx "= (new)"
end
exit
/* *****************************************
FIELD POSIT 100.0 100.0 Font A2828I direction BACK 11 ;
FIELD POSIT 81.0 100.0 Font A2828I direCTI DOWN 8 ;
FIELD POSIT 154.5 289.5 Font A1817I START 20 LENGTH 11 ;
**********************************************************/
/* *****************************************
FIELD POSIT 121.0 289.5 Font A2828I direction across 11 ;
FIELD POSIT 140.0 289.5 Font A2828I direCTI up 8 ;
FIELD POSIT 154.5 289.5 Font A1817I START 20 LENGTH 11 ;
FIELD POSIT 170.8 289.5 Font A1817I START 31 LENGTH 4 ;
SN: Seitennummer
FIELD POSIT 179.5 289.5 Font A1817I START 35 LENGTH 8 ;
FIELD POSIT 192.3 289.5 Font A1817I START 43 LENGTH 2 ;
**********************************************************/
call testGeom
editPosition: procedure expose optG RST
parse arg lx, li
up = translate(li)
px = pos('POSI', up)
if px < 1 then
return ''
xx = wordIndex(substr(li, px), 2) + px - 1
yx = wordIndex(substr(li, px), 3) + px - 1
rx = wordIndex(substr(li, px), 4) + px - 1
if rx < 1 then
rx = length(li) + 1
if xx <= px | yx <= xx then do
say 'missing words skipping line' lx li
return ''
end
x = word(substr(li, xx), 1)
y = word(substr(li, yx), 1)
if datatype(x) <> 'NUM' | datatype(y) <> 'NUM' then do
say 'not numeric skipping line' lx li
return ''
end
if optG <> '' then do
if word(optG, 1) > x | x > word(optG, 3) ,
| word(optG, 2) > y | y > word(optG, 4) then
return ''
end
n2 = rotStrTra(RST x y)
xS = pos(' ', li, px) + 1
rS = rx - (rx <= length(li))
return left(li, xS-1),
|| reformat(n2, substr(li, xS, rS-xS)),
|| substr(li, rS)
endProcedure editPosition
reformat: procedure
parse arg nums, like
res = ''
do wx=1 to words(nums)
w = word(nums, wx)
dx = pos('.', w)
if dx > 0 & length(w) - dx > 2 then
res = res format(w,,2)
else
res = res w
end
if length(res) > 0 then
res = substr(res, 2)
if length(res) >= length(like) then
return res
do wx=1 to words(nums)
rw = wordIndex(res, wx)
rx = verify(res, '. ', 'm', rw)
if rx < rw then
rx = length(res)
lw = wordIndex(like, wx)
lx = verify(like, '. ', 'm', lw)
if lx < lw then
lx = length(like)
if rx < lx then do;
if lx-rx >= length(like) - length(res) then
return left(res, rw-1) ,
|| left('',length(like) - length(res)),
|| substr(res,rw)
res = left(res, rw-1)left('',lx-rx)substr(res,rw)
if length(res) >= length(like) then
return res
end
end
return left(res, length(like))
endProcedure reformat
editDirection: procedure expose optD
parse arg lx, li
dirs = '0=ACROSS 1=DOWN 2=BACK 3=UP '
dx = pos('DIRE', translate(li))
if dx < 1 then
return ''
vx = wordIndex(substr(li, dx), 2) + dx - 1
w = translate(word(substr(li, vx), 1))
if w = '' then do
say 'direction missing' lx li
return ''
end
cx = pos('='w, dirs)
if cx < 2 then do
say 'direction illegal' w 'line' lx li
return ''
end
nx = angleNorm(optD + substr(dirs, cx-1, 1))
cx = pos(nx'=', dirs)
nn = word(substr(dirs, cx+2), 1)
qx = length(nn) - length(w)
if qx <= 0 then do
new = left(li, vx-1)nn||left('',-qx)substr(li,vx+length(w))
end
else do
rx = verify(substr(li, vx+length(w)), ' ');
if rx <= 0 then
rx = 1 + length(li)
else if rx - 2 > qx then
rx = vx + length(w) + qx
else
rx = vx + length(w) + rx - 2
new = left(li, vx-1)nn||strip(substr(li,rx), 't')
end
return new
end editDirection
analyseArgs: procedure expose optD optF optG optR optS optT labF labT
parse arg args
parse value '0 *' with optR optD optF optG optT labF labT
optS = 1 1
do wx=1 by 1
w = word(args, wx)
if w = '' then
leave
wL = left(w, 2)
wR = substr(w, 3)
select
when wL = '-d' then optD = wR
when wL = '-f' then optF = translate(wR, ' ', ',')
when wL = '-g' then optG = translate(wR, ' ', ',')
when wL = '-r' then optR = wR
when wL = '-s' then do
optS = translate(wR, ' ', ',')
if words(optS) = 1 then
optS = optS optS
end
when wL = '-t' then optT = translate(wR, ' ', ',')
when left(wL, 1) = '.' then do
if labF = '' then labF = w
else if labT = '' then labT = w
else call err 'more than two labels' w
end
when wL = '-?' | left(wL, 1) = '?' then do
call help
exit
end
otherwise call err 'bad Option' w
end /* select */
end /* do each word */
if optF = '' then optF = 0 0
if optT = '' then optT = optF
if labF = '' then labF = '.zf'
if labT = '' then labT = '.zl'
if optG <> '' then do
if word(optF, 1) <= word(optG, 1) then do
tl = word(optF, 1)
br = word(optG, 1)
end
else do
tl = word(optG, 1)
br = word(optF, 1)
end
if word(optF, 2) <= word(optG, 2) then
optG = tl word(optF, 2) br word(optG, 2)
else
optG = tl word(optG, 2) br word(optF, 2)
end
if optD = '*' then
optD = optR
else if optD = '' then
optD = 0
say 'analyseArgs -f='optF '-g='optG '-r='optR '-d='optD,
'-s='optS '-t='optT,
'from' labF 'to' labT
return
endProcedure analyseArgs
testGeom: procedure
say 'mod(112, 10)' mod(112, 10)
say 'mod(-112, 10)' mod(-112, 10)
say testRotate(0 4 5)
say testRotate(1 4 5)
say testRotate(1 4 '-5')
say testRotate(2 4 '-5')
say testRotate(3 4 '-5')
say testRotate(-297 4 '-5')
/* say testRotate(297.1 4 '-5') */
call testRST 0 1 1 1 2 7 9
call testRST 3 1 1 1 2 7 9
call testRST 2 2 3 1 2 7 9
return
end gestGeom
testRotate: procedure
parse arg aa
return 'rotate('aa') => 'rotate(aa)
endProcedure testRotate
rotate: procedure
parse arg a x y
select
when a=0 then return x y
when a=1 then return -y x
when a=2 then return -x (-y)
when a=3 then return y (-x)
otherwise return rotate(angleNorm(a) x y)
end
endProcedure rotate
testRST: procedure
parse arg r sx sy f g t u
aa = rotStrTraArgs(r sx sy f g t u)
say 'rotStrTraArgs('r sx sy f g t u ') =>' aa
say 'from RST('f g') =>' rotStrTra(aa f g)
say ' RST(-7 0 +7, -3) =>' left(rotStrTra(aa (-7) (-3)), 12) ,
left(rotStrTra(aa ( 0) (-3)), 12) ,
left(rotStrTra(aa (+7) (-3)), 12)
say ' RST(-7 0 +7, 0) =>' left(rotStrTra(aa (-7) ( 0)), 12) ,
left(rotStrTra(aa ( 0) ( 0)), 12) ,
left(rotStrTra(aa (+7) ( 0)), 12)
say ' RST(-7 0 +7, +3) =>' left(rotStrTra(aa (-7) (+3)), 12) ,
left(rotStrTra(aa ( 0) (+3)), 12) ,
left(rotStrTra(aa (+7) (+3)), 12)
return
end testRST
rotStrTra: procedure
parse arg r sx sy t u x y
return trans(stretch(sx sy rotate(r x y)) t u)
endProcedure trans
rotStrTraArgs: procedure
parse arg r sx sy f g t u
/* rotate and stretch origin (f g) */
z = stretch(sx sy rotate(r f g))
/* move it to (t u) */
return r sx sy trans(t u rotate(2 z))
endProcedure rotStrTraArgs
trans: procedure
parse arg a b x y
return (a+x) (b+y)
endProcedure trans
stretch: procedure
parse arg fx fy x y
return (fx*x) (fy*y)
endProcedure stretch
angleNorm: procedure
parse arg a
n = mod(a, 4)
if length(n) <> 1 | verify(n, '0123') > 0 then
call err 'bad angle' a
return n
endProcedure angleNorm
mod: procedure
parse arg a, b
if a >= 0 then
return a // b
else
return b + a // b
endProcedure mod
/************** member copy adr **************************************/
/**********************************************************************
dsn*: manipulate dataSetNames
dsn2Jcl: convert from tso to JCL format
dsnFromJcl: convert from jcl to TSO format
dsnGetLLQ: get the llq from a dsn
dsnGetMbr: get the Member name from a dsn
dsnApp: cleanup and append dsn parts (preserve apos ...)
dsnSetMbr: set a Member name or remove it if mbr = ''
***********************************************************************/
say dsnApp("a.b c(d e) f' ))) h")
say dsnApp("'a.b c(d e) f' ))) h")
call help
call errHelp(test errHelp)
dsn2jcl: procedure
parse arg dsn .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
dsnApp: procedure
parse arg parts
dsn = ''
do wx=1 by 1
w = word(parts, wx)
if w = '' then
leave
do while w <> ''
if pos(right(w, 1), "') ") <= 0 then
leave
w = left(w, length(w)-1)
end
dsn = dsn || w
end
if pos('(', dsn) > 0 then
dsn = dsn')'
if left(dsn,1) = "'" then
return dsn"'"
else
return dsn
endProcedure dsnApp
dsnSetMbr: procedure
parse arg dsn, mbr
mbr = strip(mbr)
bx = pos('(', dsn)
if mbr = '' then do
if bx < 1 then
return dsn
else if left(dsn, 1) = "'" then
return left(dsn,bx-1)"'"
else
return left(dsn,bx-1)
end
else do
if bx < 1 then
return dsnApp(dsn '('mbr)
else
return dsnApp(left(dsn, bx) mbr)
end
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), 't', "'")
endProcedure dsnGetMbr
dsnGetLLQ: procedure
parse arg dsn
rx = pos('(', dsn) - 1
if rx < 0 then
rx = length(dsn)
lx = lastPos('.', dsn, rx)
return strip(substr(dsn, lx+1, rx-lx), 'b', "'")
endProcedure dsnGetLLQ
/**********************************************************************
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
***********************************************************************/
lmdTest: procedure
parse arg lev
say showTime() 'lmdTest' lev
call lmdBegin 'test', lev
say showTime() 'lmdTest after begin' lev
z = 0
do while lmdNext('test', st.)
do y=1 to st.0
z=z+1
say z word(st.y, 1)
end
end
call lmdEnd 'test'
say showTime() 'lmdTest' z 'files in' lev
return /* readTest */
lmdBegin: procedure
parse arg grp, lev
call adrIsp 'lmdinit listid(lmdId) level('lev')'
call adrIsp 'lmdlist listid(&lmdId) option(save) group('grp')'
call adrIsp 'lmdfree listid(&lmdId)'
say showTime() 'lmdlist save' grp lev
call readBegin grp, grp'.datasets'
return /* end lmdBegin */
lmdNext:
parse arg lvGrp, lvSt
return readNext(lvGrp, lvSt)
lmdEnd: procedure
parse arg grp
call readEnd grp
return /* end lmdEnd */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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')'
say 'lmmBegin returning' res
return res
end lmmBegin
lmmEnd: procedure
parse arg lmmId opt
if adrIspRc("LMMLIST DATAID("lmmId") option(free)") <> 0 then
if rc <> 8 then
call err "lmmEnd" id lmmId "rc" rc "for lmmList free"
call adrIsp "LMCLOSE DATAID("lmmId")"
call adrIsp "LMFREE DATAID("lmmId")"
return
endProcedure lmmEnd
lmmNext: procedure
parse arg lmmId opt
gmRc = adrIspRc("LMMLIST DATAID("lmmid")" ,
"OPTION(LIST) MEMBER(Mbr)" opt)
if gmRc = 0 then
return mbr
else if gmRc = 8 | gmRC = 4 then
return ''
else
call err 'lmmList rc' gmRc
endProcedure lmmNext
/**********************************************************************
read: read a file
call sequence: readBegin, readNext*, readEnd
1. arg (dd) dd name, wird alloziert in begin und free in end
readNext liest 100 records in übergebenen stem,
returns false at eof
***********************************************************************/
readTest: procedure
parse arg dsn
say showTime() 'readTest' dsn
call readBegin 'ddEins', dsn
z = 0
do while readNext('ddEins', st.)
do y=1 to st.0
z=z+1
say z strip(st.y, 't')
end
end
call readEnd 'ddEins'
say showTime() 'readTest' z 'records in' dsn
return /* readTest */
readBegin: procedure
parse arg dd, dsn
call adrTso 'alloc dd('dd') shr reuse dsn('dsn')'
return /* end readBegin */
readNext:
parse arg lv_DD, lv_St
if adrTsoRc('execio 100 diskr' lv_DD '(stem' lv_St')') = 0 then
return 1
else if rc = 2 then
return (value(lv_St'0') > 0)
else
call err 'execio 100 diskr' lv_DD 'rc' rc
return /* end readNext */
readEnd: procedure
parse arg dd
call adrTso 'execio 0 diskr' dd '(finis)'
call adrTso 'free dd('dd')'
return /* end readEnd */
/**********************************************************************
writeApp: append lines to a file
ggDsn: dsn to append lines
ggStem stem containing line (with dot|)
ggNr number of lines, if empty <stem>.0
***********************************************************************/
writeApp:
parse arg ggDsn, ggStem, ggNr
if ggNr = '' then
ggNr = value(ggStem'0')
if pos('(', ggDsn) < 1 then do /* sequential ds, use disp=mod */
call adrTso 'alloc mod reuse dd(ddApp) dsn('ggDsn')'
end
else do /* pds: read and rewrite */
call adrTso 'alloc shr reuse dd(ddApp) dsn('ggDsn')'
if sysdsn(ggDsn) = 'OK' then do
call adrTso 'execio * diskr ddApp (stem ggL. finis)'
call adrTso 'execio' ggL.0 'diskw ddApp (stem ggL.)'
end
end
call adrTso 'execio' ggNr 'diskw ddApp (stem' ggStem 'finis)'
call adrTso 'free dd(ddApp)'
return
endProcedure writeApp
log: procedure
parse arg logLine
l.1 = date('s') time() logLine
call writeApp 'wk.out(ll)', l., 1
return
endProcedure log
/**********************************************************************
variable Expansion: replace variable by their value
***********************************************************************/
varExpandTest: procedure
m.v.eins ='valEins'
m.v.zwei ='valZwei'
m.l.1='zeile eins geht unverändert'
m.l.2='$EINS auf zeile ${ZWEI} und \$EINS'
m.l.3='...$EINS?auf zeile ${ZWEI}und $EINS'
m.l.4='...$EINS,uf zeile ${ZWEI}und $EINS$$'
m.l.5='${EINS}$ZWEI$EINS${ZWEI}'
m.l.0=5
call varExpand l, r, v
do y=1 to m.r.0
say 'old' y m.l.y
say 'new' y m.r.y
end
return
endProcedure varExpandTest
varExpand: procedure expose m.
parse arg old, new, var
varChars = ,
'0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
do lx=1 to m.old.0
cx = 1
res = ''
do forever
dx = pos('$', m.old.lx, cx)
if dx < cx then do
m.new.lx = res || strip(substr(m.old.lx, cx), 't')
leave
end
res = res || substr(m.old.lx, cx, dx - cx)
if dx >= length(m.old.lx) then
call err '$ at end line m.'old'.'lx'='m.old.lx
if substr(m.old.lx, dx+1, 1) = '$' then do
res = res || '$'
cx = dx + 2
iterate
end
if substr(m.old.lx, dx+1, 1) = '{' then do
cx = pos('}', m.old.lx, dx+1)
if cx <= dx then
call err 'ending } missing line m.'old'.'lx'='m.old.lx
na = substr(m.old.lx, dx+2, cx-dx-2)
cx = cx + 1
end
else do
cx = verify(m.old.lx, varChars, 'N', dx+1);
if cx <= dx then
cx = length(m.old.lx) + 1
na = substr(m.old.lx, dx+1, cx-dx-1)
end
if symbol('m.v.na') = 'VAR' then
res = res || m.var.na
else
call err 'var' na 'not defined line m.'old'.'lx'='m.old.lx
end
m.new.0 = m.old.0
end
return /* var expand */
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggStmt, ggNo
if ggNo <> '1' then
ggStmt = 'execSql' ggStmt
address dsnRexx ggStmt
if rc = 0 then
nop /* say "sql ok:" ggStmt */
else if rc > 0 then
say "sql warn rc" rc sqlmsg()':' ggStmt
else
call err "sql rc" rc sqlmsg()':' ggStmt
return
endSubroutine adrSql
adrSqlConnect: procedure
parse arg sys
if adrTSORc("SUBCOM DSNREXX") <> 0 then do
sRC = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
say 'subcom' sRc
end
call adrSql "connect" sys, 1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
call adrSql "disconnect ", 1
return
endProcedure adrSqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
if sqlCode = 0 then
return 'ok (sqlCode=0)'
else
return 'sqlCode='sqlCode,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x))
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTsoRc('DSN SYSTEM('sys')')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/**********************************************************************
adr*: address an environment
adrTso: fails if rc <> 0
adrTsoRc: returns rc without failing
***********************************************************************/
adrTsoRc:
parse arg tsoCmd
address tso tsoCmd
return rc /* end adrTsoRc */
adrTso:
parse arg tsoCmd
address tso tsoCmd
if rc <> 0 then
call err 'adrTso rc' rc 'for' tsoCmd
return /* end adrTso */
adrIspRc:
parse arg ispCmd
address ispexec ispCmd
return rc /* end adrIspRc */
adrIsp:
parse arg ispCmd
address ispexec ispCmd
if rc <> 0 then
call err 'adrIsp rc' rc 'for' ispCmd
return /* end adrIsp */
adrEdit:
parse arg editCmd, ret
address isrEdit editCmd
if rc <> 0 then
call err 'adr isrEdit rc' rc 'for' editCmd
return /* end adrEdit */
adrEditRc:
parse arg editCmd
address isrEdit editCmd
return rc /* end adrEditRc */
err:
parse arg txt
parse source s1 s2 s3 .
say 'fatal error in' s3':' txt
exit 12
errHelp: procedure
parse arg errMsg
say 'fatal error:' errMsg
call help
call err errMsg
endProcedure errHelp
help: procedure
parse source . . s3 .
say 'help for rexx' s3
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
return
endProcedure help
showtime:
parse arg showmsg
return time() sysvar('syscpu') sysvar('syssrv') showmsg
}¢--- A540769.WK.REXX.O08(INC) cre=2007-12-27 mod=2008-05-20-16.23.08 F540769 ---
/* REXX *************************************************************
include macro:
replace all lines between
<commentStart> copy <mbr> begin .....
and
<commentStart> copy <mbr> end ....
by the contents of member <mbr>
currently no nesting allowed
**********************************************************************/
call adrIsp 'control errors return'
call adrEdit 'macro (args)'
if pos('?', args) > 0 then
return help()
say 'macro inc ingoring args' args
call adrEdit "(myMb) = member"
call adrEdit "cursor = .zf"
fnd = 'copy'
begMbr = ''
do forever
if adrEdit("find '"fnd"'", 0 4) ^= 0 then
leave
call adrEdit "(lNr) = linenum .zcsr"
call adrEdit "(li) = line .zcsr"
upper li
if left(word(li, 1), 2) <> '/*' | word(li, 2) <> 'COPY' ,
| wordPos(word(li, 4), 'BEGIN END') < 1 then
nop
else if word(li, 4) = 'BEGIN' then do
begLx = lNr
begMbr = word(li, 3)
end
else if word(li, 3) = begMbr then do
call replace begMbr begLx lNr
begMbr = ''
end
else do
say '***** unpaired end' lNr li
end
end
say 'end macro inc'
exit
replace: procedure expose myMb
parse upper arg mbr fx tx
if mbr = myMb then do
say 'not replacing recursive' mbr
return
end
call adrEdit "(laX) = linenum .zl"
say 'replacing' mbr "lines" fx tx "last" laX
if laX > tx then do
call adrEdit "cursor = " (tx+1) 1
loc = "before .zcsr"
end
else do
loc = "after .zl"
end
call adrEdit "delete" fx tx
if adrEdit("copy" mbr loc, '*') <> 0 then
call err "***** could not copy" mbr loc
if ^ (laX > tx) then
call adrEdit "cursor = .zl 72 "
return
endProcedure replace
/* 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 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(INTER) cre= mod= -------------------------------------
/* rexx */
do forever
say 'enter rexx or -'
parse pull inp
say 'pull "'inp'"'
if strip(inp) = '-' then
return
interpret inp
end
}¢--- A540769.WK.REXX.O08(I2BASE) cre=2007-10-02 mod=2007-10-26-12.14.33 F540769 ---
/*
call tt 7, 16
call tt 67, 16
call tt 260, 16
call ss 1, 2
call ss 1 0 0 1, 2
call ss 1 2 3, 16
call ss 3 4, 7
call zz '0129ABFZaxyz?'
*/
numeric digits 40
call stck2utc BC5A0D03E4BB, 47
call stck2utc C15AB53613BC, 47
/*
call tt 20071002113721869421, 36
call tt 20071002113721869421, 64
call tt 2007100211372186, 36
*/
x = 'Z9999999'
y = b2i(z2w(x),35)
z = (y * 0.001024 /86400)
say x y z (z/365)
stck = BC5A0D03E4BC
stcki= c2d(x2c(stck))
say '2005' stck stcki (stcki / 1024)
say '******** zero'
call qq D2004366.T000022.AAAAAAAA
say 'rz1 **********'
call qq D2007288.T131853.BL0J3CB1
call qq D2007288.T131857.BL0J3EWI
call qq D2007288.T131900.BL0J3HXQ
call qq D2007288.T131936.BL0J4BCI
call qq D2007288.T132354.BL0KA5V8
call qq D2007288.T132358.BL0KA8YL
call qq D2007288.T133340.BL0KOJEW
call qq D2007288.T133341.BL0KOJPN
call qq D2007288.T133341.BL0KOJZZ
call qq D2007288.T142538.BL0MPJVL
call qq D2007288.T142548.BL0MPRLI
call qq D2007288.T144412.BL0NFW0U
call qq D2007288.T144412.BL0NFW42
call qq D2007288.T144413.BL0NFXAW
call qq D2007288.T144413.BL0NFXE6
call qq D2007288.T151350.BL0OLFIV
call qq D2007288.T151351.BL0OLFND
call qq D2007288.T151351.BL0OLFQ0
call qq D2007288.T151351.BL0OLFUQ
call qq D2007288.T151427.BL0OL8HQ
call qq D2007288.T151427.BL0OL8LY
call qq D2007288.T151427.BL0OL8PJ
call qq D2007288.T151427.BL0OL8UQ
call qq D2007288.T152903.BL0O56UD
call qq D2007288.T152903.BL0O56YP
call qq D2007288.T152903.BL0O563P
call qq D2007288.T152903.BL0O567D
call qq D2007289.T061315.BL1OPK16
call qq D2007289.T061316.BL1OPLDJ
call qq D2007289.T061316.BL1OPLH2
call qq D2007289.T061316.BL1OPLLR
call qq D2007289.T073913.BL1R11Q7
call qq D2007289.T073914.BL1R12BP
call qq D2007289.T073914.BL1R12FA
call qq D2007289.T073914.BL1R12JM
call qq D2007289.T074005.BL1R28H0
call qq D2007289.T074006.BL1R28NE
call qq D2007289.T074006.BL1R28R8
call qq D2007289.T074006.BL1R28WM
call qq D2007289.T092207.BL1V2OAN
call qq D2007289.T092207.BL1V2OQX
call qq D2007289.T092207.BL1V2OVB
call qq D2007289.T092207.BL1V2OYQ
call qq D2007289.T103420.BL1YWDOO
call qq D2007289.T103420.BL1YWDVK
call qq D2007289.T103420.BL1YWDY8
call qq D2007289.T103420.BL1YWD2I
call qq D2007299.T081437.BMIVPQP6
call qq D2007299.T081438.BMIVPRBH
call qq D2007299.T081438.BMIVPROP
call qq D2007299.T081439.BMIVPRTQ
say '************* rz2'
call qq D2007289.T091915.BL1VYRS8
call qq D2007289.T091922.BL1VYWWF
call qq D2007289.T091924.BL1VYYXF
call qq D2007289.T103536.BL1YX3XG
call qq D2007289.T103537.BL1YX32V
call qq D2007289.T103537.BL1YX37Q
call qq D2007289.T103537.BL1YX4C2
call qq D2007289.T103544.BL1YYAI4
call qq D2007289.T103544.BL1YYAOG
call qq D2007289.T103544.BL1YYASM
call qq D2007289.T103544.BL1YYAWW
call qq D2007299.T082822.BMIV8JLK
call qq D2007299.T082823.BMIV8JYB
call qq D2007299.T082823.BMIV8J4K
call qq D2007299.T082823.BMIV8KDK
say '************* rr2'
call qq D2007288.T132646.BL0KE4L8
call qq D2007288.T132658.BL0KFEXK
call qq D2007288.T132704.BL0KFJFR
call qq D2007288.T132709.BL0KFNO4
call qq D2007288.T132845.BL0KHTV5
call qq D2007288.T132848.BL0KHV3X
call qq D2007288.T132851.BL0KHYI3
call qq D2007288.T132854.BL0KH0XK
call qq D2007288.T132959.BL0KJI1T
call qq D2007288.T133003.BL0KJLN2
call qq D2007288.T133006.BL0KJNXS
call qq D2007288.T133008.BL0KJP7N
call qq D2007288.T143347.BL0M0OGF
call qq D2007288.T151709.BL0OPXYQ
call qq D2007289.T074254.BL1R63E1
call qq D2007289.T074304.BL1R7B02
call qq D2007289.T074307.BL1R7D0N
call qq D2007289.T074309.BL1R7FYK
call qq D2007289.T092258.BL1V3UJ2
call qq D2007289.T092302.BL1V3XIO
call qq D2007289.T092305.BL1V3ZNZ
call qq D2007289.T101631.BL1X60ZV
call qq D2007289.T101639.BL1X67AU
call qq D2007289.T103628.BL1YZAR3
call qq D2007289.T103628.BL1YZAYV
call qq D2007289.T103628.BL1YZA5I
call qq D2007289.T121543.BL12UYJI
call qq D2007314.T082933.BM6ZO232
call qq D2007314.T101338.BM63RCCS
call qq D2007314.T101403.BM63RWS0
exit
say 'all' length(m.all) m.all
say 'factor' (7810 / 7626721) '/' (1 / 7810 * 7626721)
stck2utc: procedure
arg stck, rBi /* stck in hex */
/* rBi number of right bit
stck ¢0:51! is microseconds */
sb = x2b(stck) /* hex to binary */
if rBi < 51 then /* cut or fill to 52 bit */
sb = sb || copies(0,51-rBi)
else if rBi > 51 then
sb = left(sb, length(sb) - rBi + 51)
sb = copies(0,(800-length(sb)) // 8) || sb
sd = x2d(b2x(sb))
day = sd % 8.64e10 + date('b', 19000101, 's') /* day 0 is 1.1.1900*/
sec = sd / 1e6 // 8.64e4
r = date('s', day, 'b'),
right(sec % 3600, 2, 0) ,
||right(sec % 60 // 60, 2, 0) ,
||right(sec % 1 // 60 , 2, 0) ,
||'.'||right(sec % 0.000001 // 1000000 , 6, 0)
say stck rBi r
return r
endProcedure stck2utc
qq: procedure expose m.
parse arg 'D' da '.T' ti '.' un
ds = date('s', substr(da, 3), 'j')
da0 = '20041231'
db0 = date('b', da0, 's')
ti0 = 22
uSecs = b2i(z2w(un),35) * 0.001024 + ti0 + 86400 * db0
uBa = uSecs % 86400
uDa = date('s', uBa, 'b')
uTi = uSecs // 86400
uTf = right(uTi % 3600, 2, 0) ,
||right(uTi % 60 // 60, 2, 0) ,
||right(uTi % 1 // 60 , 2, 0) ,
||'.'||right(uTi % 0.001 // 1000 , 3, 0)
say un da ds ti '-->' uDa uTf left('***<>', 5 * ,
(ds <> uDa | ti <> left(uTf, 6)))
return
tc = (left(ti, 2) * 60 + substr(ti, 3, 2)) * 60 + substr(ti,5, 2)
tc = date('b', substr(da, 3), 'j') * 86400 + tc
if symbol('m.t0') ^= 'VAR' then do
m.t0 = tc
m.u0 = uc
m.all = ''
end
do x=1 to length(un)
cc = substr(un, x, 1)
if pos(cc, m.all) < 1 then do
do y=1 to length(m.all) while cc > substr(m.all, y, 1)
end
m.all = left(m.all, y-1) || cc || substr(m.all, y)
end
end
q = left('***<>', 5 * (tc-m.t0 <> uc-m.u0))
say 'ti' ti tc 'un' un uc,
':' right(tc-m.t0,8) right(uc-m.u0, 8) q
return
qq2: procedure expose m.
parse arg 'D' da '.T' ti '.' un
uc = b2i(z2w(un),35) * 4015 % 4405445
uc = b2i(z2w(un),35) * 6898 % 7562833
uc = b2i(z2w(un),35)
hx = trans(i2base(uc*64, 16))
uc = b2i(z2w(un),35) * 7810 % 7626721
uc = trunc(b2i(z2w(un),35) * 0.001024)
tc = (left(ti, 2) * 60 + substr(ti, 3, 2)) * 60 + substr(ti,5, 2)
tc = date('b', substr(da, 3), 'j') * 86400 + tc
if symbol('m.t0') ^= 'VAR' then do
m.t0 = tc
m.u0 = uc
m.all = ''
end
do x=1 to length(un)
cc = substr(un, x, 1)
if pos(cc, m.all) < 1 then do
do y=1 to length(m.all) while cc > substr(m.all, y, 1)
end
m.all = left(m.all, y-1) || cc || substr(m.all, y)
end
end
q = left('***<>', 5 * (tc-m.t0 <> uc-m.u0))
say 'ti' ti tc 'un' un uc,
':' right(tc-m.t0,8) right(uc-m.u0, 8) q
return
ss: procedure
parse arg v, b
say v 'base' b '==>' b2i(v, b)
return
zz: procedure
parse arg v
say v '-- z2w >' z2w(v)
return
tt: procedure
parse arg v, b
r = trans(i2base(v, b))
say v '==>' r 'base' b 'len' length(r)
return
say
i2base: procedure
parse arg v, b
if v < 1 then
return v
res = ''
do while v > 0
res = v // b res
v = v % b
end
return strip(res)
b2i: procedure expose m.
parse arg v, b
r = word(v, 1)
do x = 2 to words(v)
r = r * b + word(v, x)
end
return r
z2w: procedure expose m.
parse arg z
t = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' ,
|| 'abcdefghijklmnopqrstuvwxyz'
t = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'
res = ''
do ix = 1 to length(z)
res = res (pos(substr(z, ix, 1), t)-1)
end
return strip(res)
trans: procedure
parse arg v
t = '0123456789abcdefghijklmnopqrstuvwxyz' ,
|| 'ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/='
res = ''
do x=1 to words(v)
w = word(v, x)
res = res || substr(t, w+1, 1)
end
return res
}¢--- A540769.WK.REXX.O08(J) cre=2007-03-26 mod=2008-09-22-15.38.23 F540769 ----
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jRead: procedure expose m.
parse arg m, var
if m.m.jReading then
interpret oObjMethod(m, 'jRead')
else
call err 'jRead('m',' var') but not opened r'
endProcedure jRead
jWrite: procedure expose m.
parse arg m, line
if m.m.jWriting then
interpret oObjMethod(m, 'jWrite')
else
call err 'jWrite('m',' line') but not opened w'
return
endProcedure jWrite
jWriteAll: procedure expose m.
parse arg m, opt, rdr
interpret oObjMethod(m, 'jWriteAll')
return
endProcedure jWriteAll
jWriteAllImpl: procedure expose m.
parse arg m, opt, rdr
if pos('-', opt) < 1 then
call jOpen rdr, catOpt(opt)
do while jRead(rdr, line)
call jWrite m, m.line
end
if pos('-', opt) < 1 then
call jClose rdr
return
endProcedure jWriteAll
jReset: procedure expose m.
parse arg m, arg
call jClose m
interpret oObjMethod(m, 'jReset')
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret oObjMethod(m, 'jOpen')
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
if m.m.jReading = 1 | m.m.jWriting = 1 then
interpret oObjMethod(m, 'jClose')
m.m.jReading = 0
m.m.jWriting = 0
return m
endProcedure jClose
/*--- analyze an option in oOpt and oVal -----------------------------*/
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jIni: procedure expose m.
if m.j.ini == 1 then
return
m.j.ini = 1
call oIni
call oDecMethods oNewClass("JRW"),
, "jRead call err 'jRead('m',' var') but not opened r'",
, "jWrite call err 'jWrite('m',' line') but not opened w'",
, "jWriteAll call jWriteAllImpl m, opt, rdr",
, "jRead drop m.arg; return 0",
, "jWrite say 'jOut:' line",
, "jReset ;",
, "jOpen ;",
, "jClose ;"
x = oNew("JRW")
m.j.jIn = x
m.x.jReading = 1
m.x.jWriting = 0
x = oNew("JRW")
m.j.jOut = x
m.x.jReading = 0
m.x.jWriting = 1
call oDecMethods oNewClass("Jbuf", "JRW"),
, "jOpen return jBufOpen(m, arg)",
, "jReset return jBufReset(m, arg)",
, "oSetTypePara call jBufSetTypePara m, type",
, "jRead return jBufRead(m, var)",
, "jWrite call jBufWrite m, line"
return
endProcedure jInit
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
/*--- jBuf: buffer read or write (supports datataypes) ---------------*/
jBuf: procedure expose m.
m = oNew('Jbuf')
call jBufReset m
do ax=1 to arg()
m.m.buf.ax = arg(ax)
end
m.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
m.m.stem = m'.BUF'
m.m.buf.0 = 0
call oSetTypePara m
do ax=1 to arg() - 1
m.m.buf.ax = arg(ax+1)
m.m.buf.0 = ax
end
return m
endProcedure jBufReset
jBufSetTypePara: procedure expose m.
parse arg m, type
if m.m.buf.0 <> 0 then
call err 'jBufSetTypePara but not empty'
return
endProcedure jBufSetTypePara
jBufOpen: procedure expose m.
parse arg m, opt
call jClose m
if opt == 'r' then do
m.m.readIx = 0
m.m.jReading = 1
return m
end
if opt == 'w' then
m.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
m.m.jWriting = 1
return m
endProcedure jBufOpen
jBufRead: procedure expose m.
parse arg m, var
nx = m.m.readIx + 1
if nx > m.m.buf.0 then
return 0
m.m.readIx = nx
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.var = m.m.buf.nx
else
call oTyCopy ty, var, m'.BUF.'nx
return 1
endProcedure jBufRead
jBufWrite: procedure expose m.
parse arg m, line
nx = mInc(m'.BUF.0')
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.m.buf.nx = line
else
call oTyCopy ty, m'.BUF.'nx, line
return 1
endProcedure jBufRead
/* copy j end *********************************************************/
}¢--- A540769.WK.REXX.O08(JTESTER) cre=2007-01-29 mod=2007-05-10-17.37.56 F540769 ---
m.jTest.act = ''
call jTestCat
call jTestEnv
call jTestBar
call jTestEnv
call jTestBar
call jTestCat
call jTestJ
call jTestJTest
call jTestDsn
call jTestJ 0
call jTestJTest
call jTestScan
call jTestScanWin
call jTestDsn
call jTestTotal
call jTestJ 0
call jTestJTest
call jTestScan
call jTestScanWin
call jTestTotal
exit
jTestJ: procedure expose m.
parse arg fail
say 'jTestJ test J and implicitely M without jTest with fail' fail
call envInit
call jOut 'out eins'
do lx=1 by 1 while jIn(var)
call jOut lx 'jIn()' m.var
end
call jOut 'jIn()' (lx-1) 'reads'
b = jOpen(jBuf(), 'w')
call jWrite b, 'buf line one'
call mAdd jBufStem(b), 'buf line two', 'buf line three'
call jWrite b, 'buf line four'
call jOpen b, 'r'
do while (jRead(b, line))
call jOut 'line' m.line
end
call jClose b
c = jBuf()
call envPush env('<£', b, '>£', c)
call jOut 'before readWrite 1 b --> c'
call utReadWrite
call jOut 'nach readWrite 1 b --> c'
call envPop
if fail = 1 then
call jWrite c, 'write nach pop'
call mAdd jBufStem(c), 'add nach pop'
call envPush env('<£', c)
call jOut 'before readWrite 2 c --> std'
call utReadWrite
call jOut 'nach readWrite 2 c --> std'
call envPop
if fail = 2 then
call jClose m.j.jOut
return
endProcedure jTestJ
jTestJTest: procedure expose m.
call jInit
jt = jNew()
c = jBuf()
call jTest jt, 'jTestJ',
, "jOut: out eins",
, "jIn 1: jTest in line 1 eins ,",
, "jOut: 1 jIn() jTest in line 1 eins ,",
, "jIn 2: jTest in line 2 zwei ; ",
, "jOut: 2 jIn() jTest in line 2 zwei ; ",
, "jIn 3: jTest in line 3 drei |",
, "jOut: 3 jIn() jTest in line 3 drei |",
, "jIn eof 4",
, "jOut: jIn() 3 reads",
, "jOut: line buf line one",
, "jOut: line buf line two",
, "jOut: line buf line three",
, "jOut: line buf line four",
, "jErr: write("c") when closed"
stdOut = m.env.env.1
stdOut = m.env.stdOut.out
call jTestAdd jT, ,
, "jOut: before readWrite 2 c --> std",
, "jOut: before readWrite 1 b --> c",
, "jOut: buf line one",
, "jOut: buf line two",
, "jOut: buf line three",
, "jOut: buf line four",
, "jOut: nach readWrite 1 b --> c",
, "jOut: add nach pop",
, "jOut: nach readWrite 2 c --> std",
, "jErr: do not jCLOSE("stdOut", ) base stdIn/stdOut"
call jOut 'out eins'
do lx=1 by 1 while jIn(var)
call jOut lx 'jIn()' m.var
end
call jOut 'jIn()' (lx-1) 'reads'
b = jOpen(jBuf(), 'w')
call jWrite b, 'buf line one'
call mAdd jBufStem(b), 'buf line two', 'buf line three'
call jWrite b, 'buf line four'
call jOpen b, 'r'
do while (jRead(b, line))
call jOut 'line' m.line
end
call jClose b
call envPush env('<£', b, '>£', c)
call jOut 'before readWrite 1 b --> c'
call utReadWrite
call jOut 'nach readWrite 1 b --> c'
call envPop
say 'jWrite' c
call jWrite c, 'write nach pop'
call mAdd jBufStem(c), 'add nach pop'
call envPush env('<£', c)
call jOut 'before readWrite 2 c --> std'
call utReadWrite
call jOut 'nach readWrite 2 c --> std'
call envPop
call jClose stdOut
call jTestEnd jt
return
endProcedure jTestJTest
jTestScan: procedure expose m.
call jInit
t = jNew()
call jTest t, 'jTestScan.1',
, "jOut: scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo'",
|| "'s' ",
, "jOut: scan name tok a034 key val ",
, "jOut: scan char tok , key val ",
, "jOut: scan name tok Und key val ",
, "jOut: scan space 1 tok key val ",
, "jOut: scan name tok hr123sdfER key val ",
, "jOut: scan string quo tok ""st1"" key val st1",
, "jOut: scan space 1 tok key val ",
, "jOut: scan string apo tok 'str2''mit''apo''s' key val str",
|| "2'mit'apo's",
, "jOut: scan space 4 tok key val "
call jSc1 ,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call jTestEnd t
call jTest t, 'jTestScan.2',
, "jOut: scan src litEinsefr 23 sdfER'str1'litZwei ""str2""""",
|| "mit quo""s ",
, "jOut: scan literal tok litEins key val ",
, "jOut: scan name tok efr key val ",
, "jOut: scan space 1 tok key val ",
, "jOut: scan number tok 23 key val ",
, "jOut: scan space 1 tok key val ",
, "jOut: scan name tok sdfER key val ",
, "jOut: scan string apo tok 'str1' key val str1",
, "jOut: scan literal tok litZwei key val str1",
, "jOut: scan space 1 tok key val ",
, "jOut: scan string quo tok ""str2""""mit quo"" key val str",
|| "2""mit quo",
, "jOut: scan name tok s key val str2""mit quo",
, "jOut: scan space 1 tok key val "
call jSc1 ,"litEinsefr 23 sdfER'str1'litZwei ""str2""""mit quo""s "
call jTestEnd t
call jTest t, 'jTestScan.3',
, "jOut: scan src aha;+-=f ab=cdEf eF='strIng' ",
, "jOut: scan keyValue tok no= key aha val def",
, "jOut: scan char tok ; key aha val ",
, "jOut: scan char tok + key aha val ",
, "jOut: scan char tok - key aha val ",
, "jOut: scan char tok = key aha val ",
, "jOut: scan keyValue tok no= key f val def",
, "jOut: scan keyValue tok cdEf key ab val cdEf",
, "jOut: scan keyValue tok 'strIng' key eF val strIng"
call jSc1 'kv def'," aha;+-=f ab=cdEf eF='strIng' "
call jTestEnd t
call jTest t, 'jTestScanReader',
, "jOut: name erste",
, "jOut: space",
, "jOut: name Zeile",
, "jOut: space",
, "jOut: nextLine",
, "jOut: nextLine",
, "jOut: space",
, "jOut: name dritte",
, "jOut: space",
, "jOut: name Zeile",
, "jOut: space",
, "jOut: name schluss",
, "jOut: space"
b = jBuf('erste Zeile ',,' dritte Zeile schluss ')
call jOpen b, 'r'
call scanReader s, b
do while ^scanAtEnd(s)
if scanName(s) then call jOut 'name' m.tok
else if scanVerify(s, ' ') then call jOut 'space'
else if scanNL(s) then call jOut 'nextLine'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
end
call jTestEnd t
call jTest t, 'jTestScanReader mit spaceLn',
, "jOut: name erste",
, "jOut: spaceLn",
, "jOut: name Zeile",
, "jOut: spaceLn",
, "jOut: name dritte",
, "jOut: spaceLn",
, "jOut: name Zeile",
, "jOut: spaceLn",
, "jOut: name schluss",
, "jOut: spaceLn"
call jOpen b, 'r'
call scanReader s, b
do forever
if scanName(s) then call jOut 'name' m.tok
else if scanSpaceNL(s) then call jOut 'spaceLn'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
else leave
end
call jTestEnd t
return
endProcedure jTestScan
/*--- one single test scan with lines to scan in stem ln -------------*/
jSc1:
parse arg fun def, ln
call jOut 'scan src' ln
call scanLine s, ln
do while ^scanAtEnd(s)
o = ''
if fun == 'kv' then do
if scanKeyValue(scanSkip(s), def) then o = 'keyValue '
else if scanAtEnd(s) then leave
end
else do
if scanLit(s, 'litEins') then o = 'literal '
else if scanLit(s, 'litZwei') then o = 'literal '
else if scanName(s) then o = 'name '
end
if o ^== '' then nop
else if scanString(s) then o = 'string apo'
else if scanString(s, '"') then o = 'string quo'
else if scanNat(s) then o = 'number '
else if scanVerify(s, ' ') then o = 'space' length(m.tok)
else if scanChar(s,1) then o = 'char '
else call scanErr s, 'not scanned'
call jOut 'scan' o 'tok' m.tok 'key' m.key ,
'val' m.val
end
return
endProcedure jSc1
jTestScanWin: procedure expose m.
call jInit
t = jNew()
call mAdd t'.'comp, 'eins', 'zwei', 'dreiVierFuenfSechsn',
, 'sieben', 'acht'
call jTest t, 'jTestScanWin',
, "jOut: scanWindwow cut 1 lines 41",
, "jOut: scanWindwow cut 2 lines 22",
, "jOut: scanWindwow cut 3 lines 15",
, "jOut: scanWindwow cut 4 lines 12",
, "jOut: scanWindwow cut 5 lines 10",
, "jOut: scanWindwow cut 6 lines 8",
, "jOut: scanWindwow cut 7 lines 8",
, "jOut: scanWindwow cut 8 lines 7",
, "jOut: scanWindwow cut 9 lines 7",
, "jOut: scanWindwow cut 10 lines 6",
, "jOut: scanWindwow cut 11 lines 5",
, "jOut: scanWindwow cut 12 lines 5"
do cc=1 to 12
call jScWi t, cc, "eins zwei dreiVierFuenfSechsn",
, ,"sieben acht"
end
call jTestEnd t
call jTest t, 'jTestScanWinCom' ,
, "jOut: scanWindwow cut 15 lines 5"
call jScWi t, 15,"eins %% 012345zwei dreiVierFuenfSechsn%%234",
"sieben %% 789 acht %% 234"
call jTestEnd t
return
endProcedure jTestScanWin
jScWi: procedure expose m.
parse arg t, cc
b = jOpen(jBuf(), 'r')
do ax=3 to arg()
aa = arg(ax)
if aa == '' then
aa = ' '
do cx=1 by cc to length(aa)
call mAdd jBufStem(b), substr(aa, cx, cc)
end
end
call scanWindow s, b, cc, (20%cc)+1
call scanOptions s, , , '%%'
call jOut 'scanWindwow cut' cc 'lines' mSize(jBufStem(b))
qx = 0
do forever
call scanSpaceNl s
if scanName(s) then do
qx = qx + 1
if m.tok ^== m.t.comp.qx then
call jOut 'scanned' m.tok 'but expected' m.t.comp.qx
end
else do
if ^ scanAtEnd(s) then
call scanErr s, 'could not scan'
if qx <> m.t.comp.0 then
call jOut 'scanned' qx 'name, but expected' m.t.comp.0
leave
end
end
call scanInit s
return
endProcedure jScWi
jTestDsn: procedure expose m.
call jInit
t = jNew()
call jTest t, 'jTestDsn',
, "jOut: ok write read 1 lines",
, "jOut: ok write read 2 lines",
, "jOut: ok write read 0 lines",
, "jOut: ok write read 55 lines",
, "jOut: ok write read 99 lines",
, "jOut: ok write read 100 lines",
, "jOut: ok write read 101 lines",
, "jOut: ok write read 201 lines",
, "jOut: ok write read 399 lines",
, "jOut: ok write read 300 lines",
, "jOut: ok write read 2000 lines",
, "jOut: ok write read 999 lines",
, "jOut: ok write read 3001 lines",
, "jOut: ok write read 0 lines"
d = jDsn('~TMP.TEXT(TTTEINS)')
call jTestWriteRead d, 1
call jTestWriteRead d, 2
call jTestWriteRead d, 0
call jTestWriteRead d, 55
call jTestWriteRead d, 99
call jTestWriteRead d, 100
call jTestWriteRead d, 101
call jTestWriteRead d, 201
call jTestWriteRead d, 399
call jTestWriteRead d, 300
call jTestWriteRead d,2000
call jTestWriteRead d, 999
call jTestWriteRead d,3001
call jTestWriteRead d, 0
call jTestEnd t
return
endProcedure jTestDsn
jTestWriteRead: procedure expose m.
parse arg f, cnt
call jOpen f, 'w'
pre = 'jTEstReadWrite' date() time(l) 'line'
do x=1 to cnt
call jWrite f, pre x
end
call jOpen f, 'r'
do y=1 while jRead(f, var)
if m.var <> pre y then
call jOut 'read mismatch line' y':' m.var
end
call jClose f
y = y - 1
if cnt = y then
call jOut 'ok write read' cnt 'lines'
else
call jOut 'mismatch written' cnt 'but read' y 'lines'
return
endProcedure jTestWriteRead
jTestBar: procedure expose m.
call envInit
t = jNew()
call jTest t, 'jTestBar',
, "jOut: +0 vor envBarBegin",
, "jIn 1: jTest in line 1 eins ,",
, "jIn 2: jTest in line 2 zwei ; ",
, "jIn 3: jTest in line 3 drei |",
, "jIn eof 4",
, "jOut: +7 nach envBarLast",
, "jOut: ¢7 +6 nach envBar 7!",
, "jOut: ¢7 +2 nach envBar 7!",
, "jOut: ¢7 +4 nach nested envBarLast 7!",
, "jOut: ¢7 (4 +3 nach nested envBarBegin 4) 7!",
, "jOut: ¢7 (4 (3 +1 nach envBarBegin 3) 4) 7!",
, "jOut: ¢7 (4 (3 jTest in line 1 eins , 3) 4) 7!",
, "jOut: ¢7 (4 (3 jTest in line 2 zwei ; 3) 4) 7!",
, "jOut: ¢7 (4 (3 jTest in line 3 drei | 3) 4) 7!",
, "jOut: ¢7 (4 (3 +1 nach readWrite vor envBar 3) 4) 7!",
, "jOut: ¢7 (4 +3 nach preSuf vor nested envBarLast 4) 7!",
, "jOut: ¢7 +4 nach preSuf vor nested envBarEnd 7!"
call jTestAdd t, ,
, "jOut: ¢7 +5 nach nested envBarEnd vor envBar 7!",
, "jOut: ¢7 +6 nach readWrite vor envBarLast 7!",
, "jOut: +7 nach readWrite vor envBarEnd",
, "jOut: +8 nach envBarEnd"
call jOut '+0 vor envBarBegin'
call envBarBegin
call jOut '+1 nach envBarBegin'
call utReadWrite
call jOut '+1 nach readWrite vor envBar'
call envBar
call jOut '+2 nach envBar'
call envBarBegin
call jOut '+3 nach nested envBarBegin'
call utPreSuf '(3 ', ' 3)'
call jOut '+3 nach preSuf vor nested envBarLast'
call envBarLast
call jOut '+4 nach nested envBarLast'
call utPreSuf '(4 ', ' 4)'
call jOut '+4 nach preSuf vor nested envBarEnd'
call envBarEnd
call jOut '+5 nach nested envBarEnd vor envBar'
call envBar
call jOut '+6 nach envBar'
call utReadWrite
call jOut '+6 nach readWrite vor envBarLast'
call envBarLast
call jOut '+7 nach envBarLast'
call utPreSuf '¢7 ', ' 7!'
call jOut '+7 nach readWrite vor envBarEnd'
call envBarEnd
call jOut '+8 nach envBarEnd'
call jTestEnd t
return
endProcedure jTestBar
jTestEnv: procedure
call envInit
t = jNew()
call jTest t, 'jTestEnv',
, "jOut: 1. test out",
, "jOut: 2. test write",
, "jIn 1: input einsA",
, "jOut: test read r1 1 : input einsA",
, "jIn eof 2",
, "jOut: test read r2 0 : M.R2",
, "jOut: envIsDefined(v1) false",
, "jOut: envIsDefined(v1) value of variable ""v1""",
, "jOut: 3. normaler Schluss"
call jTestAdd t, 'i0', "input einsA"
call jTestWrite t, "1. test out"
call jOut "2. test write"
call jOut "test read r1 " jIn(r1) ":" m.r1
call jOut "test read r2 " jIn(r2) ":" m.r2
if envIsDefined('v1') then
call jOut "envIsDefined(v1)" envGet('v1')
else
call jOut "envIsDefined(v1) false"
call envPut 'v1', 'value of variable "v1"'
if envIsDefined('v1') then
call jOut "envIsDefined(v1)" envGet('v1')
else
call jOut "envIsDefined(v1) false"
call jTestWrite t, "3. normaler Schluss"
call jTestEnd t
return
endProcedure jTestEnv
jTestCat: procedure
call envInit
tst = date('o') time()
t = jNew()
fn = '~test.shell'
call jTest t, 'jTestCat',
, "jOut: read aa 1 <zeile eins" tst " ",
|| " >",
, "jOut: read aa 2 <zeile zwei" tst " ",
|| " >",
, "jOut: read #buf 0 M.BLI",
, "jOut: read #buf b 1 <#buf eins" tst">",
, "jOut: read #buf b 2 <#buf zwei" tst">",
, "jOut: read bb 1 <zeile eins" tst " ",
|| " >",
, "jOut: read bb 2 <zeile zwei" tst " ",
|| " >",
, "jOut: read bb 3 <buffer 1. Zeile>",
, "jOut: read bb 4 <buffer 2.>",
, "jOut: read bb 5 <zeile eins" tst " ",
|| " >",
, "jOut: read bb 6 <zeile zwei" tst " ",
|| " >",
, "jOut: read bb 7 <#buf eins" tst">",
, "jOut: read bb 8 <#buf zwei" tst">",
, "jOut: read bb 8 lines"
c1 = cat(fn'(eins)')
call jOpen c1, 'w'
call jWrite c1, 'zeile eins' tst
call jWrite c1, 'zeile zwei' tst
call jClose c1, 'zeile drei' tst 'schluss'
call jOpen c1, 'r'
do lx=1 while jRead(c1, li)
call jOut 'read aa' lx '<'m.li'>'
end
call jClose c1
c2 = cat('#buf')
call jOpen c2, 'r'
call jOut 'read #buf' jRead(c2, bli) m.bli
call jOpen c2, 'w'
call jWrite c2, '#buf eins' tst
call jWrite c2, '#buf zwei' tst
call jOpen c2, 'r'
do lx=1 while jRead(c2, li)
call jOut 'read #buf b' lx '<'m.li'>'
end
call catReset c2, fn'(eins)'
call catAdd c2, "-£", jBuf("buffer 1. Zeile", "buffer 2.")
call catAdd c2, "-£", c1, "-", "#buf"
call jOpen c2, 'r'
do lx=1 while jRead(c2, li)
call jOut 'read bb' lx '<'m.li'>'
end
call jClose c2
call jOut 'read bb' (lx-1) 'lines'
call jTestEnd t
return
endProcedure jTestCat
err:
if m.jTest.act == '' then
call errA arg(1), 1
else
call jTestOut m.jTest.act, 'jErr:' arg(1)
return
endSubroutine err
/* copy ut begin ****************************************************
***********************************************************************/
utReadWrite: procedure expose m.
parse arg i, o
if i == '' then
i = m.j.jIn
if o == '' then
o = m.j.jOut
do while (jRead(i, line))
call jWrite o, m.line
end
return
endProcedure utReadWrite
utPreSuf: procedure expose m.
parse arg pre, suf
do while (jIn(line))
call jOut pre || m.line || suf
end
return
endProcedure utReadWrite
/* copy ut end ****************************************************/
/* copy cat begin ****************************************************
***********************************************************************/
catMakeOpen: procedure expose m.
parse arg opt, spec, defDsn
if right(opt, 1) = "£" then do
rw = spec
opt = left(opt, length(opt)-1)
end
else if left(spec, 1) == '#' then do
if envIsDefined(spec) then
rw = envGet(spec)
else
rw = envPut(spec, jBuf())
end
else if defDsn == '' then do
rw = jDsn(spec)
end
else do
rw = jReset(defDsn, spec)
end
if pos('-', opt) < 1 then
call jOpen rw, opt
return rw
endProcedure catMakeOpen
cat: procedure expose m.
m = jNew()
call catClose m
call jDefine m, "cat"
m.cat.m.defDsn = jDsn()
do ax=1 to arg()
m.cat.m.ax = arg(ax)
end
m.cat.m.0 = ax-1
return m
endProcedure cat
catReset: procedure expose m.
parse arg m
call catClose m
do ax=2 to arg()
bx=ax-1
m.cat.m.bx = arg(ax)
end
m.cat.m.0 = bx
return m
endProcedure catReset
catAdd: procedure expose m.
parse arg m
if m.cat.m.rdr ^== '' | m.cat.m.wrtr ^== '' then
call err 'catAdd but opened'
bx = m.cat.m.0
do ax=2 to arg()
bx=bx+1
m.cat.m.bx = arg(ax)
end
m.cat.m.0 = bx
return
endProcedure catAdd
catClose: procedure expose m.
parse arg m
if m.cat.m.rdr ^== '' & pos('-', m.cat.m.opt) < 1 then
if symbol('m.cat.m.rdr') == 'VAR' then
call jClose m.cat.m.rdr
m.cat.m.rdr = ''
m.cat.m.rdrIx = 'closed'
m.cat.m.opt = ''
if m.cat.m.wrtr ^== '' & pos('-', m.cat.m.opt) < 1 then
if symbol('m.cat.m.wrtr') == 'VAR' then
call jClose m.cat.m.wrtr
m.cat.m.wrtr = ''
return
endProcedure catClose
catOpen: procedure expose m.
parse arg m, oo
call catClose m
m.cat.m.opt = oo
m.cat.m.rdrIx = 0
if oo = 'r' then do
m.cat.m.rdr = catNextRW(m)
call jDefRead m, "res = catRead(m , arg)"
end
else if oo ^== 'w' & oo ^== 'a' then do
call err 'catOpen bad opt' opt
end
else do
m.cat.m.wrtr = catNextRW(m)
if m.cat.m.wrtr == '' then
call err 'catOpen no writer found'
m.cat.m.rdrIx = 'writing'
call jDefWrite m, "call catWrite m , arg"
end
return
endProcedure catOpen
catNextRW: procedure expose m.
parse arg m
cx = m.cat.m.rdrIx
oo = m.cat.m.opt
do cx=cx+1 to m.cat.m.0
if jOpt(m.cat.m.cx, 'rwa-£') then do
if pos(left(m.j.oOpt, 1), 'rwa') > 0 then
oo = left(oo, 1)substr(m.j.oOpt, 2)
else
oo = left(oo, 1)m.j.oOpt
end
else do
m.cat.m.rdrIx = cx
m.cat.m.opt = oo
return catMakeOpen(oo, m.cat.m.cx, m.cat.m.defDsn)
end
end
m.cat.m.rdrIx = cx
return ''
endProcedure catNextRw
catRead: procedure expose m.
parse arg m, arg
do while m.cat.m.rdr ^== ''
if jRead(m.cat.m.rdr, arg) then
return 1
call jClose m.cat.m.rdr
m.cat.m.rdr = catNextRW(m)
end
if ^ dataType(m.cat.m.rdrIx, 'n') then
call err 'catRead but' m.cat.m.rdrIx
return 0
endProcedure catRead
catWrite: procedure expose m.
parse arg m, arg
if m.cat.m.wrtr == '' then
call err 'catWrite without open for write'
call jWrite m.cat.m.wrtr, arg
return
endProcedure catWrite
/* copy cat end ****************************************************/
/* copy env begin ******************************************************
***********************************************************************/
env: procedure expose m.
nn = envReset(jNew())
do ax=1 by 2 to arg()-1
call envAddIo nn, arg(ax), arg(ax+1)
end
return nn
endProcedure env
envReset: procedure expose m.
parse arg m
call envClose m
m.env.m.in = ''
m.env.m.out = ''
m.env.m.doClose = ''
do ax=2 by 2 to arg()-1
call envAddIo m, arg(ax), arg(ax+1)
end
return m
endProcedure envReset
envClose: procedure expose m.
parse arg m
if symbol('m.env.m.doClose') == 'VAR' then
interpret m.env.m.doClose
m.env.m.doClose = ''
m.env.m.lastCat = ''
m.env.m.lastExt = ''
return m
endProcedure envClose
envAddIO: procedure expose m.
parse arg m, opt, spec
contX = pos("+", opt)
if contX > 0 then do
opt = left(opt, contX-1)substr(opt,contX+1)
contX = 1
end
if left(opt, 1) == '&' then do
if m.env.m.lastCat ^== '' then
call err 'envAddIO('opt',' spec') external within cat'
if m.env.m.lastExt ^== '' then
call err 'envAddIO('opt',' spec') external within ext'
m.env.m.lastExt = opt || spec
end
else if (contX | m.env.m.lastCat ^== '') then do
if left(opt, 1) ^== '<' then
call err 'envAddIO('opt',' spec') concat but not input'
if m.env.m.lastCat == '' then
m.env.m.lastCat = catNew(mNew())
call catAdd m.env.m.lastCat m, opt, spec
end
if ^ contX then do
if m.env.m.lastCat ^== '' then do
v = 'ro'
spec = m.env.m.lastCat
m.env.m.lastCat = ''
end
else do
v = env2opt(opt)
end
if m.env.m.lastExt ^== '' then do
nn = extFdNew(jNew(), m.env.m.lastExt, v, spec)
m.env.m.lastExt = ''
end
else do
nn = catMakeOpen(v, spec)
if left(v, 1) == 'r' then do
if m.env.m.in ^== '' then
call err 'addIo('opt',' spec') duplicate stdIn'
m.env.m.in = nn
end
else do
if m.env.m.out ^== '' then
call err 'addIo('opt',' spec') duplicate stdOut'
m.env.m.out = nn
end
end
m.env.m.doClose = m.env.m.doClose '; call jClose "'nn'"'
end
return m
endProcedure envAddIO
envLink: procedure expose m.
parse arg m, old
if m.env.m.lastCat ^== '' then
call err 'envLink with open cat'
if m.env.m.in == '' then
m.env.m.in = m.env.old.in
if m.env.m.out == '' then
m.env.m.out = m.env.old.out
return m
endProcedure envLink
envPut: procedure expose m.
parse arg na, va
m.env.var.na = va
return va
endProcedure envPut
envIsDefined: procedure expose m.
parse arg na
return symbol('m.env.var.na') == 'VAR'
endProcedure envIsDefined
envGet: procedure expose m.
parse arg na
if symbol('m.env.var.na') ^== 'VAR' then
call err 'envGet('na') undefined name'
return m.env.var.na
endProcedure envGet
envRemove: procedure expose m.
parse arg na
drop m.env.var.na
return
endProcedure envRemove
env2opt: procedure
parse arg o1 2 oR
if o1 == '<' then
return 'r' || oR
else if o1 ^== '>' then
return o1 || oR
else if left(oR, 1) == '>' then
return 'a' || substr(oR, 2)
else
return 'w' || oR
endProcedure env2opt
envInit: procedure expose m.
call jInit
m.env.env.0 = 1
ex = env()
m.env.env.1 = ex
m.env.ex.in = m.j.jIn
m.env.ex.out = m.j.jOut
m.env.val.0 = 0
return
endProcedure
envPush: procedure expose m.
parse arg e
ex = m.env.env.0
call envLink e, m.env.env.ex
ex = ex + 1
m.env.env.0 = ex
m.env.env.ex = e
m.j.jIn = m.env.e.in
m.j.jOut = m.env.e.out
return e
endProcedure envPush
envPop: procedure expose m.
ox = m.env.env.0
if ox <= 1 then
call err 'envPop on empty stack' ox
call envClose m.env.env.ox
ex = ox - 1
m.env.env.0 = ex
e = m.env.env.ex
m.j.jIn = m.env.e.in
m.j.jOut = m.env.e.out
return m.env.env.ox
endProcedure envPop
envBarBegin: procedure expose m.
call envPush env('>£', jBuf())
return
endProcedure envBarBegin
envBar: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.env.oldEnv.out, '>£', jBuf())
return
endProcedure envBar
envBarLast: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.env.oldEnv.out)
return
endProcedure envBarLast
envBarEnd: procedure expose m.
oldEnv = envPop()
return
endProcedure envBarEnd
/* copy env end *******************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanReader(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
m.scan.m.pos = 1
if symbol('m.scan.m.name') ^== 'VAR' then
call scanInit m
return m
endProcedure scanLine
/*--- switch to next line if atEnd of line or unCond=1 ---------------*/
scanNL: procedure expose m.
parse arg m, unCond
if m.scan.m.reading then do
interpret m.scan.m.scanNl
end
else do
np = 1 + length(m.scan.m.src)
if np <= m.scan.m.pos then
return 0
if unCond == 1 then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' ,
& abbrev(m.scan.m.src, m.scan.m.comment) then nop
else
return 0
m.scan.m.pos = np
return 1
end
endProcedure scanNL
scanAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.reading then
interpret m.scan.m.scanAtEnd
else
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEnd
/*--- initialize scanner for m --------------------------------------*/
scanInit: procedure expose m.
parse arg m, rdng
m.scan.m.reading = rdng == 1
m.tok = ''
m.val = ''
m.key = ''
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
return
endProcedure scanInit
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, m.scan.m.comment
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanInit m
if nameOne ^== '' then do
m.scan.m.Name1 = nameOne
m.scan.m.name = m.scan.m.name1 || '0123456789'
end
if namePlus ^== '' then
m.scan.m.name = m.scan.m.name1 || namePlus
return
endProcedure scanOptions
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
return substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
m.tok = scanLook(m, len)
m.scan.m.pos = m.scan.m.pos + length(m.tok)
return length(m.tok) > 0
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
ScanNat: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok 'scanPosition' ,
strip(left(substr(m.scan.m.src, m.scan.m.pos), 40), 't')
if m.scan.m.reading then
interpret 'say " "' m.scan.m.scanLinePos
else
say ' pos' m.scan.m.Pos 'in string' strip(m.scan.m.src, 't')
call err 'scanErr' txt
return
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
res = 0
do forever
if scanVerify(m, ' ') then nop
else if ^ scanNL(m) then leave
res = 1
end
m.tok = lastTok
return res
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- begin scanning the lines of a reader ---------------------------*/
scanReader: procedure expose m.
parse arg m, m.scan.m.rdr
call scanInit m, 1
m.scan.m.atEnd = 0
m.scan.m.lineX = 0
m.scan.m.scanNl = 'return scanReaderNl(m, unCond)'
m.scan.m.scanAtEnd = 'return scanReaderAtEnd(m, what)'
m.scan.m.scanLinePos = "scanReaderLinePos(m)"
call scanReaderNl m, 1
return m
endProcedure scanReader
/*--- return true/false whether we are at the end of line / reader ---*/
scanReaderAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if what == 'l' then
return 1
return m.scan.m.atEnd
endProcedure scanReaderAtEnd
scanReaderNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then nop
else if unCond ^= 2 & m.scan.m.pos > length(m.scan.m.src) then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' ,
& abbrev(m.scan.m.src, m.scan.m.comment) then nop
else
return 0
if m.scan.m.atEnd then
return 0
m.scan.m.atEnd = ^ jRead(m.scan.m.rdr, 'SCAN.'m'.SRC')
if m.scan.m.atEnd then do
m.scan.m.pos = 1 + length(m.scan.m.src)
end
else do
m.scan.m.pos = 1
m.scan.m.lineX = m.scan.m.lineX + 1
end
return ^ m.scan.m.atEnd
endProcedure scanReaderNL
scanReaderLinePos: procedure expose m.
parse arg m
if m.scan.m.atEnd then
qq = 'atEnd after'
else
qq = 'pos' m.scan.m.pos 'in'
return qq 'line' m.scan.m.lineX':' strip(m.scan.m.src, 't')
endProcedure scanReaderLinePos
/* copy scan end ****************************************************/
/* copy scanWin begin *************************************************
scan the the concatenation of the lines of a reader
any token my be split over several line
except the end-of-line-comment-token
***********************************************************************/
/*--- begin scanning the lines of a reader
by concatenating them together in window -----------------------*/
scanWindow: procedure expose m.
parse arg m, m.scan.m.rdr, m.scan.m.winCut, m.scan.m.winSz
call scanInit m, 1
m.scan.m.winML = (2 * m.scan.m.winSz + 1) * m.scan.m.winCut
m.scan.m.atEnd = 0
m.scan.m.lineX = 0
m.scan.m.scanNl = 'return scanWinNl(m, unCond)'
m.scan.m.scanAtEnd = 'return scanWinAtEnd(m, what)'
m.scan.m.scanLinePos = "scanWinLinePos(m)"
call scanLine m, ''
call scanWinNl m, 1
return m
endProcedure scanReader
/*--- return true/false whether we are at the end of line / reader ---*/
scanWinAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.pos > length(m.scan.m.src) then do
if m.scan.m.atEnd then
return 1
else
call scanErr m, 'out of window'
end
return 0
endProcedure scanReaderAtEnd
scanWinNL: procedure expose m.
parse arg m, unCond
ps = m.scan.m.pos
cut = m.scan.m.winCut
res = 0
if ps > length(m.scan.m.src) then do
if m.scan.m.atEnd then
return 0
if m.scan.m.src ^== '' then
call scanErr m, 'out of window'
end
else do
nl = ps + cut - ((ps-1) // cut)
if unCond == 1 then
res = 1
else if unCond ^= 0 & m.scan.m.comment ^== '' ,
& length(m.scan.m.comment) <= nl - ps then
res = abbrev(substr(m.scan.m.src, ps), m.scan.m.comment)
if res then
ps = nl
end
if m.scan.m.atEnd then do
m.scan.m.pos = ps
return res
end
if ps > cut * m.scan.m.winSz then do
ll = (ps-1) % cut
m.scan.m.src = substr(m.scan.m.src, 1 + ll * cut)
ps = ps - (ll * cut)
m.scan.m.lineX = m.scan.m.lineX + ll
end
do while length(m.scan.m.src) < m.scan.m.winML
m.scan.m.atEnd = ^ jRead(m.scan.m.rdr, r1)
if m.scan.m.atEnd then
leave
m.scan.m.src = m.scan.m.src || left(m.r1, cut)
end
m.scan.m.pos = ps
return res
endProcedure scanWinNL
scanWinLinePos: procedure expose m.
parse arg m
ps = m.scan.m.pos
cut = m.scan.m.winCut
if ps > length(m.scan.m.src) then do
lx = (length(m.scan.m.src) - 1) % cut
msg = 'after'
if m.scan.m.atEnd then
msg = 'atEnd' msg
end
else do
lx = (ps - 1) % cut
msg = 'pos' (ps - (lx*cut)) 'at'
end
return msg 'line' (m.scan.m.lineX+lx+1)':' ,
strip(substr(m.scan.m.src, lx*cut+1, cut), 't')
endProcedure scanWinLinePos
/* copy scanWin end *************************************************/
/* copy jTest begin ****************************************************
test infrastructure
***********************************************************************/
/*--- return stems ---------------------------------------------------*/
jTestAdd: procedure expose m.
parse arg m, wh
st = 'JTEST.'m
if pos('i', wh) > 0 then
st = st'.IN'
if pos('0', wh) > 0 then
sx = 0
else
sx = m.st.0
do ax=3 to arg()
sx = sx+1
m.st.sx = arg(ax)
end
m.st.0 = sx
return st
endProcedure jTestAdd
/*--- make writerDescriptor m a testWriter
--- and use remaining lines as compare values -----------------*/
jTest: procedure expose m.
parse arg m, name
m.jTest.m = name
m.jTest.act = m
ox = 1
m.jTest.m.ox = left('****** start jTest' name '', 79, '*')
do ax=3 to arg()
ox = ox + 1
m.jTest.m.ox = arg(ax)
end
m.jTest.m.0 = ox
m.jTest.m.in.0 = 0
call mAdd jTest'.'m'.IN', 'jTest in line 1 eins ,' ,
, 'jTest in line 2 zwei ; ',
, 'jTest in line 3 drei |'
call jDefine m, 'jTest'
call jDefine m'jIn', 'jTest'
if m.env.env.0 <> 1 then
call jTestErr m, 'm.env.env.0' m.env.env.0 '<> 1'
call envPush env( '<£', m'jIn', '>£', m)
call jTestOut m, m.jTest.m.1
return 'JTEST.'m
endProcedure jTest
jTestOpen: procedure expose m.
parse arg m, opt
if opt = 'r' then do
if right(m, 3) ^== 'jIn' then
call err 'jTestOpen' m',' opt
mw = left(m, length(m)-3)
call jDefRead m, 'res = jTestRead("'mw'", arg)'
m.jTest.mw.inIx = 0
end
else if opt = 'w' then do
call jDefWrite m, 'call jTestWrite m, arg'
m.jTest.m.out.0 = 0
m.jTest.m.err = 0
if symbol("m.jTest.err") ^= 'VAR' then
m.jTest.err = 0
end
else
call err 'bad opt jTestOpen('m',' opt')'
return m
endProcedure jTestOpen
jTestClose:
return arg(1)
endProcedure jTestClose
jTestEnd: procedure expose m.
parse arg m, opt
call envPop
m.jTest.act = ''
if m.env.env.0 <> 1 then
call jTestErr m, 'm.env.env.0' m.env.env.0 '<> 1'
if m.jTest.m.out.0 ^= m.jTest.m.0 then do
call jTestErr m, 'old' m.jTest.m.0 'lines ^= new' ,
m.jTest.m.out.0
do nx = m.jTest.m.out.0 + 1 to ,
min(m.jTest.m.out.0+10, m.jTest.m.0)
say 'old - ' m.jTest.m.nx
end
end
if m.jTest.m.err > 0 then do
say 'new lines:' m.jTest.m.out.0
len = 60
do nx=2 to m.jTest.m.out.0
str = quote(m.jTest.m.out.nx, '"')
pr = ' , '
do while length(str) > len
l=len
if substr(str, l-1, 1) = '"' then
if posCount('"', left(str, l-1)) // 2 = 0 then
l = l-1
say pr left(str, l-1)'",'
str = '"'substr(str, l)
pr = ' ||'
end
say pr str || left(',', nx < m.jTest.m.out.0)
end
end
say left('******' m.jTest.m 'end with' m.jTest.m.err 'errors ', 79,
, '*')
return
endProcedure jTestClose
/*--- write to test: say lines and compare them ----------------------*/
jTestWrite: procedure expose m.
parse arg m, arg
call jTestOut m, 'jOut:' arg
return
endProcedure jTestWrite
jTestOut: procedure expose m.
parse arg m, arg
nx = m.jTest.m.out.0 + 1
m.jTest.m.out.0 = nx
m.jTest.m.out.nx = arg
if nx > m.jTest.m.0 then do
if nx = m.jTest.m.0+1 then
call jTestErr m, 'more new Lines' nx
end
else if m.jTest.m.nx ^== arg then do
call jTestErr m, 'next line old' nx '^^^ new overnext'
say m.jTest.m.nx
end
say arg
return
endProcedure jTestOut
jTestRead: procedure expose m.
parse arg m, arg
ix = m.jTest.m.inIx + 1
m.jTest.m.inIx = ix
if ix <= m.jTest.m.in.0 then do
m.arg = m.jTest.m.in.ix
call jTestOut m, 'jIn' ix':' m.arg
return 1
end
call jTestOut m, 'jIn eof' ix
return 0
endProcedure jTestRead
/*--- say total errors and fail if not zero --------------------------*/
jTestTotal: procedure expose m.
if m.jTest.err = 0 then
say m.jTest.err 'errors total'
else
call err m.jTest.err 'errors total'
return
endProcedure jTestTotal
/*--- test err: message, count it and continue -----------------------*/
jTestErr: procedure expose m.
parse arg m, msg
say '*** error' msg
m.jTest.m.err = m.jTest.m.err + 1
m.jTest.err = m.jTest.err + 1
return
endProcedure jTestErr
/*--- return the count of occurrences of needle in heyStack ----------*/
posCount: procedure
parse arg needle, hayStack, start, fin
if start = '' then
start = 1
if fin = '' then
fin = length(hayStack) + 1 - length(needle)
do cnt = 0 by 1
start = pos(needle, haystack, start)
if start < 1 | start > fin then
return cnt
start = start + length(needle)
end
endProcedure posCount
/* copy jTest end **************************************************/
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jNew: procedure expose m.
return 'J.'mIncD(j.0)
endProcedure jNew
jFree: procedure expose m.
parse arg m
return
endProcedure jFree
jRead: procedure expose m.
parse arg m, arg
res = '?'
interpret m.j.m.read
return res
endProcedure jRead
jWrite: procedure expose m.
parse arg m, arg
interpret m.j.m.write
return
endProcedure jWrite
jReset: procedure expose m.
parse arg m, arg
interpret 'call' m.j.m.pref'Reset m, arg'
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret 'call' m.j.m.pref'Open m, arg'
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
interpret 'call' m.j.m.pref'Close m'
m.j.m.read = 'call err "read('m') when closed"'
m.j.m.write = 'call err "write('m') when closed"'
return m
endProcedure jClose
jDefine: procedure expose m.
parse arg m, m.j.m.pref
m.j.m.read = 'call err "read('m') when closed"'
m.j.m.write = 'call err "write('m') when closed"'
return m
endProcedure jDefine
jDefRead: procedure expose m.
parse arg m, m.j.m.read
m.j.m.write = 'call err "write('m') when reading"'
return m
endProcedure jDeRead
jDefWrite: procedure expose m.
parse arg m, m.j.m.write
m.j.m.read = 'call err "read('m') when writing"'
return m
endProcedure jDeWrite
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jInit: procedure expose m.
m.j.jIn = jNew()
m.j.jOut = jNew()
call jDefine m.j.jIn, "jStdIOError "
call jDefRead m.j.jIn, "res = 0"
call jDefine m.j.jOut, "jStdIOError "
call jDefWrite m.j.jOut, "say arg"
return
endProcedure jInit
jStdIOError: procedure expose m.
parse arg fun m, arg
call err 'do not j'fun'('m',' arg') base stdIn/stdOut'
return
endSubroutine
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
jBuf: procedure expose m.
m = jNew()
call jDefine m, "jBuf"
do ax=1 to arg()
m.j.m.buf.ax = arg(ax)
end
m.j.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
do ax=1 to arg() - 1
m.j.m.buf.ax = arg(ax+1)
end
m.j.m.buf.0 = ax-1
return m
endProcedure jBufReset
jBufOpen: procedure expose m.
parse arg m, opt
if opt == 'r' then do
call jDefRead m, "res = jBufRead(m , arg)"
m.j.m.bufIx = 0
return m
end
if opt == 'w' then
m.j.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
call jDefWrite m, "call mAdd 'J.'m'.BUF', arg"
return m
endProcedure jBufOpen
jBufClose:
return arg(1)
endProcedure jBufClose
jBufStem: procedure expose m.
parse arg m
return 'J.'m'.BUF'
endProcedure jBufStem
jBufRead: procedure expose m.
parse arg m, var
ix = m.j.m.bufIx + 1
if ix > m.j.m.buf.0 then
return 0
m.j.m.bufIx = ix
m.var = m.j.m.buf.ix
return 1
endProcedure jBufRead
jDsn: procedure expose m.
parse arg spec
m = jNew()
m.j.m.state = ''
call jDefine m, "jDsn"
m.j.m.defDD = 'J'mIncD('J.DEFDD')
call jDsnReset m, spec
return m
endProcedure jDsn
jDsnReset: procedure expose m.
parse arg m, spec
call jClose m
m.j.m.dsnSpec = spec
return m
endProcedure jDsnReset
jDsnOpen: procedure expose m.
parse arg m, opt
call jDsnClose m
if opt == 'r' then do
aa = dsnAlloc(m.j.m.dsnSpec, 'SHR', m.j.m.defDD)
call readDDBegin word(aa, 1)
call jDefRead m, "res = jDsnRead(m , arg)"
end
else do
if opt == 'w' then
aa = dsnAlloc(m.j.m.dsnSpec, 'OLD', m.j.m.defDD)
else if opt == 'a' then
aa = dsnAlloc(m.j.m.dsnSpec, 'MOD', m.j.m.defDD)
else
call err 'jBufOpen('m',' opt') with bad opt'
call writeDDbegin word(aa, 1)
call jDefWrite m, "call jDsnWrite m , arg"
end
m.j.m.state = opt
m.j.m.dd = word(aa, 1)
m.j.m.free = subword(aa, 2)
return m
endProcedure jBufOpen
jDsnClose:
parse arg m
if m.j.m.state ^== '' then do
if m.j.m.state == 'r' then do
call readDDend m.j.m.dd
end
else do
if m.j.m.buf.0 > 0 then
call writeDD m.j.m.dd, 'M.J.'m'.BUF.'
call writeDDend m.j.m.dd
end
interpret m.j.m.free
end
m.j.m.buf.0 = 0
m.j.m.bufIx = 0
m.j.m.state = ''
m.j.m.free = ''
m.j.m.dd = ''
return m
endProcedure jDsnClose
jDsnRead: procedure expose m.
parse arg m, var
ix = m.j.m.bufIx + 1
if ix > m.j.m.buf.0 then do
res = readDD(m.j.m.dd, 'M.J.'m'.BUF.')
if ^ res then
return 0
ix = 1
end
m.j.m.bufIx = ix
m.var = m.j.m.buf.ix
return 1
endProcedure jDsnRead
jDsnWrite: procedure expose m.
parse arg m, var
ix = m.j.m.buf.0 + 1
m.j.m.buf.0 = ix
m.j.m.buf.ix = var
if ix > 99 then do
call writeDD m.j.m.dd, 'M.J.'m'.BUF.'
m.j.m.buf.0 = 0
end
return
endProcedure jDsnWrite
/* copy j end *********************************************************/
/* copy m begin ********************************************************
stem and tree handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a, delta
if delta = '' then
m.a = m.a + 1
else
m.a = m.a + delta
return m.a
endProcedure mInc
/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
parse arg a, delta
if symbol('m.a') <> 'VAR' then
m.a = 0
return mInc(a)
endProcedure mIncD
/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
parse arg a
return m.m.key.a
endProcedure mKy
/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
parse arg a
if symbol('m.a.0') == 'VAR' then
return m.a.0
else
return 0
endProcedure mSize
/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg a
dx = lastPos('.', a)
if dx <= 1 then
return ''
else
return left(a, dx - 1)
endProcedure mPar
/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg a, Ky, val
if a == '' then
a = 'm.root.' || mIncD('m.root.0')
m.a = val
m.m.key.a = Ky
m.a.0 = 0
return a
endProcedure mRoot
/*--- add one or several values to stem m.a --------------------------*/
mAdd: procedure expose m.
parse arg a
ix = mSize(a)
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSeq: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
dx = mSize(dst)
do sx = begX to endX
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return dst
endProcedure mAddSeq
/*--- add one value to the stem m.m ----------------------------------*/
mAddNd: procedure expose m.
parse arg a
ix = mSize(a)
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
m.a.ix.0 = 0
end
m.a.0 = ix
return a'.'ix
endProcedure mAddNd
/*--- add one Ky value pair to stem m.a -----------------------------*/
mAddKy: procedure expose m.
parse arg a, Ky, val
nn = mAddNd(a, val)
m.m.key.nn = Ky
return nn
endProcedure mAddKy
/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
parse arg a, ky, val
if symbol('m.m.index.a.key.ky') == 'VAR' then
call err 'duplicate Ky' ky 'for node' m
nn = mAddNd(m, val)
m.m.key.nn = ky
m.m.index.a.key.ky = nn
return nn
endProcedure mAddK1
/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg a, Ky, val
if symbol('m.m.index.a.key.Ky') == 'VAR' then do
ch = m.m.index.a.key.Ky
m.ch = val
return ch
end
else do
return mAddK1(a, Ky, val)
end
return
endProcedure mPut
/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg a, ky
if symbol('m.m.index.a.key.ky') == 'VAR' then
return m.m.index.a.key.ky
else
return ''
endProcedure mAtK1
/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg a, Ky
if symbol('m.m.index.a.key.Ky') ^== 'VAR' then
call err 'no Ky' Ky 'at node' a
ch = m.m.index.a.key.Ky
return m.ch
endProcedure mVaAtK1
/*--- return the value of the first defined ky in the list of nodes
def if ky isn't defined ---------------------------------------*/
mFirst: procedure expose m.
parse arg Ky, def
do ax=3 to arg()
a = arg(ax)
if symbol('m.m.index.a.key.Ky') == 'VAR' then do
ch = m.m.index.a.key.Ky
return m.ch
end
end
return def
endProcedure mFirst
/*--- return the child at sequenceNo seq of node m -------------------*/
mAtSq: procedure expose m.
parse arg a, seq
if symbol('m.a.seq') ^== 'VAR' then
return ''
else
return m'.'seq
endProcedure mAtSq
/*--- remove all or all after nwSz children --------------------------*/
mRemCh: procedure expose m.
parse arg pa, nwSz
if nwSz = '' then
nwSz = 0
do cx=nwSz+1 to mSize(pa)
ch = pa'.'cx
call mRemCh ch
ky = m.m.key.ch
drop m.m.index.pa.key.ky m.key.ch m.ch m.ch.0
end
m.pa.0 = nwSz
return pa
endProcedure mRemCh
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mAddTree: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
do sx=begX to endX
sCh = src'.'sx
if symbol('m.m.key.sCh') ^= 'VAR' then do
dCh = mAddNd(dst, m.sCh)
end
else do
ky = m.m.key.sCh
if symbol('m.m.index.src.key.ky') ^= 'VAR' then
dCh = mAddKy(dst, ky, m.sCh)
else
dCh = mAddK1(dst, ky, m.sCh)
end
call mAddTree dCh, sCh
end
return dst
endProcedure mAddTree
/*--- show from one node everything that is defined ------------------*/
mShowNd: procedure expose m.
parse arg a
pa = mPar(a)
t = 'node' a 'pa='pa
if symbol('m.a') == 'VAR' then
t = t 'va='m.a
if symbol('m.a.0') == 'VAR' then
t = t 'size='m.a.0
if symbol('m.m.key.a') == 'VAR' then do
ky = m.m.key.a
t = t 'ky='ky
if symbol('m.m.index.pa.key.ky') == 'VAR' then
t = t 'index='m.m.index.pa.key.ky
end
say t
return
endProcedure mShowNd
/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg a, lv
if lv = '' then
lv = 0
t = left('', lv)a
if symbol('m.m.key.m') == 'VAR' then do
ky = m.m.key.m
pa = mPar(m)
if symbol('m.m.index.pa.key.ky') == 'VAR' then
t= t ky '>'
else
t= t ky '='
end
say t strip(m.a, 't')
do cx=1 to mSize(a)
call mShow mAtSq(a, cx), lv+1
end
return
endProcedure treeShow
/* copy m 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 -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
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 ds = '' then
ds = dsn2jcl(w)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
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)'
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(LISTCT) cre=2008-01-17 mod=2008-01-17-17.38.52 F540769 ---
parse arg arg
if arg = '' then do
call is A540769.wk.rexx
call is A540769.BMCCAT.SQL
call is A540769.dbx.cdl
call is DBOF.AU01A1P.SAM15090.P0000.D07364.T192314
call is DBOF.LFDC.AC01A1P.A002P.D08009.T080017
call is DBOF.AU01A1P.SAM05993.P0000.D08015.T221640
call is DBOF.AV01A1P.A030H.P0000.D08017.T014514
end
else do
call is "'"arg"'"
end
exit
is:
say arg(1) '-->' info(arg(1))
return
info: procedure
parse upper arg dsn
call outtrap x., '*'
address tso "listcat volume entry('"dsn"')"
rt = rc
call outtrap off
/* say 'listct rc =' rt 'lines' x.0 */
cl = ''
vo = ''
if word(x.1, 3) ^== dsn then
say 'for dsn' dsn 'bad first line' x.1
else if pos('NOT FOUND', x.1) > 0 then
return 'notFound'
else if word(x.1, 1)^== 'NONVSAM' then
say 'for dsn' dsn 'bad first line' x.1
do x=2 to x.0 while vo = '' & left(x.x, 1) = ' '
/* say x.x */
p = pos('MANAGEMENTCLASS-', x.x)
if p > 0 then
cl = strip(substr(x.x, p+16))
p = pos('VOLSER--', x.x)
if p > 0 then
vo = strip(word(substr(x.x, p+6), 1), 'l', '-')
p = pos('DEVTYPE--', x.x)
dt = strip(word(substr(x.x, p+8), 1), 'l', '-')
end
/* say 'lc' cl 'vo' vo 'dt' dt 'dsn' dsn */
if vo = '' then
say err 'no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl = '' then
res = 'tape'
else
res = cl
if abbrev(res, 'ar') ^= abbrev(dt, "X'0") ,
| abbrev(res, 'ta') ^= abbrev(dt, "X'7") ,
| (left(res, 1) >= 'A') ^= abbrev(dt, "X'3") then
say 'mismatch lc' cl 'vo' vo 'dt' dt 'dsn' dsn
return res
endProcedure info
}¢--- A540769.WK.REXX.O08(LISTDSI) cre=2006-07-27 mod=2008-02-28-18.12.45 F540769 ---
/* rexx
**********************************************************************/
w = sysexec file
rc = listdsi(w)
say 'listDsi rc' rc 'for' w sysdsname
/* if rc ^= 0 then */
say varExp('sysReason sysMsgLvl1 sysMsgLvl2')
say varExp('sysLRecL sysBlkSize sysKeyLen')
say varExp('sysUnit sysTrksCyl sysBlksTrk sysUnits sysUsed')
exit
parse arg dsns
if dsns = '' then
dsns = "'DBOF.MF01A1P.A150A.P0003.D08014.T090323' wk.rexx"
do wx = 1 to words(dsns)
w = word(dsns, wx)
rc = listdsi(w)
say 'listDsi rc' rc 'for' w
if rc ^= 0 then do
say varExp('sysReason sysMsgLvl1 sysMsgLvl2')
end
say varExp('sysLRecL sysBlkSize sysKeyLen')
say varExp('sysUnit sysTrksCyl sysBlksTrk sysUnits sysUsed')
if sysUnits = 'CYLINDER' then
cy = sysUsed
else if sysUnits = 'TRACK' then
cy = sysUsed / sysTrksCyl
else if sysUnits = 'BLOCK' then
cy = sysUsed / sysTrksCyl / sysBlksTrk
else cy = sysUnits '????'
say 'cylinders' cy
end
exit
varExp:
parse arg ggVarExpVars
ggVarExp = ''
do ggVarExpIx = 1 to words(ggVarExpVars)
ggVarExp1 = word(ggVarExpVars, ggVarExpIx)
ggVarExp = ggVarExp ggVarExp1':' value(ggVarExp1)
end
return ggVarExp
endSubroutine varExp
}¢--- A540769.WK.REXX.O08(LMD) cre=2007-03-30 mod=2007-03-30-15.34.19 F540769 ---
/* rexx ***************************************************************
synopsis: LMD (? ¨ CNT ¨ DEL ¨ SPA) level
counts, deletes or shows the space of the datasets matching level
level: datasetname including the following special chars
~ userid
% one character wildcard
* 0 - 8 charcter wildcard within one qualifier
** 0 - n qualifiers
**********************************************************************/
parse upper arg fun lev
if lev = '' then do
lev = fun
fun = 'CNT'
end
if pos(?, lev) > 0 then
return help()
if lev = '' then
lev = '~'
if left(lev, 1) = '~' then
lev = userid()'.'strip(substr(lev, 2), 'b', '.')
say 'lmd' lev
call adrIsp 'control errors return'
call lmdBegin grp, lev
call lmdNext grp, grp., , '*'
s = 0
do y=1 by max(1, (grp.0-1)/4) to grp.0
r = trunc(y+.5)
say r grp.r
end
call lmdEnd grp
if grp.0 = 0 then do
say 'no datasets in' lev
end
else if fun == 'DEL' then do
say 'enter D to delete these' grp.0 'datasets in' lev
parse upper pull ans
if ans ^== 'D' then
call errHelp 'bad answer' ans', not deleting datasets'
do y=1 to grp.0
call adrTso "delete '"strip(grp.y)"'"
end
say 'deleted' grp.0 'datasets from' lev
end
else do
say grp.0 'datasets in' lev
if fun ^== 'CNT' then
call errHelp 'bad fun' fun
end
exit
err:
call errA arg(1), 1
endSubroutine err
/* rexx */
call lmmTest
exit
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') dummy'
end
call readDDBegin grp
return /* end lmdBegin */
lmdNext:
parse arg ggGrp, ggSt, withVolume, num
if ^ readDD(ggGrp, ggSt, num) then
return 0
if withVolume ^== 1 then
do ggIx=1 to value(ggSt'0')
ggDummy = 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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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
m.dsnAlloc.dsn = ''
if left(spec, 1) = '=' then
return strip(substr(spec, 2))
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 to 3
w = word(spec, wx)
if w = '.' then do
wx = wx + 1
leave
end
if w = '' then
leave
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if m.dsnAlloc.dsn = '' then
m.dsnAlloc.dsn = dsn2jcl(w, addPref)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if m.dsnAlloc.dsn <> '' then
disp = disp "dsn('"m.dsnAlloc.dsn"')"
call adrTso 'alloc dd('dd')' disp subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(LMDTT) cre=2008-01-18 mod=2008-01-18-11.34.50 F540769 ---
call adrIsp 'control errors return'
call t1 A540769.WK
exit
t1:
parse arg lev
call adrIsp "lmdinit listid(lmdId) level("lev")"
dsn = ''
do while adrIsp('lmdlist listid(&lmdId) option(list) dataset(dsn)',
'stats(yes)', 4 8) = 0
say 'vo' ZDLVOL 'dt' ZDLDEV 'mi' ZDLMIGR dsn
end
call adrIsp 'lmdfree listid(&lmdId)'
return
endProcedure t1
end
else do
call trc 'no datasets found' showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') dummy'
end
call readDDBegin grp
say 'lmd' lev
call adrIsp 'control errors return'
call lmdBegin grp, lev
call lmdNext grp, grp., , '*'
s = 0
do y=1 by max(1, (grp.0-1)/4) to grp.0
r = trunc(y+.5)
say r grp.r
end
call lmdEnd grp
if grp.0 = 0 then do
say 'no datasets in' lev
end
else if fun == 'DEL' then do
say 'enter D to delete these' grp.0 'datasets in' lev
parse upper pull ans
if ans ^== 'D' then
call errHelp 'bad answer' ans', not deleting datasets'
do y=1 to grp.0
call adrTso "delete '"strip(grp.y)"'"
end
say 'deleted' grp.0 'datasets from' lev
end
else do
say grp.0 'datasets in' lev
if fun ^== 'CNT' then
call errHelp 'bad fun' fun
end
exit
err:
call errA arg(1), 1
endSubroutine err
/* rexx */
call lmmTest
exit
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') dummy'
end
call readDDBegin grp
return /* end lmdBegin */
lmdNext:
parse arg ggGrp, ggSt, withVolume, num
if ^ readDD(ggGrp, ggSt, num) then
return 0
if withVolume ^== 1 then
do ggIx=1 to value(ggSt'0')
ggDummy = 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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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
m.dsnAlloc.dsn = ''
if left(spec, 1) = '=' then
return strip(substr(spec, 2))
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 to 3
w = word(spec, wx)
if w = '.' then do
wx = wx + 1
leave
end
if w = '' then
leave
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if m.dsnAlloc.dsn = '' then
m.dsnAlloc.dsn = dsn2jcl(w, addPref)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if m.dsnAlloc.dsn <> '' then
disp = disp "dsn('"m.dsnAlloc.dsn"')"
call adrTso 'alloc dd('dd')' disp subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(LOGG) cre=2008-04-14 mod=2008-11-24-17.34.21 F540769 ---
/* rexx */
call logg A540769.tmp.logg, 'zeile eins', 'zeile zwei'
exit
/*--- append a message to a seq DS if available
otherwise isssue a message ----------------------------*/
logg: procedure expose m.
parse arg dsn
o.1 = ''
do x=1 to arg()-1
o.x = ' ' strip(arg(x+1), t)
end
o.1 = date(s) time() strip(o.1)
x = max(1, arg() - 1)
address tso "alloc dd(logg) mod dsn('"dsn"') MGMTCLAS(COM#A092)"
if rc <> 0 then do
say 'cannot alloc logg' dsn
return
end
address tso 'execio' x 'diskw logg (stem o. finis)'
if rc <> 0 then
say 'execio logg rc' rc dsn
address tso 'free dd(logg)'
if rc <> 0 then
say 'execio free rc' rc
return
endProcedure logg
}¢--- A540769.WK.REXX.O08(LOOP) cre=2007-03-26 mod=2007-03-26-10.57.43 F540769 ---
do i=1 by 1
if i // 10000 = 0 then
say 'loop' i
end
}¢--- A540769.WK.REXX.O08(M) cre=2007-10-19 mod=2008-05-16-09.16.25 F540769 ----
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m end *********************************************************/
}¢--- A540769.WK.REXX.O08(MAP) cre=2008-11-16 mod=2008-11-24-08.54.23 F540769 ---
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, if opt <> '' maintain stem of keys
('K' in map.keys, '=' in a else in opt) --------------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = opt
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'a')
m.vv = val
return val
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'p')
m.vv = val
return val
endProcedure mapPut
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a if it exists,
else if called with a third argument return third argument
else issue an error ----------------------------------------*/
mapGet: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv ^== '' then
return m.vv
else if arg() >= 3 then
return arg(3)
else
call err 'missing key in mapGet('a',' ky')'
endProcedure mapGet
/*--- return a stem of all keys --------------------------------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if m.map.keys ^== '' then
call err 'not implemented mapRemove('a',' ky')'
val = m.a.vv
drop m.a.ky
return val
endProcedure mapRemove
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
if length(k) > 200 then do
k = left(k, 201)
if symbol('m.a.k') == 'VAR' then/* ist noch hier */
call mapClear m.a.k
end
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
/*--- return the value pointer for a key, '' if non existing
with fun = 'a' add a key, with 'p' put a key ------------*/
mapValAdr: procedure expose m.
parse arg pA, pKy, fun
a = pA
ky = pKy
do forever
if length(ky) <= 200 then do
if symbol('m.a.ky') ^== 'VAR' then
leave
if fun == 'a' then
call err 'duplicate key' pKy 'in map' pA
return a'.'ky
end
k1 = left(ky, 201)
if symbol('m.a.k1') ^== 'VAR' then
leave
a = m.a.k1
ky = substr(ky, 202)
end
if fun == '' then
return ''
opt = left('K', m.map.keys.pA ^== '')
if opt == 'K' then
call mAdd m.map.Keys.pA, pKy
do while length(ky) > 200
k1 = left(ky, 201)
n = mapNew(opt)
m.a.k1 = n
if a ^== pA & opt == 'K' then
call mAdd m.map.keys.a, ky
a = n
ky = substr(ky, 202)
end
return a'.'ky
endProcedure mapValAdr
/* copy map end *******************************************************/
}¢--- A540769.WK.REXX.O08(MAPEXP) cre=2008-01-29 mod=2008-01-29-13.06.50 F540769 ---
/* copy mapExp begin **************************************************/
mapVia: procedure expose m.
parse arg a, ky
sx = pos('*', ky)
if sx < 1 then
return mapGet(a, ky)
via = mapGet(a, left(ky, sx-1))
do while sx <= length(ky)
fx = sx+1
sx = pos('*', ky, fx)
if sx < 1 then
sx = length(ky) + 1
if sx = fx then do
if symbol('m.via') ^== 'VAR' then
call err 'missing m.'via 'at' sx 'in mapVia('a',' ky')'
via = m.via
end
else do
f = substr(ky, fx, sx - fx)
if symbol('m.via.f') ^== 'VAR' then
call err 'missing m.'via'.'f ,
'at' sx 'in mapVia('a',' ky')'
via = m.via.f
end
end
return via
endProcedure mapVia
mapExpAt: procedure expose m.
parse arg a, src, sx
m.map.ExpAt = 0
cx = pos('$', src, sx)
if cx < 1 then
return substr(src, sx)
res = substr(src, sx, cx-sx)
do forever
if substr(src, cx+1, 1) = '{' then do
ex = pos('}', src, cx+2)
if ex < 1 then
call err 'missing } after' substr(src, cx) 'in' src
res = res || mapVia(a, strip(substr(src, cx+2, ex-cx-2)))
ex = ex + 1
end
else do
ex = verify(src, m.mAlfDot, 'n', cx+1)
if ex < 1 then
return res || mapVia(a, substr(src, cx+1))
if ex = cx+1 then do
m.map.ExpAt = cx
return res
end
res = res || mapVia(a, substr(src, cx+1, ex-cx-1))
end
cx = pos('$', src, ex)
if cx < 1 then
return res || substr(src, ex)
res = res || substr(src, ex, cx-ex)
end
endProcedure mapExpAt
mapExp: procedure expose m.
parse arg a, src
res = mapExpAt(a, src, 1)
if m.map.ExpAt ^== 0 then
call err 'mapExp stopped at' substr(src, map.ExpAt) 'in' src
return res
endProcedure mapExp
mapExpAllAt: procedure expose m.
parse arg a, dst, src, sx, cx
do while sx <= m.src.0
li = mapExpAt(a, m.src.sx, cx)
dx = m.map.ExpAt
if (cx=1 & dx = 0) | li ^= '' then
call mAdd dst, li
if dx = 0 then do
cx = 1
sx = sx+1
end
else do
return sx dx
end
end
return ''
endProcedure mapExpAllAt
mapExpAll: procedure expose m.
parse arg a, dst, src
sto = mapExpAllAt(a, dst, src, 1, 1)
if sto == '' then
return
lx = word(sto, 1)
call err 'mapExpAll stopped at' sto':' m.src.lx
endProcedure mapExpAll
/* copy mapExp end ****************************************************/
}¢--- A540769.WK.REXX.O08(MATCH) cre=2006-10-17 mod=2008-06-09-16.48.37 F540769 ---
/* copy match begin ***************************************************/
/************************************* begin copy match ******/
/*--- wildCard matching with the following wildchars:
* 0-n chars
? 1 char
fill matched expressions instem st if st is non empty
return 1 if mask matches wert ----------------------------------*/
match: procedure expose m.
parse arg wert, mask, st
if st == '' then
return matchRO(wert, mask)
m.st.0 = -9
return matchSt(wert, mask, st, 0)
endProcedure match
/*--- return the fixed prefix of maskt -------------------------------*/
matchPref: procedure
arg mask, suff
ix = verify(mask, '*?', 'm')
if ix = 0 then
return mask
else
return left(mask, ix-1)suff
endProcedure matchPref
/*--- return true if mask matches wert -------------------------------*/
matchRO: procedure
arg wert, mask
ix = verify(mask, '*?', 'm')
if ix < 1 then return (mask == wert)
if length(wert) < ix-1 then return 0
if left(mask, ix-1) ^== left(wert, ix-1) then return 0
if substr(mask, ix, 1) == '?' then do
if length(wert) < ix then return 0
return matchRO(substr(wert, ix+1), substr(mask, ix+1))
end
mask = substr(mask, ix+1) /* * 0 - n Chars */
do ex = 1+length(wert) to ix by -1
if matchRO(substr(wert, ex), mask) then return 1
end
return 0
endProcedure matchRO
/*--- wildCard matching: fill matched expressions instem st
return 1 if mask matches wert ----------------------------------*/
matchSt: procedure expose m.
parse arg wert, mask, st, sx
ix = verify(mask, '*?', 'm')
if ix < 1 then do
if mask ^== wert then
return 0
m.st.0 = sx
return 1
end
if ^ abbrev(wert, left(mask, ix-1)) then
return 0
reMa = substr(mask, ix+1)
sx = sx + 1
if substr(mask, ix, 1) == '?' then do /* ? 1 Character */
if length(wert) < ix then
return 0
m.st.sx = substr(wert, ix, 1)
return matchSt(substr(wert, ix+1), reMa, st, sx)
end
do lx = 1+length(wert) to ix by -1 /* greedy: from all to empty */
if matchSt(substr(wert, lx), reMa, st, sx) then do
m.st.sx = substr(wert, ix, lx-ix)
return 1
end
end
return 0
endProcedure matchSt
matchTrans: procedure expose m.
parse arg mask, st
r = ''
ox = 1
sx = 0
ix = verify(mask, '*?', 'm')
do sx=1 to m.st.0 while ix > 0
if sx > m.st.0 then
call err 'matchTrans('mask',' st') has only' ,
m.st.0 'variables'
r = r || substr(mask, ox, ix-ox)m.st.sx
ox = ix+1
ix = verify(mask, '*?', 'm', ox)
end
if ix > 0 then
call err 'matchTrans('mask',' st') has only' ,
m.st.0 'variables'
return r || substr(mask, ox)
endProcedure matchTrans
/* copy match end *****************************************************/
}¢--- A540769.WK.REXX.O08(MERGE) cre=2006-06-28 mod=2006-06-28-15.46.43 F540769 ---
/* rexx ****************************************************************
merge two files
**********************************************************************/
call readDsn "wk.sql(tsListOF)", m.of.
call readDsn "wk.sql(tsListLF)", m.lf.
say of m.of.0 lf m.lf.0
ox=1
lx=1
mx=0
do while ox <= m.of.0 & lx <= m.lf.0
tof = substr(m.of.ox, 11, 12)
iof = left(m.of.ox, 10)substr(m.of.ox, 31, 20)
tlf = substr(m.lf.lx, 11, 12)
ilf = left(m.lf.lx, 10)substr(m.lf.lx, 31, 20)
if tof << tlf then do
m = 'o' tof || iof
ox = ox + 1
end
else if tof == tlf then do
if substr(iof, 11, 10) == substr(ilf, 11, 10) then
m = '='
else
m = '*'
m = m tlf || iof || ilf
lx = lx + 1
ox = ox + 1
end
else do
m = 'l' tlf || left(' ', 30) || ilf
lx = lx + 1
end
mx = mx + 1
m.mr.mx = m
end
m.mr.0 = mx
call writeDsn "wk.sql(tsListMr)", m.mr.
exit
/* copy adr begin ****************************************************/
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
/**********************************************************************
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 */
readDDall:
parse arg ggDD, ggSt
call adrTso 'execio * diskr' ggDD '(stem' ggSt' finis)'
return
endSubroutine readDDall
readDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(readDsn) shr dsn('dsn')'
call readDDall readDsn, ggSt
call adrTso 'free dd(readDsn)'
return
endSubroutine readDsn
/*--- 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 */
writeDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(wriDsn) shr dsn('dsn')'
call adrTso 'execio' value(ggSt'0') ,
'diskw wriDsn (stem' ggSt 'finis)'
call adrTso 'free dd(wriDsn)'
return
endSubroutine writeDsn
/*--- 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 */
/* copy adr end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
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 zIspfRc
back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say 'help for rexx' s3
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
return 4
endProcedure help
/* copy err end *****************************************************/
}¢--- A540769.WK.REXX.O08(MOLD) cre=2007-05-18 mod=2007-05-18-11.46.09 F540769 ---
/* copy m begin ********************************************************
stem and tree handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a, delta
if delta = '' then
m.a = m.a + 1
else
m.a = m.a + delta
return m.a
endProcedure mInc
/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
parse arg a, delta
if symbol('m.a') <> 'VAR' then
m.a = 0
return mInc(a)
endProcedure mIncD
/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
parse arg a
return m.m.key.a
endProcedure mKy
/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
parse arg a
if symbol('m.a.0') == 'VAR' then
return m.a.0
else
return 0
endProcedure mSize
/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg a
dx = lastPos('.', a)
if dx <= 1 then
return ''
else
return left(a, dx - 1)
endProcedure mPar
/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg a, Ky, val
if a == '' then
a = 'm.root.' || mIncD('m.root.0')
m.a = val
m.m.key.a = Ky
m.a.0 = 0
return a
endProcedure mRoot
/*--- add one or several values to stem m.a --------------------------*/
mAdd: procedure expose m.
parse arg a
ix = mSize(a)
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSeq: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
dx = mSize(dst)
do sx = begX to endX
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return dst
endProcedure mAddSeq
/*--- add one value to the stem m.m ----------------------------------*/
mAddNd: procedure expose m.
parse arg a
ix = mSize(a)
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
m.a.ix.0 = 0
end
m.a.0 = ix
return a'.'ix
endProcedure mAddNd
/*--- add one Ky value pair to stem m.a -----------------------------*/
mAddKy: procedure expose m.
parse arg a, Ky, val
nn = mAddNd(a, val)
m.m.key.nn = Ky
return nn
endProcedure mAddKy
/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
parse arg a, ky, val
if symbol('m.m.index.a.key.ky') == 'VAR' then
call err 'duplicate Ky' ky 'for node' m
nn = mAddNd(a, val)
m.m.key.nn = ky
m.m.index.a.key.ky = nn
return nn
endProcedure mAddK1
/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg a, Ky, val
if symbol('m.m.index.a.key.Ky') == 'VAR' then do
ch = m.m.index.a.key.Ky
m.ch = val
return ch
end
else do
return mAddK1(a, Ky, val)
end
return
endProcedure mPut
/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg a, ky
if symbol('m.m.index.a.key.ky') == 'VAR' then
return m.m.index.a.key.ky
else
return ''
endProcedure mAtK1
/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg a, Ky
if symbol('m.m.index.a.key.Ky') ^== 'VAR' then
call err 'no Ky' Ky 'at node' a
ch = m.m.index.a.key.Ky
return m.ch
endProcedure mVaAtK1
/*--- return the value of the first defined ky in the list of nodes
def if ky isn't defined ---------------------------------------*/
mFirst: procedure expose m.
parse arg Ky, def
do ax=3 to arg()
a = arg(ax)
if symbol('m.m.index.a.key.Ky') == 'VAR' then do
ch = m.m.index.a.key.Ky
return m.ch
end
end
return def
endProcedure mFirst
/*--- return the child at sequenceNo seq of node m -------------------*/
mAtSq: procedure expose m.
parse arg a, seq
if symbol('m.a.seq') ^== 'VAR' then
return ''
else
return a'.'seq
endProcedure mAtSq
/*--- remove all or all after nwSz children --------------------------*/
mRemCh: procedure expose m.
parse arg pa, nwSz
if nwSz = '' then
nwSz = 0
do cx=nwSz+1 to mSize(pa)
ch = pa'.'cx
call mRemCh ch
ky = m.m.key.ch
drop m.m.index.pa.key.ky m.key.ch m.ch m.ch.0
end
m.pa.0 = nwSz
return pa
endProcedure mRemCh
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mAddTree: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
do sx=begX to endX
sCh = src'.'sx
if symbol('m.m.key.sCh') ^= 'VAR' then do
dCh = mAddNd(dst, m.sCh)
end
else do
ky = m.m.key.sCh
if symbol('m.m.index.src.key.ky') ^= 'VAR' then
dCh = mAddKy(dst, ky, m.sCh)
else
dCh = mAddK1(dst, ky, m.sCh)
end
call mAddTree dCh, sCh
end
return dst
endProcedure mAddTree
/*--- show from one node everything that is defined ------------------*/
mShowNd: procedure expose m.
parse arg a
pa = mPar(a)
t = 'node' a 'pa='pa
if symbol('m.a') == 'VAR' then
t = t 'va='m.a
if symbol('m.a.0') == 'VAR' then
t = t 'size='m.a.0
if symbol('m.m.key.a') == 'VAR' then do
ky = m.m.key.a
t = t 'ky='ky
if symbol('m.m.index.pa.key.ky') == 'VAR' then
t = t 'index='m.m.index.pa.key.ky
end
say t
return
endProcedure mShowNd
/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg a, lv
if lv = '' then
lv = 0
t = left('', lv)a
if symbol('m.m.key.a') == 'VAR' then do
ky = m.m.key.a
pa = mPar(a)
if symbol('m.m.index.pa.key.ky') == 'VAR' then
t= t ky '>'
else
t= t ky '='
end
say t strip(m.a, 't')
do cx=1 to mSize(a)
call mShow mAtSq(a, cx), lv+1
end
return
endProcedure treeShow
/* copy m end *********************************************************/
}¢--- A540769.WK.REXX.O08(MTEST) cre=2006-05-30 mod=2006-05-31-12.21.16 F540769 ---
/* copy mTest begin ***************************************************
test infrastructure plus tests for wr, wr io and scan
***********************************************************************/
/*--- all tests ------------------------------------------------------*/
call mTestAll
exit
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
mTestAll: procedure expose m.
call mTestTest
call mTestScan
/*
call mTestWr
call mTestWrFore
call mTestIO
*/
call mTestTotal
return
endProcedure mTestAll
mTestTest: procedure expose m.
call mTestBegin 'mTestTest: test mTest internals',
, "test line eins",
, "test line zwei",
, "test line drei ganz lang 1 ...li",
|| "ne drei ganz lang 2 ...line drei",
|| " ganz lang 3 ...line drei ganz l",
|| "ang 4 und schluss."
call mTestLn 'test line eins'
call mTestLn 'test line zwei'
call mTestLn 'test line drei ganz lang 1 ',
' ...line drei ganz lang 2 ',
' ...line drei ganz lang 3 ',
' ...line drei ganz lang 4 und schluss.'
call mTestEnd
return
endProcedure mTestTest
/*--- test wr writerDescriptor nur mit stems -------------------------*/
mTestWr: procedure expose m.
pT = wrNew()
call mTest pT,
, "--- mTestWr ==> wrIni",
, "--- writeLn eins",
, "text eins", "text eins.2", "text eins.3",
, "--- write a",
, "m.a.1: elf",
, "m.a.2: zwoelf",
, "--- writeLn 20",
, "text 20",
, "--- closing buffer"
call mTestOut pT, 'mTestWr ==> wrIni'
call mTestOut pT, 'writeLn eins'
call writeLn pT, 'text eins', 'text eins.2', 'text eins.3'
m.a.1 = 'm.a.1: elf'
m.a.2 = 'm.a.2: zwoelf'
m.a.0 = 2
call mTestOut pT, 'write a'
call write pT, a
call mTestOut pT, 'writeLn 20'
call writeLn pT, 'text 20'
call mTestOut pT, 'closing buffer'
call wrClose pT
call mTest pT,
, "--- testing out",
, "outLn eins vor out a",
, "m.a.1: elf",
, "m.a.2: zwoelf",
, "outLn VIER nach out a ",
, "--- testing wrDefine",
, "beginStem 1",
, "line writeLn eins vor out a",
, "end Stem 1",
, "beginStem 2",
, "line m.a.1: elf",
, "line m.a.2: zwoelf",
, "end Stem 2",
, "beginStem 1",
, "line writeLn eins nach out a vor close",
, "end Stem 1",
, "close pX"
call outPush pT
call mTestOut pT, 'testing out'
call outLn 'outLn eins vor out a'
call out a
call outLn 'outLn VIER nach out a '
call mTestOut pT, 'testing wrDefine'
pX = wrDefine(wrNew(), 'call outLn "beginStem" m.stem.0',
, 'call outLn "close pX"',
, 'call outLn "line" m.line',
, 'call outLn "end Stem" m.stem.0')
call writeLn pX, 'writeLn eins vor out a'
call write pX, a
call writeLn pX, 'writeLn eins nach out a vor close'
call wrClose pX
call wrClose pT
call outPop
call mTest pT,
, "--- stem A ==> test",
, "a.1 eins ",
, "a.2 zwei ",
, "--- stem A ==> B ==> test",
, "a.1 eins ",
, "a.2 zwei ",
, "--- stem A,A==> B strip ==> test",
, "a.1 eins",
, "a.2 zwei",
, "a.1 eins",
, "a.2 zwei"
pX = wrNew()
m.a.1 = 'a.1 eins '
m.a.2 = 'a.2 zwei '
m.a.0 = 2
call wrDefine
call mTestOut pt, 'stem A ==> test'
call wrFromDS pT, 'stem=A'
call wrDSFromDS 'stem=B', 'stem=A'
call mTestOut pt, 'stem A ==> B ==> test'
call wrFromDS pT, 'stem=B'
call wr2DS pX, 'stem=B strip=1'
call wrFromDS pX, 'stem=A'
call wrFromDS pX, 'stem=A'
call wrClose pX
call mTestOut pt, 'stem A,A==> B strip ==> test'
call wrFromDS pT, 'stem=B'
call wrClose pT
return
endProcedure mTestWr
/*--- foreground test, schreibt nur auf Bildschirm ohne Vergleich ----*/
mTestWrFore: procedure expose m.
say '--- mTestWr Foreground wr2DS dsn=*'
t = wrNew()
call wr2DS t, 'dsn=*'
call writeLn t, 'first writeln to dsn=*'
say '--- write ABC to dsn=*'
call write t, wrArgs('ABC', 0, 'ABC.1 eins', 'ABC.2','ABC.3 .')
call writeLn t, 'after write a', 'last writeln to dsn=*'
call wrClose t
say '--- outLn'
call outLn 'first outLn line'
say '--- out ABC'
call out 'ABC'
call outLn 'outLn after out a', 'last outLn'
say '--- mTestWr Foreground end'
return
endProcedure mTestWrFore
/*--- test io Funktionen auf Datasets --------------------------------*/
mTestIO: procedure expose m.
pO = wrNew()
pT = wrNew()
dsnPr = 'test.out'
tst = date('s') time()
do i=0 by 1
if i>5 then
call err 'no nonExisting dataset found in' dsnPr'0..'dsn
dsn = dsnPr||i
if sysDsn(dsn) == 'DATASET NOT FOUND' then
leave
end
call mTest pT,
, "--- allocating "dsn,
, "--- writing to "dsn,
, "--- appending to "dsn,
, "--- reading "dsn,
, "zeile eins ln "tst" ",
, "zeile zwei a.1 "tst" ",
, "zeile zwei a.2 "tst" ",
, "zeile vier ln "tst" ",
, "zeile funf app "tst" ",
, "zeile sech a.1 "tst" ",
, "zeile sieb a.2 "tst" ",
, "zeile acht app "tst" "
call mTestOut pT, 'allocating' dsn
call wr2DS pO, 'disp=new,catalog lrecl=35 dsn='dsn
call mTestOut pT, 'writing to' dsn
call writeLn pO, 'zeile eins ln ' tst
call write pO, wrArgs(a, 0, 'zeile zwei a.1' tst,
, 'zeile zwei a.2' tst)
call writeLn pO, 'zeile vier ln' tst
call wrClose pO
call mTestOut pT, 'appending to' dsn
call wr2DS pO, 'dsn='dsn 'strip=1 ioa=a'
call writeLn pO, 'zeile funf app' tst ' '
call write pO, wrArgs(a, 0, 'zeile sech a.1' tst ' ',
, 'zeile sieb a.2' tst)
call writeLn pO, 'zeile acht app' tst ' '
call wrClose pO
call mTestOut pT, 'reading' dsn
rx = readDS(wrNew(), 'dsn='dsn)
do while readLn(rx, vv)
call writeLn pT, m.vv
end
call wrClose pT
call mTest pT,
, "--- wrFromDS "dsn,
, "zeile eins ln "tst" ",
, "zeile zwei a.1 "tst" ",
, "zeile zwei a.2 "tst" ",
, "zeile vier ln "tst" ",
, "zeile funf app "tst" ",
, "zeile sech a.1 "tst" ",
, "zeile sieb a.2 "tst" ",
, "zeile acht app "tst" "
call mTestOut pT, 'wrFromDS' dsn
call wrFromDs pT, 'dsn='dsn
call wrClose pT
call mTest pT,
, "--- wr2DS append to 666 records "dsn"",
, "--- readln 666 records "dsn"",
, "read 123 line 123 from dss dsn="dsn": append line 123 ",
|| " ",
, "read 246 line 246 from dss dsn="dsn": append line 246 ",
|| " ",
, "read 369 line 369 from dss dsn="dsn": append line 369 ",
|| " ",
, "read 492 line 492 from dss dsn="dsn": append line 492 ",
|| " ",
, "read 615 line 615 from dss dsn="dsn": append line 615 ",
|| " ",
, "eof at 667 eof after line 666 from dss dsn="dsn": appe",
|| "nd line 666 "
call mTestOut pT, 'wr2DS append to 666 records' dsn
call wr2DS pO, 'dsn='dsn 'strip=1 ioa=a'
ox = 0
do rx=9 to 667
ox = ox + 1
m.qrs.ox = 'append line' rx
if rx // 111 = 0 then do
m.qrs.0 = ox-1
call write pO, qrs
call writeLn pO, m.qrs.ox
ox = 0
end
end
call mTestOut pT, 'readln 666 records' dsn
call wrClose pO
call readDS pO, 'dsn='dsn
do r=1 while readLn(pO, v2)
if r//123=0 then
call writeLn pT, 'read' r readInfo(pO, '*')':' m.v2
end
call writeLn pT, 'eof at' r readInfo(pO, '*')':' m.v2
call wrClose pT
call mTest pT,
, "--- read 666 records "dsn"",
, "read q 1 line 1 from dss dsn="dsn" disp=old,delete: ze",
|| "ile eins ln "tst" ",
, "read q 2 line 102 from dss dsn="dsn" disp=old,delete: ",
|| "append line 102 ",
, "read q 3 line 203 from dss dsn="dsn" disp=old,delete: ",
|| "append line 203 ",
, "read q 4 line 304 from dss dsn="dsn" disp=old,delete: ",
|| "append line 304 ",
, "read q 5 line 405 from dss dsn="dsn" disp=old,delete: ",
|| "append line 405 ",
, "read q 6 line 506 from dss dsn="dsn" disp=old,delete: ",
|| "append line 506 ",
, "read q 7 line 607 from dss dsn="dsn" disp=old,delete: ",
|| "append line 607 ",
, "eof eof after line 666 from dss dsn="dsn" disp=old,del",
|| "ete",
, "--- sysdsn("dsn") = DATASET NOT FOUND"
call mTestOut pT, 'read 666 records' dsn
call readDs pO, 'dsn='dsn 'disp=old,delete'
do q=1 by 1 while read(pO, myStem)
call writeLn pt, 'read q' q,
readInfo(pO, q-m.myStem.0)':' m.myStem.q
end
call writeLn pt, 'eof' readInfo(pO, q-m.myStem.0)
call mTestOut pT, 'sysdsn('dsn') =' sysdsn(dsn)
call wrClose pT
return
endProcedure mTestIO
/*--- test scan ------------------------------------------------------*/
mTestScan: procedure expose m.
call mTestBegin 'mTestScan 1',
, "scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo''s",
|| "' ",
, "scan name tok a034 key val ",
, "scan char tok , key val ",
, "scan name tok Und key val ",
, "scan space 1 tok key val ",
, "scan name tok hr123sdfER key val ",
, "scan string quo tok ""st1"" key val st1",
, "scan space 1 tok key val ",
, "scan string apo tok 'str2''mit''apo''s' key val st",
|| "r2'mit'apo's",
, "scan space 4 tok key val "
call mTestScan1,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call mTestEnd
call mTestBegin 'mTestScan 2',
, "scan src litEinsfr 23 sR'str1'litZwei ""str2""""mi",
|| "t quo""s ",
, "scan literal tok litEins key val ",
, "scan name tok fr key val ",
, "scan space 1 tok key val ",
, "scan number tok 23 key val ",
, "scan space 1 tok key val ",
, "scan name tok sR key val ",
, "scan string apo tok 'str1' key val str1",
, "scan literal tok litZwei key val str1",
, "scan space 1 tok key val ",
, "scan string quo tok ""str2""""mit quo"" key val st",
|| "r2""mit quo",
, "scan name tok s key val str2""mit quo",
, "scan space 1 tok key val "
call mTestScan1,"litEinsfr 23 sR'str1'litZwei ""str2""""mit quo""s "
call mTestEnd
call mTestBegin 'mTestScan3',
, "scan src aha;+-=f ab=cdEf eF='strIng' ",
, "scan keyValue tok no= key aha val <default>",
, "scan word tok ;+-=f key aha val ;+-=f",
, "scan keyValue tok cdEf key ab val cdEf",
, "scan keyValue tok 'strIng' key eF val strIng",
, "scan no word tok key eF val "
call mTestScan1 w," aha;+-=f ab=cdEf eF='strIng' "
call mTestEnd
call mTestBegin 'scan4: 3 Zeilen mit nextLine',
, "name erste",
, "space",
, "name Zeile",
, "space",
, "nextLine",
, "nextLine",
, "space",
, "name dritte",
, "space",
, "name Zeile",
, "space",
, "name schluss",
, "space"
call mCopyArgs a, 0, 'erste Zeile ',,' dritte Zeile schluss '
call scanStem s, a
do while ^ scanAtEnd(s)
if scanName(s) then call mTestLn 'name' m.tok
else if scanVerify(s, ' ') then call mTestLn 'space'
else if scanNL(s) then call mTestLn 'nextLine'
else call scanErr s, 'not scanned'
end
call mTestEnd
call mTestBegin 'scan5: 3 Zeilen mit spaceLn',
, "name erste",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name dritte",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name schluss",
, "spaceLn"
call scanStem s, a
do while ^ scanAtEnd(s)
if scanName(s) then call mTestLn 'name' m.tok
else if scanSpaceNL(s) then call mTestLn 'spaceLn'
else call scanErr s, 'not scanned'
end
call mTestEnd
call mTestBegin 'scan6: 10 Zeilen mit Kommentar',
, "key abc=efg + 1 ",
, "key efg=2",
, "key j=x",
, "key k=y",
, "key l=schluss",
, "atEnd 1"
call mCopyArgs 'abc', 0,
, " * kommentar ",
, " abc ='efg + 1 ' * komm 2 ",
, " efg * komm 3 ",
, " = * komm 4 ",
, " * komm 5 ",
, " 2 j=x k=y l=* komm 6 ",
, " * komm 7 ",
, " ",
, " schluss ",
, " * end komment "
call scanStem s, 'abc'
call scanOptions s, , , '*'
do while scanKeyValue(s)
call mTestLn 'key' m.key'='m.val
end
call mTestLn 'atEnd' scanAtEnd(s)
call mTestEnd
call mTestTotal
return
endProcedure mTestScan
/*--- one single test scan with lines to scan in stem ln -------------*/
mTestScan1:
parse arg fun ., ln
call mTestLn 'scan src' ln
call scanLine s, ln
do while ^scanAtEnd(s)
if fun = w then do
if scanKeyValue(s, '<default>') then o = 'keyValue '
else if scanword(s) then o = 'word '
else o = 'no word '
end
else if scanLit(s, 'litEins') then o = 'literal '
else if scanLit(s, 'litZwei') then o = 'literal '
else if scanName(s) then o = 'name '
else if scanString(s) then o = 'string apo'
else if scanString(s, '"') then o = 'string quo'
else if scanNum(s) then o = 'number '
else if scanVerify(s, ' ') then o = 'space' length(m.tok)
else if scanChar(s,1) then o = 'char '
else call scanErr s, 'not scanned'
call mTestLn 'scan' o 'tok' m.tok 'key' m.key ,
'val' m.val
end
return
endProcedure mTestScan1
/***********************************************************************
test writer infrastructure
***********************************************************************/
/*--- make writerDescriptor m a testWriter
--- and use remaining lines as compare values -----------------*/
mTestBegin: procedure expose m.
parse arg m.mTest.msg
m.mTest.out.0 = 0
say '*** begin' m.mTest.msg
do cx = 1 to arg()-1
m.mTest.cmp.cx = arg(cx+1)
end
m.mTest.cmp.0 = cx-1
m.mTest.err = 0
return
endProcedure mTestBegin
/*--- write to test: say lines and compare them ----------------------*/
mTestLn: procedure expose m.
parse arg line
ox = m.mTest.out.0 + 1
m.mTest.out.0 = ox
m.mTest.out.ox = line
say left(ox, 4) line
if ox > m.mTest.cmp.0 then do
if ox = m.mTest.cmp.0 + 1 then
call mTestErr 'more new Lines' ox
end
else if m.mTest.out.ox ^== m.mTest.cmp.ox then do
say 'old^^' || m.mTest.cmp.ox
m.mTest.err = m.mTest.err + 1
end
return
endProcedure mTestLn
/*--- close test: check differences and say compare strings ----------*/
mTestEnd: procedure expose m.
parse arg
if m.mTest.cmp.0 ^= m.mTest.out.0 then do
call mTestErr 'old' m.mTest.cmp.0 'lines ^= new' m.mTest.out.0
do nx = m.mTest.out.0 + 1 to ,
min(m.mTest.out.0 + 10, m.mTest.cmp.0)
say 'old--'m.mTest.cmp.nx
end
end
say '***' m.mTest.err 'errors in' m.mTest.msg
if m.mTest.err > 0 then do
say 'new lines:' m.mTest.out.0
len = 60
do nx=1 to m.mTest.out.0
str = quote(m.mTest.out.nx, '"')
pr = ' , '
do while length(str) > len
l=len
if substr(str, l-1, 1) = '"' then
if posCount('"', left(str, l-1)) // 2 = 0 then
l = l-1
say pr left(str, l-1)'",'
str = '"'substr(str, l)
pr = ' ||'
end
say pr str || left(',', nx < m.mTest.out.0)
end
end
if symbol('m.mTest.errTotal') ^== 'VAR' then
m.mTest.errTotal = 0
m.mTest.errTotal = m.mTest.errTotal + m.mTest.err
return
endProcedure mTestEnd
/*--- write a single test message ------------------------------------*/
mTestOut: procedure expose m.
parse arg m, msg
call writeLn m, '---' msg
return
endProcedure mTestOut
/*--- say total errors and fail if not zero --------------------------*/
mTestTotal: procedure expose m.
if m.mTest.errTotal = 0 then
say m.mTest.errTotal 'errors total'
else
call err m.mTest.errTotal 'errors total'
return
endProcedure mTestTotal
/*--- test err: message, count it and continue -----------------------*/
mTestErr: procedure expose m.
parse arg msg
say '*** error' msg
m.mTest.err = m.mTest.err + 1
return
endProcedure mTestErr
/* copy mTest end **************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
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 zIspfRc
back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say 'help for rexx' s3
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
return 4
endProcedure help
/* copy err end *****************************************************/
/* copy mrw begin *****************************************************
interface m mRead and mWrite
mNew
convenience function to write to current output
***********************************************************************/
test: procedure
call mCopyArgs a, 0, 'eins ...', 'zwei ...', 'drei ... schluss'
call mIni
r = mNew()
s = mNew()
call mDefReadFromStem r, a
say 0 mReadLn(r,x) "'"m.x"'"
call mDefReadFromStem s, a
do i=1 to 5
say i mReadLn(r,x) "'"m.x"' read s" mReadLn(s, y) m.y
end
exit
endProcedure
/*--- initialize m ---------------------------------------------------*/
mIni: procedure expose m.
m.mrw.0 = 0
m.mrw.ini = 1
return
endProcedure mIni
mNew: procedure expose m.
m.mrw.0 = m.mrw.0 + 1
return m.mrw.0
endProcedure mNew
mDefRead: procedure expose m.
parse arg m, rexx
m.mrw.m.readLnIx = ''
m.mrw.m.read = rexx
return
endProcedure mDefRead
mRead: procedure expose m.
parse arg m, stem
interpret m.mrw.m.read
endProcedure mRead
/*--- put next line into m.line, return false at eof -----------------*/
mReadLn: procedure expose m.
parse arg m, line
if m.mrw.m.readLnIx == '' ,
| m.mrw.m.readLnIx >= m.mrw.m.readLnStem.0 then do
if ^ mRead(m, 'MRW.'m'.READLNSTEM') then do
m.line = ''
return 0
end
lx = 1
end
else do
lx = 1 + m.mrw.m.readLnIx
end
m.mrw.m.readLnIx = lx
m.line = m.mrw.m.readLnStem.lx
return 1
endProcedure readLn
mDefReadFromStem: procedure expose m.
parse arg m, stem
m.mrw.m.readFromStem = stem
call mDefRead m, 'if m.mrw.m.readFromStem == "" then return 0;' ,
'call mCopyStem stem, 0, m.mrw.m.readFromStem;' ,
'm.mrw.m.readFromStem = "";',
'return 1;'
return
endProcedure mDefReadStem
mReadFromStem: procedure expose m.
parse arg m, stem
si = m.mrw.m.readStem
ix = m.mrw.m.readStemIx + 1
m.mrw.m.readStemIx = ix
if ix <= m.si.0 then do
m.stem = m.si.ix
return 1
end
else do
m.stem = ''
return 0
end
endProcedure mReadFromStem
/**** simple convience function for stems *****************************/
/*--- fill stem st from index dx with lines from stem src ------------*/
mCopyStem: procedure expose m.
parse arg dst, dx, src
if dx == '' then
dx = m.dst.0
do ix = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.ix
end
m.dst.0 = dx
return dst
endProcedure mCopyStmm
/*--- fill stem dst from index dx with arguments ---------------------*/
mCopyArgs: procedure expose m.
parse arg dst, dx
if dx == '' then
dx = m.dst.0
do ix = 3 to arg()
dx = dx + 1
m.dst.dx = arg(ix)
end
m.dst.0 = dx
return dst
endProcedure mCopyArgs
mSay: procedure expose m.
parse arg stem, msg
l = length(m.stem.0)
if l < 3 then
l = 3
say left('', l, '-') msg 'mSay begin stem' stem m.stem.0
do ix = 1 to m.stem.0
say right(ix, l) strip(m.stem.ix, 't')
end
say left('', l, '-') msg 'mSay end stem' stem m.stem.0
return
endProcedure mSayem
/* copy mrw end ****************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line
scanStem(m,ln) : begin scanning all lines in a stem
scanAtEOL(m) : returns whether we reached end of line
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
scanNum(m) : scan integer (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
call scanStart m
return
endProcedure scanLine
/*--- begin scanning the lines of a stem -----------------------------*/
scanStem: procedure expose m.
parse arg m, inStem
call scanStart m
m.scan.m.stem = inStem
m.scan.m.stIx = 0
call scanNL m, 1
return
endProcedure scanStem
/*--- switch to next line if atEOF or argument unCond=1 --------------*/
scanNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then
m.scan.m.pos = 1 + length(m.scan.m.src)
else if m.scan.m.pos <= length(m.scan.m.src) then
return 0
st = m.scan.m.stem
if st == '' then
return 0
ix = m.scan.m.stIx + 1
if ix > m.st.0 then
return 0
m.scan.m.src = m.st.ix
m.scan.m.stIx = ix
m.scan.m.pos = 1
m.scan.m.tok = ''
return 1
endProcedure scanNL
/*--- initialize scanner for m --------------------------------------*/
scanStart: procedure expose m.
parse arg m
m.scan.m.pos = 1
m.tok = ''
m.val = ''
m.key = ''
m.scan.m.stem = ''
if symbol('m.scan.m.Name') ^== 'VAR' then do
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
end
return
endProcedure scanStart
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanStart
if nameOne ^== '' then do
m.scan.m.Name1 = nameOne
if namePlus = '' then
namePlus = '0123456789'
m.scan.m.name = nameOne || namePlus
end
m.scan.m.comment = comm
return
endProcedure scanBegin
/*--- return true/false whether we are at the end of the line --------*/
scanAtEOL: procedure expose m.
parse arg m
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEOL
/*--- return true/false whether we are at the end of the input -------*/
scanAtEnd: procedure expose m.
parse arg m
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
st = m.scan.m.stem
return st == '' | m.st.0 <= m.scan.m.stIx
endProcedure scanAtEnd
/*--- scan len characters --------------------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
m.tok = substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
if nx = m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a number --------------------------------------------------*/
scanNum: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure scanNum
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
/*--- scan a key = word phrase
put key into *.key and word into val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(scanSkip(m)) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.scan.m.tok
say ' charPos' m.scan.m.Pos':',
strip(substr(m.scan.m.src, m.scan.m.Pos), 't')
say ' in line:' strip(m.scan.m.src, 't')
st = m.scan.m.stem
if st ^== '' then
say 'stem' st 'line' m.scan.m.stIx 'of' m.st.0
call err 'scanErr' txt
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
res = 0
cc = m.scan.m.comment
do forever
if scanVerify(m, ' ') then nop
else if scanNL(m) then nop
else if cc == '' then
return res
else if ^ scanLit(m, cc) then
return res
else if ^scanNL(m, 1) then
return res
res = 1
end
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/* copy scan end ****************************************************/
}¢--- A540769.WK.REXX.O08(NAK) cre=2007-05-15 mod=2008-08-28-10.16.52 F540769 ---
/* rexx ****************************************************************
nak what fun list
fun
a allocate libraries
u create unloadLimit0 and info alt neu
i create rebind and free
l create unload load
c copy alt und transform neu lctl, listdef etc.
k copy alt lctl, listdef etc.
r check packages and create remaining rebinds
.2 list: s = show flags, = = ignore packages as bad as befo
d check unload Datasets
drop
***********************************************************************/
parse upper arg what fun list
if what = '' then
parse upper value 'tst u' with what fun
call mIni
m.warn.0 = 0
if userid() = 'A540769' then
m.skels = 'A540769.wk.skels'
else
m.skels = 'ORG.U0009.B0106.KIUT23.SKELS'
m.limit = 1E10
if fun = 'DROP' then do
if substr(what, 5, 1) ^== '.' then
call err "what = 'dbSu.pref' expected not" what 'for drop'
m.dbSys = left(what, 4)
what = substr(what, 6)
m.dPre = 'DSN.DROP.'m.dbSys
call envPut 'MGMTCLAS', 'A008Y000'
m.tas3 = left(what, 2)right(what, 1)
end
else do
m.tas3 = left(what, 2)right(what, 1)
m.task = 'NAK'what
if sysvar('SYSNODE') = 'RZ1' then do
m.dbSys = 'DBAF'
newCreator = 'TSTNAKNE'
call envPut 'MGMTCLAS', 'D008Y000'
m.dPre = 'A540769.TMPNAK.'m.task
m.dPre = 'DSN.'m.task
end
else if 1 then do /* rz2 proc */
m.dbSys = 'DBOF'
newCreator = 'OA1P'
call envPut 'MGMTCLAS', 'A008Y005'
m.dPre = 'DSN.'m.task
end
else do /* transfer rz2 --> rz1 */
m.dbSys = 'DBOF'
newCreator = 'OA1P'
call envPut 'MGMTCLAS', 'D008Y000'
m.dPre = 'SHR21.DIV.P021.'m.task
end
end
nGen = m.dPre'.JCL'
if fun = 'A' then do
if list = '' then
list = '*'
cx = pos('*', list)
if cx > 0 then
list = left(list, cx-1) 'JCL LIST CALT.LCTL CNEU.LCTL' ,
'CALT.LISTDEF CNEU.LISTDEF' substr(list, cx+1)
call allocList m.dPre, list
exit
end
call adrSqlConnect m.dbSys
if fun = 'R' then do
call restartRebind list, nGen"(info)", nGen"(rebinRst)"
exit
end
if fun = 'D' then do
call checkUnloadDS nGen"(info)", m.dPre'.UNL'
exit
end
if fun = 'DROP' then do
call infoDb nGen'('what'DB)'
call infoAlt 'STDKR'
call createJb
call showAlt nGen'('what'info)'
call showSyscopy nGen'('what'SyCo)'
call alias nGen'('what'al)'
call rebind nGen'('what'rebi)', 'REBIND', 'T'
call rebind nGen'('what'free)', 'FREE', ''
call dropAlt nGen'('what'Drop)', 1
call utilList 'PDR', nGen'('what'UPDR)', 1
exit
end
if fun = 'TT' then do
call infoDb nGen'(DB)'
call transformTest
exit
end
else if fun = 'TE' then do
call testExp
exit
end
else if fun = '' | verify(fun, 'IULCKQS') > 0 then
call err 'bad fun "'fun'"'
m.igno.0 = 0
call infoDb nGen'(DB)'
if 0 then
call mShow mGetType('StemDB'), db
aOpt = 'ST'
if verify(fun, 'IU', 'm') > 0 then
aOpt = aOpt'DKR'
else if verify(fun, 'LC', 'm') > 0 then
aOpt = aOpt'D'
call infoAlt aOpt
if verify(fun, 'CUL', 'm') > 0 then do
call infoNeu nGen'(ddlNeu)'
if 0 then
call mShow mGetType('StemNN'), nn
call mapAltNeu newCreator, (verify(fun, 'U', 'm') > 0)
if 0 then
call mShow mGetType('StemTB'), tb
if 0 then
call mShow mGetType('StemNN'), nn
if 0 then
call mShow mGetType('StemJob'), jb
if 1 then
call mShow mGetType('Stem'), igno
end
else do
call createJb
if 0 then
call mShow mGetType('StemJob'), jb
end
if verify(fun, 'IU', 'm') > 0 then do
call showAlt nGen'(info)'
call showSyscopy nGen'(infoSyCo)'
call alias nGen'(alia)'
call utilList 'PDR', nGen'(utilPDR)', 1
call utilList 'COP', nGen'(copyAlt)', 1
call dropAlt nGen'(dbDropAl)'
call count nGen'(CNALT)', 1, m.limit
end
if pos('I', fun) > 0 then do
call rebind nGen'(rebind)', 'REBIND', 'T'
call rebind nGen'(freePkg)', 'FREE', ''
end
if pos('U', fun) > 0 then do
call showNeu nGen'(infoMap)'
call unload 'ULI', nGen'(unloLim0)'
call check 'CHK', nGen'(check)'
call rebind nGen'(rebind)', 'REBIND', 'TOQ'
call utilList 'COP', nGen'(copyNeu)', 0
call count nGen'(cnNeu)', 0, m.limit
end
if pos('L', fun) > 0 then do
call unload 'UNL', nGen'(unload)'
call unload 'UNL', nGen'(unloaSAV)', 'SAV'
call loadLines m.dPre'.ULI'
call load 'LOA', nGen'(load)'
end
sMbrs = 'LCTL LISTDEF PCL DBSP BOLIAL BOLIBS BOLICI',
'BOLICR BOLIPH BOLIPI BOLIRZ BOLIUE BOLIVI BOLIW7 BOLIW8'
if pos('Q', fun) > 0 then do
call ctlTransQQ
end
else if pos('C', fun) > 0 then do
call ctlSearch 'C', nGen'(infoCTL)', m.dPre'.LIST', sMbrs, m.dPre
end
if pos('K', fun) > 0 then do
call ctlSearch 'K', nGen'(infoCTL)', m.dPre'.LIST', sMbrs, m.dPre
end
if pos('S', fun) > 0 then do
call count nGen'(CNALT)', 1, m.limit
end
call adrSqlDisConnect m.dbSys
call warnWrite m.dPre'.JCL'
exit
infoAlt: procedure expose m.
parse arg opt
if pos('S', opt) > 0 then do
call infoTS
if 0 then
call mShow mGetType('StemTS'), ts
if 0 then
do x=1 to m.ts.0
say m.ts.x.db'.'m.ts.x.ts m.ts.x.bp m.ts.x.used
end
end
if pos('T', opt) > 0 then do
call mapReset crNa
call infoTB
if 0 then
call mShow mGetType('StemTB'), tb
if 0 then
do x=1 to m.tb.0
n = m.tb.x.tsNd
say m.tb.x.cr'.'m.tb.x.tb m.tb.x.db'.'m.tb.x.ts n '->' m.n
end
end
if pos('D', opt) > 0 then do
call infoDep
if 0 then
call mShow mGetType('StemDep'), dep
if 0 then
do x=1 to m.dep.0
say m.dep.x.ty m.dep.x.cr'.'m.dep.x.na,
m.dep.x.bTy m.dep.x.bCr'.'m.dep.x.bNa
end
end
if 0 then
call mShow mGetType('Stem'), igno
if pos('K', opt) > 0 then do
call infoPackage
if 0 then
call mShow mGetType('StemPK'), pk
end
if pos('R', opt) > 0 then do
call infoRI
if 0 then
call mShow mGetType('StemRI'), ri
end
return
endProcedure infoAlt
infoDB: procedure expose m.
parse arg inp
call mapReset ii, 'K'
call readDsn inp, c.
dbII = 'in ('
dbNN = 'in ('
con = ''
call mapReset(db.a2n)
call mapReset(db.n2a)
call mTypeNew 'StemDB', mTypeNew(db, '', 'ALT NEU')
m.db.0 = 0
do c=1 to c.0
dbAlt = word(c.c, 1)
dbNeu = word(c.c, 2)
if left(dbAlt, 1) <> '-' then do
dd = mAdd(db, dbAlt'->'dbNeu)
m.dd.alt = dbAlt
m.dd.neu = dbNeu
call mapPut db.a2n, dbAlt, dbNeu
call mapPut db.n2a, dbNeu, dbAlt
dbII = dbII || con || "'"dbAlt"'"
dbNN = dbNN || con || "'"dbNeu"'"
con = ', '
end
else do
call mapAdd ii, translate(dbNeu), dbNeu
end
end
m.dbIn = dbII')'
m.dbInNeu = dbNN')'
say m.db.0 'alte DB' m.dbIn', neue' m.dbInNeu
call mShow mGetType('Stem'), mapKeys(ii)
return
endProcedure infoDB
isIgnored: procedure expose m.
parse upper arg ty, qu, na
if pos(ty, 'VTA') > 0 then do
if mapHasKey(ii, 'C.'qu) then
return 1
end
if mapHasKey(ii, ty'.'qu'.'na) then
return 1
return 0
endProcedure isIgnored
infoTS: procedure expose m.
root = 'TS'
flds = DB TS NTB PARTS BP USED
if mDefIfNot(root'.'0, 0) then do
call mTypeNew 'StemTS', mTypeNew(ts, '', flds 'TBSQ')
call mapReset root
end
sqlFlds = sqlFields(flds)
sql = "select dbName, name, nTables, partitions," ,
"bPool, float(nActive)*pgSize*1024" ,
"from sysibm.systablespace",
"where dbname" m.dbIn ,
"order by 1, 2 "
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
tbSQ = ''
do c=1 by 1
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars flds
if isIgnored('S', db, ts) then do
call mAdd igno, 'alt S' db'.'ts
iterate
end
used = format(used,2,3,2,0)
nd = mPutVars(mAdd(root, db'.'ts), flds 'TBSQ')
call mapAdd root, db'.'ts, nd
end
call adrSql 'close c1'
say m.root.0 'tablespaces'
return
endProcedure infoTS
infoTB: procedure expose m.
root = tb
flds = cr tb db ts
xFlds = tsNd newNd
if mDefIfNot(root'.'0, 0) then do
call mTypeNew 'StemTB', mTypeNew(tb, '', flds xflds)
call mapReset root
end
newNd = ''
sqlFlds = sqlFields(flds)
sql = "select creator, name, dbName, tsName",
"from sysibm.systables",
"where dbname" m.dbIn "and type = 'T'"
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
do forever
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars flds
if isIgnored('T', cr, tb) then do
call mAdd igno, 'alt T' cr'.'tb 'in' db'.'ts
iterate
end
tsNd = mapGet('TS', db'.'ts)
nd = mPutVars(mAdd(root, cr'.'tb), flds xFlds)
m.tsNd.tbSq = m.tsNd.tbSq nd
if mapHasKey(root, tb) then
call err '??? duplicate table' cr'.'tb
else
call mapAdd root, tb, nd
call mapAdd crNa, cr'.'tb, nd
end
call adrSql 'close c1'
say m.root.0 'tables'
return
endProcedure infoTb
stripVars:
parse arg ggList
do ggX=1 to words(ggList)
ggW = word(ggList, ggX)
x=value(ggW, strip(value(ggW)))
end
return
endSubroutine stripVars
infoDep: procedure expose m.
flds = ty cr na bTy bCr bNa
if mDefIfNot(dep'.'0, 0) then
call mTypeNew 'StemDep', mTypeNew('Dep', '', flds 'NEWND ACT')
sqlFlds = sqlFields(flds)
newNd = ''
act = ''
call envPut 'DBIN', m.dbin
sql = skel2sql('nakDep')
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
do forever
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars flds
if isIgnored(ty, cr, na) then do
call mAdd igno, 'alt dep' ty cr'.'na 'from' bTy bCr'.'bNa
end
else if mapHasKey(crNa, cr'.'na) then do
qTy = 'TY'
qBTy = 'BTY'
qbCr = 'BCR'
qbNa = 'BNA'
oo = mapGet(crNa, cr'.'na)
if left(oo, 3) = 'TB.' then do
if ty = 'T' & bTy = '.' & bNa = m.oo.db then
nop /* say 'old table in dep' cr'.'na */
else
call err 'dep with name of old table' ty cr'.'na
end
else if ty ^== m.oo.qTy then
call err 'new dep' m.oo.qTy cr'.'na 'mismatches old' ,
m.oo.qTy m.oo
else if (ty == 'A'| ty == 'Y') ,
& ^ (bTy == m.oo.qBty & bCr == m.oo.qBcr ,
& bNa == m.oo.qBNa) then
call err 'dep with duplicate different al/sy' cr'.'na ,
'b' bTy bCr'.'bNa ,
'oo' m.oo.qBty m.oo.qBcr'.'m.oo.qBNa
else if 0 then
say 'skipping duplicate' cr'.'na
end
else do
nd = mPutVars(mAdd(dep, cr'.'na), flds 'NEWND' 'ACT')
call mapAdd crNa, cr'.'na, nd
end
end
call adrSql 'close c1'
say m.dep.0 'dependencies'
return
endProcedure infoDep
infoNeu: procedure expose m.
parse arg ddlNeu
flds = cr na ty for oldNd oldAl
if mDefIfNot(nn.0, 0) then do
call mapReset(nn)
call mTypeNew 'StemNN', mTypeNew('NN', '', flds)
end
oldNd = ''
oldAl = ''
r = jDsn(ddlNeu)
call jOpen r, 'r'
call scanReader scanSqlIni(s), r
lastX = 0
do forever
if lastX = m.scan.s.lineX then
if ^ scanNl(s, 1) then
leave
lastX = m.scan.s.lineX
if pos('CREATE', translate(m.scan.s.src)) < 1 then
iterate
fnd = 0
linePos = scanLinePos(s)
do while lastX = m.scan.s.lineX & ^fnd
if scanSql(scanSkip(s)) = '' then
leave
fnd = m.sqlType = 'i' & m.val == 'CREATE'
end
if ^ fnd then do
say 'no create, ignoring' linePos
iterate
end
if scanSqlId(scanSkip(s)) == '' then do
say 'no sqlId, ignoring line' lastx strip(m.scan.s.src)
iterate
end
subTy = ''
if wordPos(m.val, 'UNIQUE LARGE LOB') > 0 then do
subTy = m.val
plus = ''
if subTy = 'UNIQUE' then
plus = 'WHERE NOT NULL'
do wx=1 by 1
if scanSqlId(scanSkip(s)) == '' then
call scanErr s, 'no sqlId after create' subTy
else if m.val = word(plus, wx) then
subTy = subTy m.val
else if wx=1 | wx > words(plus) then
leave
else
call scanErr s, 'stopped in middle of' plus
end
end
ty = m.val
m.scan.s.sqlBrackets = 0
if scanSqlQuId(scanSkip(s)) == '' then
call scanErr s, 'no qualId after create' subTy ty
na = m.val
na1 = m.val.1
na2 = m.val.2
for = '-'
if ty = 'ALIAS' then do
if scanSqlId(scanSkip(s)) ^== 'FOR' then
call scanErr s, 'IN expected after create' ty
if scanSqlQuId(scanSkip(s)) == '' then
call scanErr s, 'table name expected after create' ty na
for = m.val
ty = 'A'
end
else if ty = 'INDEX' then do
if scanSqlId(scanSkip(s)) ^== 'ON' then
call scanErr s, 'IN expected after create' ty
if scanSqlQuId(scanSkip(s)) == '' then
call scanErr s, 'table name expected after create' ty na
for = m.val
ty = 'X'
end
else if ty = 'TABLE' then do
do while ^ (m.scan.s.sqlBrackets = 0 & m.sqlType = 'i' ,
& m.val == 'IN')
if scanSql(scanSkip(s)) = '' | m.tok == ';' then
call scanErr s, 'in database expected'
end
if scanSqlQuId(scanSkip(s)) == '' | m.val = 'DATABASE' then
call scanErr s, 'ts name expected after create' ty na
for = m.val
ty = 'T'
end
else if ty = 'TABLESPACE' then do
if scanSqlId(scanSkip(s)) ^== 'IN' then
call scanErr s, 'IN expected after create' ty
if scanSqlDeId(scanSkip(s)) == '' then
call scanErr s, 'db name expected after create' ty
na = m.val'.'na
ty = 'S'
end
else if ty = 'VIEW' then do
ty = 'V'
for = ''
end
if 0 then
say 'create' subTy ty 'name' na 'for' for
if for == '-' then do
end
else if isIgnored(ty, na1, na2) then do
call mAdd igno, 'neu ' ty na 'for' for
end
else do
nd = mPut(mAdd(nn, na), flds, na1, na2, ty, for)
call mapAdd nn, na, nd
end
end
call jClose r
return
endProcedure infoNeu
infoRI: procedure expose m.
flds = cr tb db ts bCr bTb bDb bTS rNa
if mDefIfNot(ri.0, 0) then
call mTypeNew 'StemRI', mTypeNew('RI', '', flds)
sql = "select r.creator, r.tbName, td.dbName, td.tsName" ,
", refTbcreator, refTbName, tr.dbName, tr.tsName, relName",
"from sysibm.sysrels r, sysibm.sysTables td, sysibm.sysTables tr",
"where r.creator = td.creator and r.tbName = td.name",
"and r.refTbcreator = tr.creator and r.reftbName = tr.name"
sql = sql "and td.dbname" m.dbIn ,
'union' sql "and tr.dbname" m.dbIn
sqlFlds = sqlFields(flds)
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
do forever
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars flds
nd = mPutVars(mAdd(ri, cr'.'tb'.'rNa), flds)
end
call adrSql 'close c1'
say m.ri.0 'references'
return
endProcedure infoRI
infoPackage: procedure expose m.
flds = timeStamp pcTimestamp type,
validate isolation valid operative owner qualifier
fldStr = collid Name version flds
flds = collid Name version conToken flds
if mDefIfNot(pk.0, 0) then do
call mTypeNew 'StemPK', mTypeNew('PK', '', flds 'ACT')
call mapReset pkMap
end
call envPut 'DBIN', m.dbIn
sql = skel2sql('nakPckg')
sqlFlds = sqlFields(flds)
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
cVa = 0
cOp = 0
act = ''
do c=1 by 1
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars fldStr
nd = mPutVars(mAdd('PK', collid'.'name), flds 'ACT')
call mapAdd pkMap, collid'.'name'.'conToken, nd
if valid = 'Y' then
cVa = cVa + 1
if operative = 'Y' then
cOp = cOp + 1
end
call adrSql 'close c1'
say (c-1) 'packages,' cVa 'valid,' cOp 'operative'
return
endProcedure infoPackage
showSyscopy: procedure expose m.
parse arg out
m.o.0 = 0
call envPut 'DBIN', m.dbIn
sql = skel2Sql('nakSysCo')
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
do c=1 by 1
call adrSql 'fetch c1 into :job, :ty, :cnt, :tst'
if sqlCode = 100 then
leave
call mAdd o, left(job, 8) left(ty, 1) right(cnt, 9) tst
end
call adrSql 'close c1'
call writeDsn out, m.o., , 1
return
endProcedure showSyscopy
skel2Sql: procedure expose m.
parse arg skel
call readDsn m.skels'('skel')', m.skel2Sql.i.
call leftSt skel2Sql.i, 72
m.skel2Sql.o.0 = 0
call envExpAll skel2Sql.o, skel2Sql.i
return catStripSt(skel2Sql.o)
endProcedure skel2Sql
catStripSt: procedure expose m.
parse arg m
r = ''
mid = ''
do x=1 to m.m.0
r = r || mid || strip(m.m.x)
mid = ' '
end
return r
endProcedure catStripSt
leftSt: procedure expose m.
parse arg m, le
do x=1 to m.m.0
m.m.x = left(m.m.x, 72)
end
return m
endProcedure leftSt
mapAltNeu: procedure expose m.
parse arg newCr, doQ
do tx=1 to m.tb.0
cc = tb'.'tx
if ^ mapHasKey(nn, newCr'.'m.cc.tb) then
call err 'old table' m.cc 'has no corr. new'
dd = mapGet(nn, newCr'.'m.cc.tb)
if ^mapHasKey(db.a2n, m.cc.db) then
call err 'old table' m.cc 'ts in bad db' m.cc.db'.'m.cc.ts
if m.dd.oldNd ^== '' then
call err 'old table' m.cc 'maps to new' m.dd ,
'which already maps to' m.dd.oldNd
nTs = m.dd.for
if mapGet(db.a2n, m.cc.db) <> left(nTs, pos('.', nTs)-1) then
call err 'new table' m.dd 'in wrong db' nTs
m.cc.newNd = dd
m.dd.oldNd = cc
end
qDep = ''
do dx=1 to m.dep.0
dd = dep'.'dx
a = m.dd.ty
if ^ mapHasKey(nn, newCr'.'m.dd.na) then do
if a <> 'A' & a <> 'Y' then
call err 'old dep' a m.dd 'has no corr. new'
m.dd.act = 'q'
qDep = qDep "or (bQualifier = '"m.dd.cr"'" ,
"and bName = '"m.dd.na"')"
iterate
end
ww = mapGet(nn, newCr'.'m.dd.na)
if a == 'V' then do
if m.ww.ty ^== 'V' then
call err 'old view' m.dd 'maps to' m.ww.ty m.ww
if m.ww.oldNd ^== '' then
call err 'old view' m.dd 'maps to' m.ww.ty m.ww ,
'which is already mapped to' m.ww.oldNd
m.ww.oldNd = dd
m.dd.newNd = ww
end
else if (a == 'A' | a == 'Y') then do
if m.dd.na ^== m.dd.bNa then
call err 'bad old alias' m.dd ,
'for' m.dd.bCr'.'m.dd.bNa
m.ww.oldAl = m.ww.oldAl m.dd
end
else do
call err 'bad dep type' m.dd.ty m.dd
end
end
do nx=1 to m.nn.0
ww = nn'.'nx
if m.ww.ty = 'T' | m.ww.ty = 'V' then do
oo = m.ww.oldNd
if oo == '' then
call err 'no old for new' m.ww.ty m.ww
else if m.oo.cr ^== newCr & m.ww.oldAl = '' then
call warn 'no old alias for new obj' m.ww.ty m.ww
end
end
do otX=1 to m.tb.0
ot = 'TB.'otX
os = m.ot.tsNd
osNa = m.os
nt = m.ot.newNd
ns = m.nt.for
if symbol('os.os') ^== 'VAR' then do
os.os = ns
m.oldTs.osNa = ns
end
else if wordPos(ns, os.os) < 1 then do
os.os = os.os ns
m.oldTs.osNa = os.os
end
if symbol('ns.ns') ^== 'VAR' then do
ns.ns = os
nt.ns = nt
end
else do
if ns.ns ^== os then
call err 'new TS maps to old' ns.ns 'and' os
if wordPos(nt, nt.ns) < 1 then
nt.ns = nt.ns nt
end
end
do tx=1 to m.ts.0
tt = ts'.'tx
newSq = ''
do nsX=1 to words(os.tt)
ns = word(os.tt, nsX)
do ntx=1 to words(nt.ns)
nt = word(nt.ns, ntX)
newSq = newSq m.nt.oldNd
end
end
/* say 'ts' m.tt 'seq' m.tt.tbSq '-->' newSq */
m.tt.tbSq = newSq
end
call createJb
if doQ & qDep <> '' then do
m.o.0 = 0
call mAdd o, 'select * from RZ2.TACCT_PKGUSED where'
pre = ' '
sql = "select dCollid, dName, dConToken" ,
"from sysibm.syspackdep",
"where (not bType in ('P', 'R')) and" ,
"(" substr(qDep, 5) ")"
flds = co na ct
sqlFlds = sqlFields(flds)
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
do c=1 by 1
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars 'CO NA'
if ^ mapHasKey(pkMap, co'.'na'.'ct) then
call err 'q package' co'.'na'.'ct 'not in dep'
dd = mapGet(pkMap, co'.'na'.'ct)
if m.dd.act ^== 'q' then do
m.dd.act = 'q'
call mAdd o, pre "(PCK_ID = '"na"' AND" ,
"PCK_CONSIST_TOKEN = '"c2x(ct)"')"
pre = ' or'
end
end
call adrSql 'close c1'
call writeDsn m.dPre'.JCL(QPKGSQL)', m.o., , 1
end
return
endProcedure mapAltNeu
createJb: procedure expose m.
m.jb.0 = 0
call mTypeNew 'StemJob', mTypeNew('Job', '', 'JOB TBND')
if m.task = 'NAKCD01' then
bLim = 4E+9
else
bLim = 1E+9
tLim = 30
tbs = 0
bys = 0
jobNo = 1
do tx=1 to m.ts.0
tt = ts'.'tx
if tbs > 0 & (bys + m.tt.used > bLim ,
| tbs + m.tt.nTb > tLim) then do
jobNo = jobNo + 1
bys = 0
tbs = 0
end
if m.tt.nTb < 1 then do
call warn 'skipping ts' m.tt 'without tables' m.tt.nTb
iterate
end
bys = bys + m.tt.used
tbs = tbs + m.tt.nTb
do nsX=1 to words(m.tt.tbSq)
ot = word(m.tt.tbSq, nsX)
if symbol('m.ot') ^== 'VAR' then
call err 'oldTable' ot 'undefined in TS' m.tt tt
call mPut mAdd(jb, m.ot), 'JOB TBND', jobNo, ot
end
end
return
endProcedure createJb
showAlt: procedure expose m.
parse arg out
m.o.0 = 0
do dx=1 to m.db.0
dd = db'.'dx
call mAdd o, 'mD' left(m.dd.alt, 20)left(m.dd.neu, 20)
end
do tx=1 to m.tb.0
tt = 'TB.'tx
ss = m.tt.tsNd
l = 'oT' left(m.tt, 20)left(m.ss, 20) m.ss.used,
right(m.ss.ntb, 4) || right(m.ss.parts, 4) m.ss.bp
call mAdd o, l
end
do dx=1 to m.dep.0
dd = dep'.'dx
ww = m.dd.newNd
tp = m.dd.ty
if tp == 'V' then do
l = 'mV' left(m.dd, 20)left(m.ww, 20)
end
else if tp == 'A' | tp == 'Y' then do
l = m.dd.act
if l = '' then
l = 'd'
else if length(l) <> 1 | l = 'd' then
call err 'bad dep act' l 'for' m.dd
l = l || tp left(m.dd, 30)left(m.dd.bCr'.'m.dd.bNa, 30)
end
else do
call err 'bad ty in dep' m.dd.ty m.dd
end
call mAdd o, l
end
do rx=1 to m.ri.0
rr = ri'.'rx
if ^mapHasKey(db.a2n, m.rr.db) ,
| ^mapHasKey(db.a2n, m.rr.bDb) then
call err 'implement external ri' m.rr ,
'->' m.rr.bCr'.'m.rr.bTb
/* q = '|f' */
else if m.rr.db <> m.rr.bDb then
q = '|d'
else
q = '= '
call mAdd o, 'mR' left(m.rr.cr'.'m.rr.tb, 20) ,
|| left(m.rr.bCr'.'m.rr.bTb, 20) q m.rr.rNa
end
do px=1 to m.pk.0
p = 'PK.'px
if m.p.act = '' then
aa = 'pk'
else if (length(m.p.act) <> 1 | m.p.act = 'k') then
call err 'bad pk act' m.p.act
else
aa = m.p.act'k'
call mAdd o, aa left(m.p.collid'.'m.p.name, 17) ,
left(c2x(m.p.conToken), 16) substr(m.p.pcTimeStamp, 3,8),
left(m.p.validate, 1)left(m.p.isolation, 1),
|| left(m.p.valid, 1)left(m.p.operative, 1),
left(m.p.qualifier,8) left(m.p.owner, 8)
end
call writeDsn out, m.o., ,1
return
endProcedure showAlt
showNeu: procedure expose m.
parse arg out
m.o.0 = 0
do jx=1 to m.jb.0
jj = 'JB.'jx
tt = m.jj.tbNd
ww = m.tt.newNd
l = 'mt'right(m.jj.job, 4) left(m.tt, 20)left(m.ww, 20),
|| left(m.tt.ts, 8) m.ww.for
call mAdd o, l
end
call writeDsn out, m.o., ,1
return
endProcedure showNeu
alias: procedure expose m.
parse arg out
m.dr.0 = 0
m.cr.0 = 0
c = 0
call sqlId cr, dr
do dx=1 to m.dep.0
dd = dep'.'dx
if m.dd.ty ^== 'A' then
iterate
c = c + 1;
if c // 50 = 0 then
call commit cr, dr
call mAdd dr, 'DROP ALIAS' m.dd';'
call mAdd cr, 'CREATE ALIAS' m.dd 'FOR' m.dd.bCr'.'m.dd.bNa';'
end
call commit cr, dr
mb = dsnGetMbr(out)
call writeDsn dsnSetMbr(out, left(mb'CREATE', 8)), m.cr., ,1
call writeDsn dsnSetMbr(out, left(mb'DROPPP', 8)), m.dr., ,1
return
endProcedure alias
commit: procedure expose m.
do ax=1 to arg()
call mAdd arg(ax), 'COMMIT;'
end
return
endProcedure commit
sqlId: procedure expose m.
do ax=1 to arg()
call mAdd arg(ax), "SET CURRENT SQLID = 'S100447';"
end
return
endProcedure sqlId
unload: procedure expose m.
parse arg fun, out, suFu
call readDsn m.skels'(nakJobCa)', m.jc.
call readDsn m.skels'(nak'fun'Ut)', m.skSt.
call readDsn m.skels'(nak'fun'TS)', m.skTs.
call readDsn m.skels'(nak'fun'Tb)', m.skTb.
m.o.0 = 0
jj = ''
call envPut 'STEP', 'S01'
call envPut 'DBSYS', m.dbSys
if suFu = '' then
call envPut 'DSNPRE', m.dPre'.'fun
else
call envPut 'DSNPRE',
, overlay(suFu, m.dPre, pos('NAK', m.dPre))'.'suFu
jOld = 0
do jx=1 to m.jb.0
jj = 'JB.'jx
if oldJob <> m.jj.job then do
if jx > 1 then
say 'job' fun oldJob':' (jx-jOld) 'tables'
jOld = jx
oldJob = m.jj.job
if suFu = '' then
call envPutJOBNAME fun, oldJob
else
call envPutJOBNAME suFu, oldJob
call envExpAll o, jc
call envExpAll o, skSt
end
ot = m.jj.tbNd
os = m.ot.tsNd
if oldOs <> os then do
oldOs = os
call envPut 'TS', m.os
if m.os.parts = 0 then do
call envPut 'PARTONE', ''
call envPut 'PAUN', 'UN'
end
else do
call envPut 'PARTONE', 'PART 1'
call envPut 'PAUN', 'PA'
end
call envExpAll o, skTS
end
call envPut 'TB', m.ot
call envExpAll o, skTb
end
say 'job' fun oldJob':' (jx-jOld) 'tables'
call writeDsn out, m.o., ,1
return
endProcedure unload
loadLines: procedure expose m.
parse arg punPre
do sx=1 to m.ts.0
ss = ts'.'sx
pun = punPre'.'m.ss.db'.'m.ss.ts'.PUN'
call readDsn pun, p.
wh = ''
tbCnt = 0
do p=1 to p.0
w1 = word(p.p, 1)
if w1 = 'LOAD' then do
wh = 'l'
end
else if w1 = 'INTO' then do
if word(p.p, 2) ^== 'TABLE' then
call err 'TABLE expected in line' p 'in' pun':' p.p
w3 = word(p.p, 3)
dx = pos('.', w3)
if dx < 1 then
call err '. expected in w3 line' p 'in' pun':' p.p
crTb = strip(left(w3, dx-1), 'b', '"')'.',
||strip(substr(w3, dx+1), 'b', '"')
if ^ mapHasKey(crNa, crTb) then
call err 'old table' crTb 'not found' ,
'for punchLine' p 'in' pun':' p.p
tt = mapGet(crNa, crTb)
if m.tt.tsNd ^== ss then
call err 'old table' crTb ,
'wrong ts' m.tt.db'.'m.tt.ts,
'for punchLine' p 'in' pun':' p.p
if ^mDefIfNot(tt'.LO.0', 0) then
call err 'already loaded table' crTb ,
'for punchLine' p 'in' pun':' p.p
tbCnt = tbCnt + 1
if m.ss.parts == 0 then
wh = 'i'
else
wh = 'p'
end
else if w1 = 'PART' then do
if wh = 'p' then
wh = 'i'
else
call err 'PART in unpartitioned TS' m.tt.ts,
'for punchLine' p 'in' pun':' p.p
end
else if w1 = ')' then do
if strip(p.p) <> ')' then
call err 'bad ) line' p 'in' pun':' p.p
if wh <> 'i' then
call err ') in state' wh 'line' p 'in' pun':' p.p
call mAdd tt'.LO', p.p
wh = ''
end
else if wh == 'i' then do
call mAdd tt'.LO', p.p
end
else if wh == 'l' then do
if w1 ^== 'EBCDIC' then
call err 'bad line after load' ,
'in punchLine' p 'in' pun':' p.p
end
end
if wh ^== '' then
call err 'punch' pun 'ends in state' wh
if tbCnt <> m.ss.nTb then
call err tbCnt 'tables not' m.ss.nTb 'loaded for' m.ss
say 'loadCards for' tbCnt 'tables for' m.ss
end
return
endProcedure loadLines
load: procedure expose m.
parse arg fun, out
call readDsn m.skels'(nakJobCa)', m.jc.
call readDsn m.skels'(nak'fun'Ut)', m.skSt.
call readDsn m.skels'(nak'fun'OS)', m.skOs.
call readDsn m.skels'(nak'fun'TS)', m.skTs.
call readDsn m.skels'(nak'fun'Tb)', m.skTb.
m.o.0 = 0
jj = ''
call envPut 'STEP', 'S01'
call envPut 'DBSYS', m.dbSys
call envPut 'DSNPRE', m.dPre'.UNL'
do jx=1 to m.jb.0
jj = 'JB.'jx
if oldJob <> m.jj.job then do
if jx > 1 then
say 'job' fun oldJob':' (jx-jOld) 'tables'
jOld = jx
oldJob = m.jj.job
call envPutJOBNAME fun, oldJob
call envExpAll o, jc
call envExpAll o, skSt
end
ot = m.jj.tbNd
os = m.ot.tsNd
nt = m.ot.newNd
ns = m.nt.for
if oldOS ^== os then do
oldOS = os
tRec = 'TREC' || jx
call envPut 'TREC', tRec
call envPut 'OLDDB', m.os.db
call envPut 'OLDTS', m.os.ts
if m.os.parts = 0 then do
call envPut 'PAVAR',''
call envPut 'UNPARTDDN', 'INDDN' tRec
end
else do
call envPut 'PAVAR','P&PA..'
call envPut 'UNPARTDDN', ''
end
call envExpAll o, skOS
end
if oldNS ^== ns then do
oldNS = ns
call envPut 'TS', ns
call envExpAll o, skTs
end
call envPut 'TB', m.nt
if m.os.parts = 0 then do
call envPut 'PARTDDN', ''
call envExpAll o, skTb
call mAddSt o, ot'.LO'
end
else do
do px=1 to m.os.parts
call envPut 'PARTDDN', 'PART' px 'INDDN' tRec
call envExpAll o, skTb
call mAddSt o, ot'.LO'
end
end
end
say 'job' fun oldJob':' (jx-jOld) 'tables'
call writeDsn out, m.o., ,1
return
endProcedure load
check: procedure expose m.
parse arg fun, out
call readDsn m.skels'(nakJobCa)', m.jc.
call readDsn m.skels'(nak'fun'Ut)', m.skut.
call readDsn m.skels'(nak'fun'Ts)', m.skts.
call envPut 'STEP', 'S01'
call envPut 'DBSYS', m.dbSys
call envPutJOBNAME 'CHCK'
m.o.0 = 0
call envExpAll o, jc
call envExpAll o, skUt
do rx=1 to m.ri.0
rr = 'RI.'rx
cn = m.rr.cr'.'m.rr.tb
if mapHasKey(crNa, cn) then do
ot = mapGet(crNa, cn)
nt = m.ot.newNd
dbTs = m.nt.for
end
else do
call err 'implement check on foreign table'
end
if R.dbTs == 1 then
iterate
R.dbTs = 1
call envPut 'TS', dbTs
call envExpAll o, skTs
end
call writeDsn out, m.o., ,1
return
endProcedure check
utilList: procedure expose m.
parse arg fun, out, useOld
call readDsn m.skels'(nakJobCa)', m.jc.
call readDsn m.skels'(nakLstUt)', m.skUt.
call readDsn m.skels'(nakLstTs)', m.skTS.
call readDsn m.skels'(nak'fun')', m.skFu.
m.o.0 = 0
jj = ''
call envPut 'STEP', 'S01'
call envPut 'DBSYS', m.dbSys
do jx=1 to m.jb.0
jj = 'JB.'jx
if oldJob <> m.jj.job then do
if jx > 1 then
call envExpAll o, skFu
oldJob = m.jj.job
call envPutJOBNAME fun, oldJob
call envExpAll o, jc
call envExpAll o, skUt
end
ot = m.jj.tbNd
if useOld then do
os = m.ot.tsNd
ts = m.os
end
else do
nt = m.ot.newNd
ts = m.nt.for
end
if ts.ts = 1 then
iterate
ts.ts = 1
call envPut 'TS', ts
call envExpAll o, skTS
end
if jx > 1 then
call envExpAll o, skFu
call writeDsn out, m.o., ,1
return
endProcedure utilList
envPutJobname: procedure expose m.
parse arg fun, jobNo
jobChars = '0123456789ABCDEF'
if jobNo = '' then
n = 'Y' || m.tas3 || left(fun, 4, 'Z')
else
n = 'Y' || m.tas3 || left(fun, 3, 'Z') ,
|| substr(jobChars, 1 + (jobNo // length(jobChars)), 1)
call envPut 'JOBNAME', n
return
endProcedure envPutJobname
dropAlt: procedure expose m.
parse upper arg out, dropOnly
m.o.0 = 0
call mAdd o, "bist Du wirklich sicher ?"
call mAdd o, "set current sqlId = 'q100447';"
do ddx=1 to m.db.0
dd = 'DB.'ddx
call mAdd o, 'xrop database' m.dd.alt';'
call mAdd o, 'commit;'
end
call writeDsn out, m.o., ,1
if dropOnly == 1 then
return
call readDsn m.skels'(nakJobCa)', m.jc.
m.o.0 = 0
call envPutJOBNAME 'DBDROP'
call envExpAll o, jc
call dsnTep2 o, 'SDROP', out, '*'
call writeDsn m.dPre'.JCL(DBDROPAJ)', m.o., ,1
m.o.0 = 0
call envPutJobname 'DDLNEU'
call envExpAll o, jc
call dsnTep2 o, 'SCREA', m.dPre'.JCL(DDLNEU)', '*'
call writeDsn m.dPre'.JCL(DDLNEUJ)',m.o., ,1
m.o.0 = 0
call envPutJobname 'REBIND'
call envExpAll o, jc
call db2Dsn o, 'SCREA', m.dPre'.JCL(REBIND)', '*'
call writeDsn m.dPre'.JCL(REBINDJ)',m.o., ,1
return
endProcedure dropAlt
count: procedure expose m.
parse upper arg out, useOld, lim
outMb = dsnGetMbr(out)
if useOld then
call envPut 'DBIN', m.dbIn
else
call envPut 'DBIN', m.dbInNeu
if symbol('m.cnWit.0') ^== 'VAR' then do
call readDsn m.skels'(nakCnWit)', m.cnWit.
call readDsn m.skels'(nakCnRun)', m.cnRun.
call readDsn m.skels'(nakCnRts)', m.cnRts.
call readDsn m.skels'(nakCnSQL)', m.cnSQL.
call readDsn m.skels'(nakCnSQ2)', m.cnSQ2.
call readDsn m.skels'(nakJobCa)', m.cnJC.
end
m.o.0 = 0
call envExpAll o, cnWit
call envExpAll o, cnRun
m.o2.0 = 0
call splitSql o2, o
call writeDsn dsnSetMbr(out, outMb'RUN'), m.o2., ,1
m.o.0 = 0
call envExpAll o, cnWit
call envExpAll o, cnRts
m.o2.0 = 0
call splitSql o2, o
call writeDsn dsnSetMbr(out, outMb'RTS'), m.o2., ,1
m.o.0 = 0
call envExpAll o, cnWit
call envExpAll o, cnSQL
pre = ' '
if lim = '' then
lim = 9E99
ovLim = ''
do tx = 1 to m.tb.0
s = m.tb.tx.tsNd
if m.s.used > lim then do
ovLim = ovLim m.tb.tx.tb
end
else do
if useOld then do
call mAdd o, pre "select '"m.tb.tx.cr"', '"m.tb.tx.tb"'," ,
'count(*) from' m.tb.tx
end
else do
nt = m.tb.tx.newNd
call mAdd o, pre "select '"m.nt.cr"', '"m.nt.na"'," ,
'count(*) from' m.nt
end
pre = 'union'
end
end
call warn words(ovLim) 'tables over limit' lim 'of' m.tb.0':' ovLim
call envExpAll o, cnSQ2
m.o2.0 = 0
call splitSql o2, o
call writeDsn dsnSetMbr(out, outMb'SQL'), m.o2., ,1
call envPut 'DBSYS', m.dbSys
call envPutJobname outMb
m.o.0 = 0
call envExpAll o, cnJC
call dsnTep2 o, 'SRUN', m.dPre'.JCL('outMb'RUN)',
, m.dPre'.LIST('outMb'RUJ)'
call dsnTep2 o, 'SRTS', m.dPre'.JCL('outMb'RTS)',
, m.dPre'.LIST('outMb'RTJ)'
call dsnTep2 o, 'SSQL', m.dPre'.JCL('outMb'SQL)',
, m.dPre'.LIST('outMb'SQJ)'
/* call envPut 'STEP', 'SRUN'
call envPut 'DSNIN', 'DISP=SHR,DSN='m.dPre'.JCL('outMb'RUN)'
call envPut 'DSNOUT', 'DISP=SHR,DSN='m.dPre'.LIST('outMb'RUJ)'
call envExpAll o, cnTep2
call envPut 'STEP', 'SRTS'
call envPut 'DSNIN', 'DISP=SHR,DSN='m.dPre'.JCL('outMb'RTS)'
call envPut 'DSNOUT', 'DISP=SHR,DSN='m.dPre'.LIST('outMb'RTJ)'
call envExpAll o, cnTep2
call envPut 'STEP', 'SSQL'
call envPut 'DSNIN', 'DISP=SHR,DSN='m.dPre'.JCL('outMb'SQL)'
call envPut 'DSNOUT', 'DISP=SHR,DSN='m.dPre'.LIST('outMb'SQJ)'
call envExpAll o, cnTep2
*/ call writeDsn dsnSetMbr(out, outMb'J'), m.o., ,1
return
endProcedure count
dsnTep2: procedure expose m.
parse arg o, st, in ,out
if symbol('m.dsnTep2.0') ^== 'VAR' then
call readDsn m.skels'(nakTep2)' , m.dsnTep2.
call envPut 'STEP', st
call envPut 'DSNIN', 'DISP=SHR,DSN='in
if out == '*' then
call envPut 'DSNOUT', 'SYSOUT=*'
else
call envPut 'DSNOUT', 'DISP=SHR,DSN='out
call envExpAll o, dsnTep2
return
endProcedure dsnTep2
db2Dsn: procedure expose m.
parse arg o, st, in ,out
if symbol('m.db2Dsn.0') ^== 'VAR' then
call readDsn m.skels'(nakDsn)' , m.db2Dsn.
call envPut 'STEP', st
call envPut 'DSNIN', 'DISP=SHR,DSN='in
if out == '*' then
call envPut 'DSNOUT', 'SYSOUT=*'
else
call envPut 'DSNOUT', 'DISP=SHR,DSN='out
call envExpAll o, db2Dsn
return
endProcedure db2Dsn
splitSql: procedure expose m.
parse arg d, s
do sx=1 to m.s.0
l = strip(m.s.sx, 't')
do while length(l) > 71
cx = lastPos(", ", left(l, 72))
if cx < 20 then
call err 'cannot split line' l
call mAdd d, left(l, cx+1)
l = ' ' substr(l, cx+2)
end
call mAdd d, l
end
return
endProcedure splitSql
rebind: procedure expose m.
parse arg out, cmd, opt
m.o.0 = 0
spec = 0
triCmd = cmd
if pos('T', opt) > 0 then
triCmd = cmd 'TRIGGER'
do px=1 to m.pk.0
p = 'PK.'px
spec = spec+rebindOut(o, cmd, opt,
, m.p.collid, m.p.name, m.p.version,
, m.p.type, m.p.qualifier, m.p.owner)
end
if spec > 0 then do
call warn spec 'special rebinds (qualifier or owner)'
end
call writeDsn out, m.o., ,1
return
endProcedure rebind
rebindOut: procedure expose m.
parse arg o, cmd, opt, co, pk, ve, ty, qu, ow
if ty == 'T' then
t = cmd 'PACKAGE('co'.'pk')'
else
t = cmd 'PACKAGE('co'.'pk'.('strip(ve)'))'
q = ''
if pos('Q', opt) > 0 then
if qu ^= 'OA1P' then
q = 'QUAL(OA1P)'
if pos('O', opt) > 0 then
if wordPos(ow, 'S100447 CMNBATCH S100006') < 1 then
q = q 'OWNER(S100447)'
if q == '' then do
call mAdd o, t';'
return 0
end
if length(t q) <= 70 then do
call mAdd o, t q';'
end
else do
call mAdd o, t '-'
call mAdd o, ' ' q';'
end
return 1
endProcedure rebindOut
restartRebind: procedure expose m.
parse arg opt, in, out
sql = "select version,type, valid, operative",
"from sysibm.sysPackage",
"where location = '' and collid=? and name=? and conToken = ? "
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call readDsn in, i.
m.o.0 = 0
cPk = 0
cRs = 0
do i=1 to i.0
if ^ (left(i.i, 3) == 'pk ' | left(i.i, 3) == 'qk ') then
iterate
parse var i.i 4 co '.' pk ct dt fl qu ow .
ctsq = "'" || x2c(ct) || "'"
call adrSql 'open c1 using :CO, :PK , :ctsq'
call adrSql 'fetch c1 into :fVe, :fTy, :fVd, :fOp'
rst = 0
msg = ''
if sqlCode = 100 then do
say '*** pkg not in catalog' fl co'.'pk ct
rst = 1
end
call adrSql 'fetch c1 into :fVe, :fTy, :fVd, :fOp'
if sqlCode ^= 100 then
call err 'duplicate fetch for package' co'.'pk ct
if rst then
nop
else if fVd = 'Y' & fOp = 'Y' then
nop /* say fVe fTy fVd '|| fOp 'validOp' */
else if (fVd = 'Y' | substr(fl, 3, 1) = 'N') then
msg = 'inval bef'
else if pos('=', opt) > 0 & (fVd = substr(fl, 3, 1)) then
msg = 'as before'
else
rst = 1
if pos('S', opt) > 0 then do
if rst then
msg = 'retrying '
if msg ^== '' then
say msg fTy fl '-->' fVd || fOp co'.'pk'('fVe')'
end
cPk = cPk + 1
cRs = cRs + rst
if rst then do
/* say 'retrying ' fTy fl '-->' fVd || fOp co'.'pk'('fVe')'
*/ call rebindOut o, 'REBIND', 'QO', co, pk, fVe, fTy, qu, ow
end
call adrSql 'close c1'
end
say 'retrying' cRs 'rebinds of' cPk
if m.o.0 > 0 then
call writeDsn out, m'.'o'.', , 1
return
endProcedure restartRebind
checkUnloadDS: procedure expose m.
parse arg in, pref
call readDsn in, i.
cTb = 0
cTs = 0
cDS = 0
cEr = 0
call mapReset 'TS', 'K'
do i=1 to i.0
if left(i.i, 3) ^== 'oT ' then
iterate
parse var i.i 4 cr '.' tb db '.' ts sz nTb parts bp .
call stripVars 'cr tb db ts'
if 0 then
say cr'.'tb 'in' db'.'ts 'sz' sz 'nTb' nTb 'parts' parts
dbTs = db'.'ts
cTb = cTb + 1
if mapHasKey('TS', dbTs) then do
ts.dbTs = ts.dbTs cr'.'tb
end
else do
cTs = cTs + 1
call mapAdd 'TS', dbTs, nTb
ts.dbTs = cr'.'tb
if parts = 0 then do
cEr = cEr + check1Ds(pref'.'db'.'ts'.UNL')
cDs = cDs + 1
end
else do
do px=1 to parts
cEr = cEr + check1Ds( ,
pref'.'db'.'ts'.P'right(px, 5, 0)'.UNL')
cDs = cDs + 1
end
end
end
end
say cTb 'tables,' cTs 'TS, ' cDs 'Datasets with' cEr 'errors'
k = mapKeys('TS')
do x=1 to m.k.0
dbts = m.k.x
if mapGet('TS', dbTs) ^= words(ts.dbTs) then
call err 'ts' dbTs 'should have' mapGet('TS', dbTs) ,
'tables but found' words(ts.dbTs)':' ts.dbTs
end
return
endProcedure checkUnloadDS
check1Ds: procedure expose m.
parse arg dsn
res = sysDsn("'"dsn"'")
if res ^== 'OK' then do
say dsn res
return 1
end
res = adrTso("alloc dd(ch) dsn('"dsn"')", '*')
if res <> 0 then do
say 'could not allocate' dsn
call adrTso "free dd(ch)", '*'
return 1
end
call readDDbegin ch
call readDD ch, ch., 100
if ch.0 < 100 then
say 'read' dsn ch.0
call readDDend ch
call adrTso "free dd(ch)", '*'
return 0
endProcedure check1DS
ctlSearch: procedure expose m.
parse arg fun, out, pds, mbrs, sPre
m.o.0 = 0
do mx=1 to words(mbrs)
seMb = word(mbrs, mx)
dsn = pds'('seMb')'
call readDsn dsn, l.
do l=1 to l.0 while pos('SRCH DSN:', l.l) < 1
end
cx = pos('SRCH DSN:', l.l)
if cx < 1 then
call err 'no SRCH DSN: found in' dsn
sLib = word(substr(l.l, cx+9), 1)
cnt = 0
drop f.
do l=l to l.0
cx = pos('--- STRING(S) FOUND ---', l.l)
if cx < 1 then
iterate
else if cx < 20 then
call err 'bad ...FOUND... line' l in dsn':' l.l
cMb = word(l.l, 1)
if f.cMb = 1 then do
call warn 'duplicate' cMb 'in' seMb sLib
iterate
end
f.cMb = 1
call mAdd o, 'cc' left(cMb, 9) left(seMb,9) sLib
cnt = cnt + 1
call readDsn sLib'('cMb')', m.cc.
m.ctlMbr = seMb'('cMb')'
call writeDsn sPre'.CALT.'seMb'('cMb') ::F', m.cc., , 1
if fun = 'C' then do
call transformCtl cc
call writeDsn sPre'.CNeu.'seMb'('cMb') ::F', m.cc., , 1
end
end
say cnt 'members found in' seMb sLib
end
call writeDsn out, m.o., ,1
return
endProcedure ctlSearch
ctlTransQQ: procedure expose m.
call ctlTransMM 'DSN.NAKWB.CALT.LISTNEU', 'DSN.NAKWB.CNEU.LISTNEU',
, QR055031 ,
QR055081 ,
QR055151 ,
QR058041 ,
QR058051 ,
QR058071 ,
QS055031 ,
QS055081 ,
QS055151 ,
QS058031 ,
QS058041 ,
QS058051
return
endProcedure ctlTransQQ
ctlTransMM: procedure expose m.
parse arg src, trg, mbrs
say '??mm' mbrs
do mx=1 to words(mbrs)
mb = word(mbrs,mx)
say '??' mb
call readDsn src'('mb')', m.cc.
call transformCtl cc
call writeDsn trg'('mb') ::F', m.cc., , 1
end
return
endProcedure ctlTransMM
transformTest: procedure expose m.
m.h.1 = 'wie gehts walti'
m.h.2 = 'wie ODV.walti mit imf.ersatz oder IMFDNF01DNF02ODV'
m.oldTs.TSTNAKAL.S004A = TSTNAKNE.A00004A345A
m.oldTs.TSTNAKAL.S003 = TSTNAKNE.A3A
m.h.3 = 'wie TSTNAKAL . S003 TSTNAKAL.S004A DTSTNAKAL . M014A V'
m.h.4 = 'TSTNAKAL,.| TSTNAKAL ? SP(S003 , S004A , M014A* V'
m.h.0 = 4
call mAddSt mCut(i, 0), h
call transformCtl i
do x=0 to m.h.0
say 'i' m.h.x
say 'o' m.i.x
end
exit
endProcedure transformTest
transformCtl: procedure expose m.
parse arg i
if symbol('m.tcl.0') ^== 'VAR' then do
say m.scan.tcl.name1
call scanSqlIni tcl
say m.scan.tcl.name1
say m.scan.tcl.name
if symbol('m.scan.tcl.name') ^== 'VAR' then
call err 'ini scanSql failed'
m.tcl.f.1 = 'ODV'
m.tcl.t.1 = 'OA1P'
m.tcl.f.2 = 'IMF'
m.tcl.t.2 = 'OA1P'
y = 2
do d=1 to m.db.0
y = y + 1
m.tcl.f.y = m.db.d.alt
m.tcl.t.y = m.db.d.neu
end
m.tcl.0 = y
end
do j=1 to m.i.0
lNo = substr(m.i.j, 73)
m.i.j = strip(left(m.i.j, 72), 't')
if left(m.i.j, 2) = '//' & word(m.i.j, 2) = 'JOB' then
iterate
do y=1 to m.tcl.0
cx = 1
do forever
cx = replOne(i'.'j, cx, m.tcl.f.y, m.tcl.t.y)
if cx < 1 then
leave
if y <= 2 then
iterate
call scanLine tcl, m.i.j " ' ' ' ' ' ' ' ' "
m.scan.tcl.pos = cx
call scanSql scanSkip(tcl)
if m.sqlType == '.' then do
if scanSqlDeID(scanSkip(tcl)) ^== '' then do
cx = replTS(i'.'j,
, m.scan.tcl.pos,
, length(m.tok),
, m.tcl.f.y'.'m.val)
end
end
else do
fnd = 0
do q=1 to 3 while m.scan.tcl.pos <= 73
if m.sqlType == 'i' & wordPos(m.val,
, 'SP SPACE SPACENAM') > 0 then do
fnd = 1
leave
end
call scanSql scanSkip(tcl)
end
if ^fnd then
iterate
do while m.scan.tcl.pos <= 73
if scanSqlDeID(scanSkip(tcl)) ^== '' then do
px = replTS(i'.'j,
, m.scan.tcl.pos,
, length(m.tok),
, m.tcl.f.y'.'m.val)
call scanLine tcl, m.i.j
m.scan.tcl.pos = px
end
else if scanSql(scanSkip(tcl)) == '' ,
| m.sqlType == ')' then
leave
end
end
end
end
m.i.j = strip(m.i.j, 't')
if length(m.i.j) > 72 then do
call warn 'line overFlow' length(m.i.j)m.i.j
m.i.j = left(m.i.j, 80)
end
m.i.j = left(m.i.j, 72)lNo
end
return
endProcedure transformCtl
replOne: procedure expose m.
parse arg l, x, o, n
y = pos(o, translate(m.l), x)
if y < 1 then
return 0
m.l = left(m.l, y-1) || n || substr(m.l, y + length(o))
return y + length(n)
endProcedure replOne
replTS: procedure expose m.
parse arg li, x, len, os
if symbol('m.oldTs.os') ^== 'VAR' then do
call warn 'old TS not found:' os 'in' m.ctlMbr 'line' m.li
return x
end
na = strip(m.oldTs.os)
if words(m.oldTs.os) > 1 then do
call warn 'old TS has multiple new:' os '->' nn,
'in' m.ctlMbr 'line' m.li
return x
end
na2 = strip(substr(na, pos('.', na)+1))
m.li = left(m.li, x-1-len) || na2 || substr(m.li, x)
return x - len + length(na2)
endProcedure replTS
allocList: procedure expose m.
parse upper arg nPre, list
s.1 = 'dummy member zzzzzzzz'
s.0 = 1
do wx=1 to words(list)
w = word(list, wx)
if w = 'LIST' then
call writeDsn nPre'.'w'(ZZZZZZZZ) ::F133', s., 1, 1
else
call writeDsn nPre'.'w'(ZZZZZZZZ) ::F', s., 1, 1
end
return
endProcedure allocList
err:
say '*** error:' arg(1)
call warnWrite m.dPre'.JCL'
call errA arg(1), 1
endSubroutine err
envPut: procedure expose m.
parse arg na, va
call mapPut m.vars, na, va
return
endProcedure envPut
envIsDefined: procedure expose m.
parse arg na
return mapHasKey(m.vars, na)
endProcedure envIsDefined
envGet: procedure expose m.
parse arg na
return mapGet(m.vars, na)
endProcedure envGet
envRemove: procedure expose m.
parse arg na
return mapRemove(env.vars, na)
endProcedure envRemove
envExpand: procedure expose m.
parse arg src
cx = pos('$', src)
if cx < 1 then
return strip(src, 't')
res = left(src, cx-1)
do forever
if substr(src, cx+1, 1) = '{' then do
ex = pos('}', src, cx+2)
if ex < 1 then
call err 'missing } after' substr(src, cx) 'in' src
res = res || envGet(substr(src, cx+2, ex-cx-2))
ex = ex + 1
end
else do
ex = verify(src, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_',
|| 'abcdefghijklmnopqrstuvwxyz', 'n', cx+1)
if ex < 1 then
return strip(res || envGet(substr(src, cx+1)), 't')
res = res || envGet(substr(src, cx+1, ex-cx-1))
end
cx = pos('$', src, ex)
if cx < 1 then
return strip(res || substr(src, ex), 't')
res = res || substr(src, ex, cx-ex)
end
endProcedure envExpand
envExpAll: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx+1
m.dst.dx = envExpand(m.src.sx)
end
m.dst.0 = dx
return
endProcedure envExpAll
testExp: procedure
call mIni
m.xx.0 = 0
call envPut 'v1', eins
call envPut 'v2', zwei
call testExp1 'ohne variabeln'
call testExp1 '$v1 variabeln'
call testExp1 'mit $v1 iabeln'
call testExp1 'mit variab$v1'
call testExp1 '${v2}variabeln'
call testExp1 'mit vari${v1}'
call testExp1 'mit v${v2}eln'
call testExp1 'mit v${v1}eln'
call testExp1 'mit $v1 viel${v2}+$v1-vars${v2}'
call envExpAll mCut(yy, 0), xx
do x=1 to m.yy.0
say 'tesStem exp' m.yy.x'|'
end
return
endProcedure testExp
testExp1: procedure expose m.
parse arg src
call mAdd xx, src
say 'testExp src' src'|'
say 'testExp exp' envExpand(src)'|'
return
endProcedure testExp1
warn: procedure expose m.
parse arg msg
msg = strip(msg)
say '***warn:' msg
call mAdd warn, left(msg, 72)
do x=73 by 68 to length(msg)
call mAdd warn, ' 'substr(msg,x, 68)
end
return
endProcedure warn
warnWrite: procedure expose m.
parse arg lib
if 0 then do
x = 'abcdefghijklmnopqrstuvwxyz'
x = '0123456789' || x || translate(x)
call warn 'test mit langer warnung' x x x x x x x x x x x'|'
end
if m.warn.0 = 0 then do
say 'keine Warnungen'
return
end
say m.warn.0 'Warnungen'
do i=1 to 20
dsn = lib'(warn'right(i, 3, 0)')'
sd = sysDsn("'"dsn"'")
if sd = 'MEMBER NOT FOUND' then
leave
end
if sd = 'MEMBER NOT FOUND' then do
call writeDsn dsn, m.warn., , 1
end
else do
say 'error cannot write warnings' dsn ':' sd
do x=1 to m.warn.0
say m.warn.x
end
end
return
endProcedure warnWrite
/* copy scanSql begin *************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanSqlIni: procedure expose m.
parse arg m
call scanOptions m, , '0123456789_' , '--'
m.scan.m.sqlBrackets = 0
return m
endProcedure scanSqlIni
scanSqlSeekId: procedure expose m.
parse arg m, lx, cmd
call adrEdit "cursor =" lx
do while adrEdit("seek" cmd 'word', 4) = 0 /* find each command*/
call adrEdit "(fx) = cursor"
call debug 'scanSqlSeekId after' lx 'found' cmd 'at' fx
call editReadDefine m, fx
call scanReader m, m
do while m.m.editReadLx <= fx
if scanSql(scanSkip(m)) = '' then
return -1
if m.sqlType = 'i' & m.val == cmd then
return fx
end
end
return -1
endProcedure scanSqlSeekId
ePos: procedure expose m.
parse arg m
return m.m.editReadLx m.scan.m.pos
endProcedure ePos
/*--- scan a sql token put type in m.sqltype:
'i': ordinary identifier e.g. Name
'd': delimited identifier e.g. "Delimited"
'q': quantified identifier e.g. abc."efg"
'u': integer units e.g. 8G
'n': number e.g. -234
"'": string e.g. 'abc''ef'
'' : at end
: any other character e.g. ;
----------------------------------------------------------------*/
scanSql: procedure expose m.
parse arg m
if scanAtEnd(m) then do
m.sqlType = ''
m.val = ''
end
else if scanStringML(m, "'") then
m.sqlType = "'"
else if scanSqlQuId(m) ^== '' then
nop
else if scanSqlNumUnit(m, 1) ^== '' then
nop
else if scanChar(m, 1) then do
m.sqlType = m.tok
m.val = ''
if m.tok = '(' then
m.scan.m.sqlBrackets = m.scan.m.sqlBrackets + 1
else if m.tok = ')' then
m.scan.m.sqlBrackets = m.scan.m.sqlBrackets - 1
end
else
call scanErr m, 'cannot scan sql'
return m.sqlType
endProcedure scanSql
/*--- scan an ordinary sql identifier e.g. abc, ef_12 ----------------*/
scanSqlId: procedure expose m.
parse arg m
if ^ scanName(m) then
return ''
m.val = translate(m.tok)
m.sqlType = 'i'
return m.val
endProcedure scanSqlId
/*--- scan a delimited or ordinay sql identifier ---------------------*/
scanSqlDeId: procedure expose m.
parse arg m
if scanSqlId(m) == '' then do
if scanString(m, '"') then do
val = strip(val, 't')
m.sqlType = 'd'
end
end
return m.val
endProcedure scansqlDeId
/*--- scan a qualified sql identifier --------------------------------*/
scanSqlQuId: procedure expose m.
parse arg m
if scanSqlDeId(m) == '' then
return ''
res = ''
do qx=1 by 1
m.val.qx = m.val
res = res'.'m.val
if ^ scanLit(scanSkip(m), '.') then do
m.val.0 = qx
if qx > 1 then
m.sqlType = 'q'
m.val = substr(res, 2)
return m.val
end
if scansqlDeId(scanSkip(m)) == '' then
call scanErr m, 'id expected after .'
end
endProcedure scanSqlQuId
/*--- scan a sql number ----------------------------------------------*/
scanSqlNum: procedure expose m.
parse arg m, checkEnd
c3 = left(scanLook(m, 3), 3)
p = left(c3, 1) == '+' | left(c3, 1) == '-'
p = p + (substr(c3, p + 1, 1) == '.')
if pos(substr(c3, p+1, 1), '0123456789') < 1 then
return ''
n = ''
if p > 0 & left(c3, 1) ^== '.' then do
call scanChar m, 1
n = m.tok
end
if scanVerify(m, '0123456789') then
n = n || m.tok
if scanLit(m, '.') then do
n = n'.'
if scanVerify(m, '0123456789') then
n = n || m.tok
end
c3 = left(translate(scanLook(m, 3)), 3)
if left(c3, 1) == 'E' then do
p = substr(c3, 2, 1) == '+' | substr(c3, 2, 1) == '-'
if pos(substr(c3, p+2, 1), '0123456789') > 0 then do
call scanChar m, p+1
n = n || m.tok
if scanVerify(m, '0123456789') then
n = n || m.tok
c3 = scanLook(m, 1)
end
end
if checkEnd ^= 0 then
if pos(left(c3, 1), m.scan.m.name) > 0 then
call scanErr m, 'end of number' n 'expected'
m.val = n
return n
endProcedure scanSqlNum
/*--- scan a sql number with unit K M or G ---------------------------*/
scanSqlNumUnit: procedure expose m.
parse arg m, both
nu = scanSqlNum(m, 0)
if nu = '' then
return ''
sp = scanSpaceNl(m)
af = translate(scanSqlId(m))
if wordPos(af, "K M G") > 0 then do
m.sqlType = 'u'
m.val = nu || af
return m.val
end
else if af <> '' & ^ sp then
call scanErr m, 'end of number' nu 'expected'
if both ^== 1 then
call scanErr m, 'unit K M or G expected'
else if af ^== '' then
call scanBack m, m.tok
m.sqlType = 'n'
m.val = nu
return nu
endProcedure scanSqlNumUnit
scanSqlskipBrackets: procedure expose m.
parse arg m, br
call scanSpaceNl m
if br ^== '' then
nop
else if ^ scanLit(m, '(') then
return 0
else
br = 1
do forever
t = scanSql(scanSpaceNl(m))
if t = '' | t = ';' then
call scanErr m, 'closing )'
else if t = '(' then
br = br + 1
else if t ^== ')' then
nop
else if br > 1 then
br = br - 1
else if br = 1 then
return 1
else
call scanErr m, 'skipBrackets bad br' br
end
endProcedure skipBrackets
/* copy scanSql end *************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanReader(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
m.scan.m.pos = 1
call scanInit m
return m
endProcedure scanLine
/*--- switch to next line if atEnd of line or unCond=1 ---------------*/
scanNL: procedure expose m.
parse arg m, unCond
if m.scan.m.reading then do
interpret m.scan.m.scanNl
end
else do
np = 1 + length(m.scan.m.src)
if np <= m.scan.m.pos then
return 0
if unCond == 1 then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' ,
& abbrev(m.scan.m.src, m.scan.m.comment) then nop
else
return 0
m.scan.m.pos = np
return 1
end
endProcedure scanNL
scanAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.reading then
interpret m.scan.m.scanAtEnd
else
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEnd
/*--- initialize scanner for m --------------------------------------*/
scanInit: procedure expose m.
parse arg m, rdng
m.scan.m.reading = rdng == 1
m.tok = ''
m.val = ''
m.key = ''
if symbol('m.scan.m.name') ^== 'VAR' then do
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
end
return
endProcedure scanInit
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
call scanInit m
m.scan.m.comment = comm
if nameOne ^== '' then do
m.scan.m.Name1 = nameOne
m.scan.m.name = m.scan.m.name1 || '0123456789'
end
if namePlus ^== '' then
m.scan.m.name = m.scan.m.name1 || namePlus
return
endProcedure scanOptions
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
return substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
m.tok = scanLook(m, len)
m.scan.m.pos = m.scan.m.pos + length(m.tok)
return length(m.tok) > 0
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a string with quote char qu -------------------------------*/
scanStringML: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
lCnt = 0
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then do
m.val = m.val || substr(m.scan.m.src, qx)
if lCnt == 9 | ^ scanNl(m, 1) then
call scanErr m, 'ending Apostroph('qu') missing multi'
qx = 1
bx = 1
end
else do
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
ScanNat: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
scanLinePos: procedure expose m.
parse arg m
interpret 'return' m.scan.m.scanLinePos
endProcedure scanLinePos
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok 'scanPosition' ,
strip(left(substr(m.scan.m.src, m.scan.m.pos), 40), 't')
if m.scan.m.reading then
say scanLinePos(m)
else
say ' pos' m.scan.m.Pos 'in string' strip(m.scan.m.src, 't')
call err 'scanErr' txt
return
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
res = 0
do forever
if scanVerify(m, ' ') then nop
else if ^ scanNL(m) then leave
res = 1
end
m.tok = lastTok
return res
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- begin scanning the lines of a reader ---------------------------*/
scanReader: procedure expose m.
parse arg m, m.scan.m.rdr
call scanInit m, 1
m.scan.m.atEnd = 0
m.scan.m.lineX = 0
m.scan.m.scanNl = 'return scanReaderNl(m, unCond)'
m.scan.m.scanAtEnd = 'return scanReaderAtEnd(m, what)'
m.scan.m.scanLinePos = "scanReaderLinePos(m)"
call scanReaderNl m, 1
return m
endProcedure scanReader
/*--- return true/false whether we are at the end of line / reader ---*/
scanReaderAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if what == 'l' then
return 1
return m.scan.m.atEnd
endProcedure scanReaderAtEnd
scanReaderNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then nop
else if unCond ^= 2 & m.scan.m.pos > length(m.scan.m.src) then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' & abbrev(substr( ,
m.scan.m.src, m.scan.m.pos), m.scan.m.comment) then nop
else
return 0
if m.scan.m.atEnd then
return 0
m.scan.m.atEnd = ^ jRead(m.scan.m.rdr, 'SCAN.'m'.SRC')
if m.scan.m.atEnd then do
m.scan.m.pos = 1 + length(m.scan.m.src)
end
else do
m.scan.m.pos = 1
m.scan.m.lineX = m.scan.m.lineX + 1
end
return ^ m.scan.m.atEnd
endProcedure scanReaderNL
scanReaderLinePos: procedure expose m.
parse arg m
if m.scan.m.atEnd then
qq = 'atEnd after'
else
qq = 'pos' m.scan.m.pos 'in'
return qq 'line' m.scan.m.lineX':' strip(m.scan.m.src, 't')
endProcedure scanReaderLinePos
/* copy scan end ****************************************************/
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jNew: procedure expose m.
if m.j.jIni ^== 1 then
call jIni
return 'J.'mInc(j)
endProcedure jNew
jFree: procedure expose m.
parse arg m
return
endProcedure jFree
jRead: procedure expose m.
parse arg m, arg
res = '?'
interpret m.j.m.read
return res
endProcedure jRead
jWrite: procedure expose m.
parse arg m, arg
interpret m.j.m.write
return
endProcedure jWrite
jReset: procedure expose m.
parse arg m, arg
interpret 'call' m.j.m.pref'Reset m, arg'
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret 'call' m.j.m.pref'Open m, arg'
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
interpret 'call' m.j.m.pref'Close m'
m.j.m.read = 'call err "read('m') when closed"'
m.j.m.write = 'call err "write('m') when closed"'
return m
endProcedure jClose
jDefine: procedure expose m.
parse arg m, m.j.m.pref
m.j.m.read = 'call err "read('m') when closed"'
m.j.m.write = 'call err "write('m') when closed"'
return m
endProcedure jDefine
jDefRead: procedure expose m.
parse arg m, m.j.m.read
m.j.m.write = 'call err "write('m') when reading"'
return m
endProcedure jDeRead
jDefWrite: procedure expose m.
parse arg m, m.j.m.write
m.j.m.read = 'call err "read('m') when writing"'
return m
endProcedure jDeWrite
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jIni: procedure expose m.
parse arg force
if m.j.jIni == 1 & force ^== 1 then
return
m.j.jIni = 1
m.j.0 = 0
m.j.defDD.0 = 0
m.j.jIn = jNew()
m.j.jOut = jNew()
call jDefine m.j.jIn, "jStdIOError "
call jDefRead m.j.jIn, "res = 0"
call jDefine m.j.jOut, "jStdIOError "
call jDefWrite m.j.jOut, "say arg"
return
endProcedure jIni
jStdIOError: procedure expose m.
parse arg fun m, arg
call err 'do not j'fun'('m',' arg') base stdIn/stdOut'
return
endSubroutine
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
jBuf: procedure expose m.
m = jNew()
call jDefine m, "jBuf"
do ax=1 to arg()
m.j.m.buf.ax = arg(ax)
end
m.j.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
do ax=1 to arg() - 1
m.j.m.buf.ax = arg(ax+1)
end
m.j.m.buf.0 = ax-1
return m
endProcedure jBufReset
jBufOpen: procedure expose m.
parse arg m, opt
if opt == 'r' then do
call jDefRead m, "res = jBufRead(m , arg)"
m.j.m.bufIx = 0
return m
end
if opt == 'w' then
m.j.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
call jDefWrite m, "call mAdd 'J.'m'.BUF', arg"
return m
endProcedure jBufOpen
jBufClose:
return arg(1)
endProcedure jBufClose
jBufStem: procedure expose m.
parse arg m
return 'J.'m'.BUF'
endProcedure jBufStem
jBufRead: procedure expose m.
parse arg m, var
ix = m.j.m.bufIx + 1
if ix > m.j.m.buf.0 then
return 0
m.j.m.bufIx = ix
m.var = m.j.m.buf.ix
return 1
endProcedure jBufRead
jDsn: procedure expose m.
parse arg spec
m = jNew()
m.j.m.state = ''
call jDefine m, "jDsn"
m.j.m.defDD = 'J'mInc('J.DEFDD')
call jDsnReset m, spec
return m
endProcedure jDsn
jDsnReset: procedure expose m.
parse arg m, spec
call jClose m
m.j.m.dsnSpec = spec
return m
endProcedure jDsnReset
jDsnOpen: procedure expose m.
parse arg m, opt
call jDsnClose m
if opt == 'r' then do
aa = dsnAlloc(m.j.m.dsnSpec, 'SHR', m.j.m.defDD)
call readDDBegin word(aa, 1)
call jDefRead m, "res = jDsnRead(m , arg)"
end
else do
if opt == 'w' then
aa = dsnAlloc(m.j.m.dsnSpec, 'OLD', m.j.m.defDD)
else if opt == 'a' then
aa = dsnAlloc(m.j.m.dsnSpec, 'MOD', m.j.m.defDD)
else
call err 'jBufOpen('m',' opt') with bad opt'
call writeDDbegin word(aa, 1)
call jDefWrite m, "call jDsnWrite m , arg"
end
m.j.m.state = opt
m.j.m.dd = word(aa, 1)
m.j.m.free = subword(aa, 2)
return m
endProcedure jBufOpen
jDsnClose:
parse arg m
if m.j.m.state ^== '' then do
if m.j.m.state == 'r' then do
call readDDend m.j.m.dd
end
else do
if m.j.m.buf.0 > 0 then
call writeDD m.j.m.dd, 'M.J.'m'.BUF.'
call writeDDend m.j.m.dd
end
interpret m.j.m.free
end
m.j.m.buf.0 = 0
m.j.m.bufIx = 0
m.j.m.state = ''
m.j.m.free = ''
m.j.m.dd = ''
return m
endProcedure jDsnClose
jDsnRead: procedure expose m.
parse arg m, var
ix = m.j.m.bufIx + 1
if ix > m.j.m.buf.0 then do
res = readDD(m.j.m.dd, 'M.J.'m'.BUF.')
if ^ res then
return 0
ix = 1
end
m.j.m.bufIx = ix
m.var = m.j.m.buf.ix
return 1
endProcedure jDsnRead
jDsnWrite: procedure expose m.
parse arg m, var
ix = m.j.m.buf.0 + 1
m.j.m.buf.0 = ix
m.j.m.buf.ix = var
if ix > 99 then do
call writeDD m.j.m.dd, 'M.J.'m'.BUF.'
m.j.m.buf.0 = 0
end
return
endProcedure jDsnWrite
/* copy j end *********************************************************/
/* copy adrSql begin *************************************************/
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then do
return 0
end
else if rc < 0 then do
if ggRet == '*' then nop
else if wordPos(sqlCode, ggRet) > 0 then nop
else
call err "sql rc" rc sqlmsg() ggNo
end
else if sqlWarn.0 ^== ' ' then do
say 'warning' sqlMsg() ggNo
end
return sqlCode
endSubroutine adrSql
adrSqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call adrSql "connect" ggSys, ggRetCon ,1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
parse arg ggRet
call adrSql "disconnect ", ggRet, 1
return
endProcedure adrSqlDisconnect
sqlFields: procedure
parse arg flds
sql = ''
do wx=1 to words(flds)
sql = sql', :'word(flds, wx)
end
if wx > 1 then
sql = substr(sql, 3)
return sql
endProcedure sqlFields
sqlMsg: /* no procedure, to keep variables sql... */
ggW = ''
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggw = ggw ggx'='sqlWarn.ggx
end
ggXX = pos(':', ggSqlStmt)
ggVV = ''
if ggXX > 0 then do
ggVV = word(substr(ggSqlStmt, ggXX + 1), 1)
ggXX = verify(ggVV, ' ,:+-*/&%?|', 'm')
if ggXX > 0 then
ggVV = left(ggVV, ggXX-1)
ggVV = 'with' ggVV '=' value(ggVV)
end
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x)) ,
'stmt = ' ggSqlStmt ggVV
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/* copy adrSql 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 -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
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 ds = '' then
ds = dsn2jcl(w)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
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 m begin ********************************************************
stem and type handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a.0 = m.a.0 + 1
return m.a.0
endProcedure mInc
mDefIfNot: procedure expose m.
parse arg a, put
if symbol('m.a') == 'VAR' then
return 0
m.a = put
return 1
endProcedure mDefIfNot
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- put into stem a the fields flds from arguments -----------------*/
mPut: procedure expose m.
parse arg a, flds
do wx = 1 to words(flds)
f = word(flds, wx)
m.a.f = arg(wx+2)
end
return a
endProcedure mPut
/*--- put into stem a the fields flds from stem b --------------------*/
mPutSt: procedure expose m.
parse arg a, flds, b
do wx = 1 to words(flds)
f = word(flds, wx)
m.a.f = m.b.f
end
return a
endProcedure mPutSt
/*--- put into stem a the fields flds from variable pool -------------*/
mPutVars:
parse arg ggA, ggFlds
do ggWx = 1 to words(ggFlds)
ggF = word(ggFlds, ggWx)
m.ggA.ggF = value(ggF)
end
return ggA
endProcedure mPutVars
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
if m.m.mIni ^== 1 then
call mIni
return mapReset(mAdd(m.map, 'map'))
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.a.mapKey') == 'VAR' then
call mapClear a
m.a.mapKey = translate(opt) = 'K'
if m.a.mapKey then
m.a.mapKey.0 = 0
else
m.a.mapKey.0 = 'noMapKeys'
return a
endProcedure
mapClear: procedure expose m.
parse arg a
do kx=1 to m.a.mapKey.0
k = m.a.mapKey.kx
drop m.a.mapK2V.k m.a.mapKey.kx
end
m.a.mapKey.0 = 0
return a
endProcedure mapClear
mapKeys: procedure expose m.
parse arg a
return a'.'mapKey
endProcedure mapKeys
mapAdd: procedure expose m.
parse arg a, ky, val
if symbol('m.a.mapK2V.ky') == 'VAR' then
call err 'duplicate key in mAdd('a',' ky',' val')'
m.a.mapK2V.ky = val
if m.a.mapKey then
call mAdd a'.'mapKey, ky
return
endProcedure mapAdd
mapPut: procedure expose m.
parse arg m, ky, val
if m.m.mapKey then
if symbol('m.m.mapK2V.ky') ^== 'VAR' then
call mAdd m'.'mapKey, ky
m.m.mapK2V.ky = val
return
endProcedure mapPut
mapHasKey: procedure expose m.
parse arg m, ky
return symbol('m.m.mapK2V.ky') == 'VAR'
endProcedure mapHasKey
mapGet: procedure expose m.
parse arg m, ky
if symbol('m.m.mapK2V.ky') ^== 'VAR' then
call err 'missing key in mapGet('m',' ky')'
return m.m.mapK2V.ky
endProcedure mapGet
mapGetOr: procedure expose m.
parse arg m, ky, orDef
if symbol('m.m.mapK2V.ky') == 'VAR' then
return m.m.mapK2V.ky
else
return orDef
endProcedure mapGetOr
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mGetType:
parse arg name
return mapGet(m.type, name)
endProcedure mGetType
mTypeNew: procedure expose m.
parse arg name, stem, flds, types
if m.m.ini ^== 1 then
call mIni
ty = mAdd(m.type, name)
call mapAdd m.type, name, ty
m.ty.ass = '='
m.ty.type = stem
m.ty.0 = words(flds)
m.ty.type.0 = m.ty.0
do y=1 to m.ty.0
m.ty.y = word(flds, y)
if word(types, y) = '' then
m.ty.type.y = m.type.1
else
m.ty.type.y = word(types, y)
end
return ty
endProcedure mTypeNew
mShow: procedure expose m.
parse arg ty, a, lv
if lv='' then
lv = 0
pr = a
if lv > 0 & lastPos('.', pr) > 0 then
pr = substr(pr, lastPos('.', pr))
say left('', lv)pr '=' m.a
do y=1 to m.ty.0
call mShow m.ty.type.y, a'.'m.ty.y, lv+1
end
if m.ty.type ^== '' then do
do y=1 to m.a.0
call mShow m.ty.type, a'.'y, lv+1
end
end
return
endProcedure mShow
mClear: procedure expose m.
parse arg ty, a, val
m.a = val
do y=1 to m.ty.0
call mClear m.ty.type.y, a'.'m.ty.y
end
if m.ty.type ^== '' then
m.a.0 = 0
return
endProcedure mClear
mTypeSay: procedure expose m.
parse arg t
say 'type' t'='m.t 'ass' m.t.ass '#' m.t.0 'tys' m.t.type
return
endProcedure mInit
mTypeCopy: procedure expose m.
parse arg ty, t, f
if m.ty.ass == '=' then
m.t = m.f
else
call err 'type.ass' m.ty.ass 'not supported'
do x = 1 to m.ty.0
fld = m.ty.x
call mTypeCopy m.ty.type.x, t'.'fld, f'.'fld
end
if m.ty.type ^== '' then do
do y = 1 to m.f.0
call mTypeCopy m.ty.type, t'.'y, f'.'y
end
m.t.0 = m.f.0
end
return t
endProcedure mTypeCopy
mIni: procedure expose m.
m.m.ini = 1
m.m.type.0 = 0
m.m.map.0 = 0
call mapReset m.type
call mapReset m.vars
siTy = mTypeNew('Simple')
stTy = mTypeNew('Stem', siTy)
tyTy = mTypeNew('Type', siTy, 'ASS TYS', siTy stTy)
ttTy = mTypeNew('StemType', tyTy)
return
endProcedure mIni
mTest: procedure
call mIni
siTy = mGetType('Simple')
tyTy = mGetType('Type')
ttTy = mGetType('StemType')
say 'siTy' siTy 'tyTy' tyTy 'stTyTy' ttTy
call mTypeSay siTy
call mTypeCopy siTy, nnn, siTy'.'ass
say 'm.nnn nach copy' m.nnn
call mTypeCopy tyTy, mmm, siTy
call mTypeSay mmm
call mTypeCopy tyTy, qqq, tyTy
call mTypeSay qqq
call mShow tyTy, qqq
call mShow ttTy, m.type
return
endProcedure mTest
/* copy m end *********************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(NAKJOB) cre=2007-05-22 mod=2007-05-22-06.57.36 F540769 ---
/* rexx ****************************************************************
nak what fun
***********************************************************************/
parse upper arg what fun
if what = '' then
parse upper value 'tst 1' with what fun
call mIni
m.tas3 = left(what, 2)right(what, 1)
m.task = 'NAK'what
nPre = 'DSN.'m.task
m.skels = 'A540769.wk.skels'
nLctl = nPre'.LCTL'
if sysvar('SYSNODE') = 'RZ1' then do
m.dbSys = 'DBAF'
newCreator = 'TSTNAKNE'
call envPut 'MGMTCLAS', 'D035Y000'
m.dPre = 'A540769.TMPNAK.'m.task
end
else if 0 then do /* rz2 proc */
m.dbSys = 'DBOF'
newCreator = 'OA1P'
call envPut 'MGMTCLAS', 'D035Y000'
m.dPre = 'DSN.'m.task
end
else do /* transfer rz2 --> rz1 */
m.dbSys = 'DBOF'
newCreator = 'OA1P'
call envPut 'MGMTCLAS', 'D008Y000'
m.dPre = 'SHR21.DIV.P021.'m.task
end
if fun = 9 then do
call testExp
exit
end
m.job.0 = 0
m.jobFlds = 'JOB CR TB DB TS NCR NTB NDB NTS'
call mTypeNew 'StemJob', mTypeNew('Job', '', m.jobFlds)
call adrSqlConnect m.dbSys
if fun = 1 then do
call function1 newCreator, nPre, nLctl
end
else if fun = 2 then do
call unload 'UNL', nLctl'(unload)'
call loadLines m.dPre'.ULI'
call load 'LOA', nLctl'(load)'
end
else
call err 'bad fun' fun
call adrSqlDisConnect m.dbSys
exit
function1: procedure expose m.
parse arg newCreator, nPre, nLctl
call infoDb nLctl'(DB)'
if 0 then
call mShow mGetType('StemDB'), db
call infoTS
if 0 then
call mShow mGetType('StemTS'), ts
if 0 then
do x=1 to m.ts.0
say m.ts.x.db'.'m.ts.x.ts m.ts.x.bp m.ts.x.used
end
call mapReset crNa
call infoTB
if 0 then
call mShow mGetType('StemTB'), tb
if 0 then
do x=1 to m.tb.0
n = m.tb.x.tsNd
say m.tb.x.cr'.'m.tb.x.tb m.tb.x.db'.'m.tb.x.ts n '->' m.n
end
call infoDep
if 0 then
call mShow mGetType('StemDep'), dep
if 0 then
do x=1 to m.dep.0
say m.dep.x.ty m.dep.x.cr'.'m.dep.x.na,
m.dep.x.bTy m.dep.x.bCr'.'m.dep.x.bNa
end
call infoNeu nLctl'(ddlNeu)'
if 0 then
call mShow mGetType('StemNN'), nn
call mapAltNeu newCreator
if 0 then
call mShow mGetType('StemTB'), tb
if 0 then
call mShow mGetType('StemDep'), dep
if 0 then
call mShow mGetType('StemNN'), nn
if 1 then
call mShow mGetType('StemJob'), job
call infoRI
if 0 then
call mShow mGetType('StemRI'), ri
call showAltNeu nLctl'(info)'
call showJob nLctl'(job)'
if 1 then
call mShow mGetType('StemJob'), job
call alias nLctl'(alia)'
call unload 'ULI', nLctl'(unloLim0)'
call err 'check not yet'
call check 'CHK', nLctl'(check)'
return
endProcedure function0
infoDB: procedure expose m.
parse arg inp
call readDsn inp, c.
dbII = 'in ('
call mapReset(db.a2n)
call mapReset(db.n2a)
call mTypeNew 'StemDB', mTypeNew(db, '', 'ALT NEU')
m.db.0 = 0
do c=1 to c.0
dbAlt = word(c.c, 1)
dbNeu = word(c.c, 2)
dd = mAdd(db, dbAlt'->'dbNeu)
m.dd.alt = dbAlt
m.dd.neu = dbNeu
call mapPut db.a2n, dbAlt, dbNeu
call mapPut db.n2a, dbNeu, dbAlt
if c>1 then
dbII = dbII', '
dbII = dbII"'"dbAlt"'"
end
m.dbIn = dbII')'
say m.db.0 'db' m.dbIn
return
endProcedure infoDB
infoTS: procedure expose m.
root = 'TS'
flds = DB TS NTB PARTS BP USED
if mDefIfNot(root'.'0, 0) then do
call mTypeNew 'StemTS', mTypeNew(ts, '', flds)
call mapReset root
end
sqlFlds = sqlFields(flds)
sql = "select dbName, name, nTables, partitions," ,
"bPool, float(nActive)*pgSize*1024" ,
"from sysibm.systablespace",
"where dbname" m.dbIn ,
"order by 1, 2 "
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
do c=1 by 1
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars flds
used = format(used,2,3,2,0)
nd = mPutVars(mAdd(root, db'.'ts), flds)
call mapAdd root, db'.'ts, nd
end
call adrSql 'close c1'
say m.root.0 'tablespaces'
return
endProcedure infoTS
infoTB: procedure expose m.
root = tb
flds = cr tb db ts
xFlds = tsNd newNd
if mDefIfNot(root'.'0, 0) then do
call mTypeNew 'StemTB', mTypeNew(tb, '', flds xflds)
call mapReset root
end
newNd = ''
sqlFlds = sqlFields(flds)
sql = "select creator, name, dbName, tsName",
"from sysibm.systables",
"where dbname" m.dbIn "and type = 'T'"
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
do forever
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars flds
ts = strip(ts)
tsNd = mapGet('TS', db'.'ts)
nd = mPutVars(mAdd(root, cr'.'tb), flds xFlds)
if mapHasKey(root, tb) then
say '??? duplicate table' cr'.'tb
else
call mapAdd root, tb, nd
call mapAdd crNa, cr'.'tb, nd
end
call adrSql 'close c1'
say m.root.0 'tables'
return
endProcedure infoTb
stripVars:
parse arg ggList
do ggX=1 to words(ggList)
ggW = word(ggList, ggX)
x=value(ggW, strip(value(ggW)))
end
return
endSubroutine stripVars
infoDep: procedure expose m.
flds = ty cr na bTy bCr bNa
if mDefIfNot(dep'.'0, 0) then
call mTypeNew 'StemDep', mTypeNew('Dep', '', flds 'NEWND ACT')
sqlFlds = sqlFields(flds)
newNd = ''
act = ''
sql = ,
"with o (lev, dType, dCreator, dName, bType, bCreator, bName) as",
"( select 0, t.type, creator, name, '.', '', t.dbName",
"from sysibm.sysTables t",
"where t.dbname" m.dbIn,
"union all select o.lev+1, d.dType, d.dCreator, d.dName,",
"o.dType, o.dCreator, o.dName",
"from o, sysibm.sysviewdep d",
"where d.bcreator = o.dCreator and d.bName = o.dName",
"and o.lev < 999999",
"union all select o.lev+1, a.Type, a.creator, a.name,",
"o.dType, o.dCreator, o.dName",
"from o, sysibm.systables a",
"where a.tbCreator = o.dCreator and a.tbName = o.dName",
"and a.type = 'A' and o.lev < 999999",
") select dType, dCreator, dName, bType, bCreator, bName",
"from o"
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
do forever
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars flds
if mapHasKey(crNa, cr'.'na) then do
qTy = 'TY'
qBTy = 'BTY'
qbCr = 'BCR'
qbNa = 'BNA'
oo = mapGet(crNa, cr'.'na)
if left(oo, 3) = 'TB.' then do
if ty = 'T' & bTy = '.' & bNa = m.oo.db then
nop /* say 'old table in dep' cr'.'na */
else
call err 'dep with name of old table' ty cr'.'na
end
else if ty ^== m.oo.qTy then
call err 'new dep' m.oo.qTy cr'.'na 'mismatches old' ,
m.oo.qTy m.oo
else if ty == 'A' & ^ (bTy == m.oo.qBty & bCr == m.oo.qBcr ,
& bNa == m.oo.qBNa) then
call err 'dep with duplicate different alias' cr'.'na ,
'b' bTy bCr'.'bNa ,
'oo' m.oo.qBty m.oo.qBcr'.'m.oo.qBNa
else if 0 then
say 'skipping duplicate' cr'.'na
end
else do
nd = mPutVars(mAdd(dep, cr'.'na), flds 'NEWND' 'ACT')
call mapAdd crNa, cr'.'na, nd
end
end
call adrSql 'close c1'
say m.dep.0 'dependencies'
return
endProcedure oldInfo
infoNeu: procedure expose m.
parse arg ddlNeu
flds = cr na ty for oldNd oldAl
if mDefIfNot(nn.0, 0) then do
call mapReset(nn)
call mTypeNew 'StemNN', mTypeNew('NN', '', flds)
end
oldNd = ''
oldAl = ''
r = jDsn(ddlNeu)
call jOpen r, 'r'
call scanSqlReader s, r
lastX = 0
do forever
if lastX = m.scan.s.lineX then
if ^ scanNl(s, 1) then
leave
lastX = m.scan.s.lineX
if pos('CREATE', translate(m.scan.s.src)) < 1 then
iterate
fnd = 0
do while lastX = m.scan.s.lineX & ^fnd
if scanSql(scanSkip(s)) = '' then
leave
fnd = m.sqlType = 'i' & m.val == 'CREATE'
end
if ^ fnd then do
say 'no create, ignoring line' lastx strip(m.scan.s.src)
iterate
end
if scanSqlId(scanSkip(s)) == '' then do
say 'no sqlId, ignoring line' lastx strip(m.scan.s.src)
iterate
end
subTy = ''
if wordPos(m.val, 'UNIQUE LARGE LOB') > 0 then do
subTy = m.val
plus = ''
if subTy = 'UNIQUE' then
plus = 'WHERE NOT NULL'
do wx=1 by 1
if scanSqlId(scanSkip(s)) == '' then
call scanErr s, 'no sqlId after create' subTy
else if m.val = word(plus, wx) then
subTy = subTy m.val
else if wx=1 | wx > words(plus) then
leave
else
call scanErr s, 'stopped in middle of' plus
end
end
ty = m.val
m.scan.m.sqlBrackets = 0
if scanSqlQuId(scanSkip(s)) == '' then
call scanErr s, 'no qualId after create' subTy ty
na = m.val
na1 = m.val.1
na2 = m.val.2
for = '-'
if ty = 'ALIAS' then do
if scanSqlId(scanSkip(s)) ^== 'FOR' then
call scanErr s, 'IN expected after create' ty
if scanSqlQuId(scanSkip(s)) == '' then
call scanErr s, 'table name expected after create' ty na
for = m.val
ty = 'A'
end
else if ty = 'INDEX' then do
if scanSqlId(scanSkip(s)) ^== 'ON' then
call scanErr s, 'IN expected after create' ty
if scanSqlQuId(scanSkip(s)) == '' then
call scanErr s, 'table name expected after create' ty na
for = m.val
ty = 'X'
end
else if ty = 'TABLE' then do
do while ^ (m.scan.s.sqlBrackets = 0 & m.sqlType = 'i' ,
& m.val == 'IN')
if scanSql(scanSkip(s)) = '' | m.tok == ';' then
call scanErr s, 'in database expected'
end
if scanSqlQuId(scanSkip(s)) == '' | m.val = 'DATABASE' then
call scanErr s, 'ts name expected after create' ty na
for = m.val
ty = 'T'
end
else if ty = 'TABLESPACE' then do
if scanSqlId(scanSkip(s)) ^== 'IN' then
call scanErr s, 'IN expected after create' ty
if scanSqlDeId(scanSkip(s)) == '' then
call scanErr s, 'db name expected after create' ty
na = m.val'.'na
ty = 'S'
end
else if ty = 'VIEW' then do
ty = 'V'
for = ''
end
if 0 then
say 'create' subTy ty 'name' na 'for' for
if for ^== '-' then do
nd = mPut(mAdd(nn, na), flds, na1, na2, ty, for)
call mapAdd nn, na, nd
end
end
call jClose r
return
endProcedure infoNeu
infoRI: procedure expose m.
parse arg ddlNeu
flds = cr tb db bCr bTS bTb bDb bTS rNa
if mDefIfNot(ri.0, 0) then
call mTypeNew 'StemRI', mTypeNew('RI', '', flds)
sql = "select r.creator, r.tbName, td.dbName, td.tsName" ,
", refTbcreator, refTbName, tr.dbName, tr.tsName, relName",
"from sysibm.sysrels r, sysibm.sysTables td, sysibm.sysTables tr",
"where r.creator = td.creator and r.tbName = td.name",
"and r.refTbcreator = tr.creator and r.reftbName = tr.name",
"and (td.dbname" m.dbIn "or tr.dbname" m.dbIn")"
/*
select char(td.dbName, 8),
char(strip(r.creator) ||'.'|| strip(r.tbName), 20) "dep",
char(case when td.dbName = tr.dbName then '=' else tr.dbName end
, 8),
char(strip(refTbcreator) ||'.'|| strip(refTbName), 20) "ref par",
char(relName, 30)
from sysibm.sysrels r, sysibm.sysTables td, sysibm.sysTables tr
where r.creator = td.creator and r.tbName = td.name
and r.refTbcreator = tr.creator and r.reftbName = tr.name
and (td.dbname like 'BJAA_0001'
or td.dbname = 'DBJ01' or td.dbname like 'DNF%'
or tr.dbname like 'BJAA_0001'
or tr.dbname = 'DBJ01' or tr.dbname like 'DNF%')
*/
sqlFlds = sqlFields(flds)
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
do forever
call adrSql 'fetch c1 into' sqlFlds
if sqlCode = 100 then
leave
call stripVars flds
nd = mPutVars(mAdd(ri, cr'.'tb'.'rNa), flds)
end
call adrSql 'close c1'
say m.ri.0 'references'
return
endProcedure infoRI
mapAltNeu: procedure expose m.
parse arg newCr
do tx=1 to m.tb.0
cc = tb'.'tx
if ^ mapHasKey(nn, newCr'.'m.cc.tb) then
call err 'old table' m.cc 'has no corr. new'
dd = mapGet(nn, newCr'.'m.cc.tb)
if ^mapHasKey(db.a2n, m.cc.db) then
call err 'old table' m.cc 'ts in bad db' m.cc.db'.'m.cc.ts
if m.dd.oldNd ^== '' then
call err 'old table' m.cc 'maps to new' m.dd ,
'which already maps to' m.dd.oldNd
nTs = m.dd.for
if mapGet(db.a2n, m.cc.db) <> left(nTs, pos('.', nTs)-1) then
call err 'new table' m.dd 'in wrong db' nTs
m.cc.newNd = dd
m.dd.oldNd = cc
end
do dx=1 to m.dep.0
dd = dep'.'dx
if ^ mapHasKey(nn, newCr'.'m.dd.na) then
call err 'old dep' m.dd.ty m.dd 'has no corr. new'
ww = mapGet(nn, newCr'.'m.dd.na)
a = m.dd.ty
if a == 'V' then do
if m.ww.ty ^== 'V' then
call err 'old view' m.dd 'maps to' m.ww.ty m.ww
if m.ww.oldNd ^== '' then
call err 'old view' m.dd 'maps to' m.ww.ty m.ww ,
'which is already mapped to' m.ww.oldNd
m.ww.oldNd = dd
m.dd.newNd = ww
end
else if a == 'A' then do
if m.dd.na ^== m.dd.bNa then
call err 'bad old alias' m.dd ,
'for' m.dd.bCr'.'m.dd.bNa
m.ww.oldAl = m.ww.oldAl m.dd
end
else do
call err 'bad dep type' m.dd.ty m.dd
end
end
do nx=1 to m.nn.0
ww = nn'.'nx
if m.ww.ty = 'T' | m.ww.ty = 'V' then do
oo = m.ww.oldNd
if oo == '' then
call err 'no old for new' m.ww.ty m.ww
else if m.oo.cr ^== newCr & m.ww.oldAl = '' then
say '*warn: no old alias for new obj' m.ww.ty m.ww
end
end
bLim = 1E+9
tLim = 30
tbs = 0
bys = 0
jobNo = 1
do tx=1 to m.ts.0
tt = ts'.'tx
if tbs > 0 & (bys + m.tt.used > bLim ,
| tbs + m.tt.nTb > tLim) then do
jobNo = jobNo + 1
bys = 0
tbs = 0
end
bys = bys + m.tt.used
tbs = tbs + m.tt.nTb
m.tt.job = jobNo
end
do ox=1 to m.tb.0
ot = tb'.'ox
os = m.ot.tsNd
nt = m.ot.newNd
ns = m.nt.for
if symbol('os.os') ^== 'VAR' then
os.os = ns
else if wordPos(ns, os.os) < 1 then
os.os = os.os ns
if symbol('ns.ns') ^== 'VAR' then do
ns.ns = os
nt.ns = nt
end
else do
if ns.ns ^== os then
call err 'new TS maps to old' ns.ns 'and' os
if wordPos(nt, nt.ns) < 1 then
nt.ns = nt.ns nt
end
end
do ox=1 to m.ts.0
os = ts'.'ox
do nx=1 to words(os.os)
ns = word(os.os, nx)
do ny=1 to words(nt.ns)
nt = word(nt.ns, ny)
ot = m.nt.oldNd
say 'old' m.ot.cr m.ot.tb m.os.db m.os.ts ,
'new' m.nt.cr m.nt.na ns
nq = pos('.', ns)
call mPut mAdd(job, m.ot), m.jobFlds, m.os.job,
, m.ot.cr, m.ot.tb, m.os.db, m.os.ts,
, m.nt.cr, m.nt.na, left(ns,nq-1), substr(ns,nq+1)
end
end
end
return
endProcedure mapAltNeu
showAltNeu: procedure expose m.
parse arg out
m.o.0 = 0
do dx=1 to m.db.0
dd = db'.'dx
call mAdd o, 'mD' left(m.dd.alt, 20)left(m.dd.neu, 20)
end
do tx=1 to m.tb.0
tt = tb'.'tx
ss = m.tt.tsNd
l = 'oT' left(m.tt, 20)left(m.ss, 20) ,
|| right(m.ss.job, 4) m.ss.used,
|| right(m.ss.ntb, 4) || right(m.ss.parts, 4) m.ss.bp
call mAdd o, l
end
do tx=1 to m.tb.0
tt = tb'.'tx
ww = m.tt.newNd
l = 'mt' left(m.tt, 20)left(m.ww, 20),
|| left(m.tt.ts, 8) m.ww.for
call mAdd o, l
end
do dx=1 to m.dep.0
dd = dep'.'dx
ww = m.dd.newNd
if m.dd.ty == 'V' then
l = 'mV' left(m.dd, 20)left(m.ww, 20)
else if m.dd.ty == 'A' then
l = 'dA' left(m.dd, 20)left(m.dd.bCr'.'m.dd.bNa, 20)
else
call err 'bad ty in dep' m.dd.ty m.dd
call mAdd o, l
end
do rx=1 to m.ri.0
rr = ri'.'rx
if ^mapHasKey(db.a2n, m.rr.db) ,
| ^mapHasKey(db.a2n, m.rr.bDb) then
q = '|f'
else if m.rr.db <> m.rr.bDb then
q = '|d'
else
q = '= '
call mAdd o, 'mR' left(m.rr.cr'.'m.rr.tb, 20) ,
|| left(m.rr.bCr'.'m.rr.bTb, 20) q m.rr.rNa
end
call writeDsn out, m.o., ,1
return
endProcedure showAltNeu
showJob: procedure expose m.
parse arg out
m.o.0 = 0
do jx=1 to m.job.0
jj = 'JOB.'jx
call mAdd o, right(m.jj.job, 4) ,
left(m.jj, 20) left(m.jj.db'.'m.jj.ts, 17) ,
left(m.jj.nCr, 10) left(m.jj.nDb'.'m.jj.nTs, 17)
end
call writeDsn out, m.o., ,1
call loadJob out
return
endProcedure showAltNeu
loadJob: procedure expose m.
parse arg inp
call readDsn inp, i.
do i=1 to i.0
parse var i.i job cr '.' tb db '.' ts nCr nDb '.' nTs .
call stripVars 'CR DB NDB'
nTb = tb
say job cr'.'tb db'.'ts 'old' nCr'.'tb nDb'.'nTs
call mPutVars mAdd('JOB', cr'.'db), m.jobFlds
end
return
endProcedure loadJob
alias: procedure expose m.
parse arg out
m.dr.0 = 0
m.cr.0 = 0
c = 0
call sqlId cr, dr
do dx=1 to m.dep.0
dd = dep'.'dx
if m.dd.ty ^== 'A' then
iterate
c = c + 1;
if c // 50 = 0 then
call commit cr, dr
call mAdd dr, 'DROP ALIAS' m.dd';'
call mAdd cr, 'CREATE ALIAS' m.dd 'FOR' m.dd.bCr'.'m.dd.bNa';'
end
call commit cr, dr
call writeDsn dsnSetMbr(out, dsnGetMbr(out) || 'CREA'), m.cr., ,1
call writeDsn dsnSetMbr(out, dsnGetMbr(out) || 'DROP'), m.dr., ,1
return
endProcedure alias
commit: procedure expose m.
do ax=1 to arg()
call mAdd arg(ax), 'COMMIT;'
end
return
endProcedure commit
sqlId: procedure expose m.
do ax=1 to arg()
call mAdd arg(ax), "SET CURRENT SQLID = 'S100447';"
end
return
endProcedure sqlId
unload: procedure expose m.
parse arg fun, out
call readDsn m.skels'(nakJobCa)', m.jc.
call readDsn m.skels'(nak'fun'Ut)', m.skSt.
call readDsn m.skels'(nak'fun'TS)', m.skTs.
call readDsn m.skels'(nak'fun'Tb)', m.skTb.
m.o.0 = 0
jj = ''
call envPut 'STEP', 'S01'
call envPut 'DBSYS', m.dbSys
call envPut 'DSNPRE', m.dPre'.'fun
do sx=1 to m.ts.0
ss = ts'.'sx
if jj <> m.ss.job then do
jj = m.ss.job
call envPut 'JOBNAME', 'Y' || m.tas3 || fun || jj
call envExpAll o, jc
call envExpAll o, skSt
end
call envPut 'TS', m.ss
if m.ss.parts = 0 then
call envPut 'PARTONE', ''
else
call envPut 'PARTONE', 'PART 1'
call envExpAll o, skTS
do tx=1 to m.tb.0
tt = tb'.'tx
if m.tt.tsNd ^== ss then
iterate
call envPut 'TB', m.tt.cr'.'m.tt.tb
call envExpAll o, skTb
say 'job' jj 'ts' m.ss 'tb' m.tt
end
end
call writeDsn out, m.o., ,1
return
endProcedure unload
loadLines: procedure expose m.
parse arg punPre
do sx=1 to m.ts.0
ss = ts'.'sx
pun = punPre'.'m.ss.ts'.PUN'
call readDsn pun, p.
wh = ''
tbCnt = 0
do p=1 to p.0
w1 = word(p.p, 1)
if w1 = 'LOAD' then do
wh = 'l'
end
else if w1 = 'INTO' then do
wh = 'i'
if word(p.p, 2) ^== 'TABLE' then
call err 'TABLE expected in line' p 'in' pun':' p.p
w3 = word(p.p, 3)
dx = pos('.', w3)
if dx < 1 then
call err '. expected in w3 line' p 'in' pun':' p.p
crTb = strip(left(w3, dx-1), 'b', '"')'.',
||strip(substr(w3, dx+1), 'b', '"')
if ^ mapHasKey(crNa, crTb) then
call err 'old table' crTb 'not found' ,
'for punchLine' p 'in' pun':' p.p
tt = mapGet(crNa, crTb)
if m.tt.tsNd ^== ss then
call err 'old table' crTb ,
'wrong ts' m.tt.db'.'m.tt.ts,
'for punchLine' p 'in' pun':' p.p
if ^mDefIfNot(tt'.LO.0', 0) then
call err 'already loaded table' crTb ,
'for punchLine' p 'in' pun':' p.p
tbCnt = tbCnt + 1
end
else if w1 = ')' then do
if strip(p.p) <> ')' then
call err 'bad ) line' p 'in' pun':' p.p
if wh <> 'i' then
call err ') in state' wh 'line' p 'in' pun':' p.p
call mAdd tt'.LO', p.p
wh = ''
end
else if wh == 'i' then do
call mAdd tt'.LO', p.p
end
else if wh == 'l' then do
if w1 ^== 'EBCDIC' then
call err 'bad line after load' ,
'in punchLine' p 'in' pun':' p.p
end
end
if wh ^== '' then
call err 'punch' pun 'ends in state' wh
if tbCnt <> m.ss.nTb then
call err tbCnt 'tables not' m.ss.nTb 'loaded for' m.ss
say 'loadCards for' tbCnt 'tables for' m.ss
end
return
endProcedure loadLines
load: procedure expose m.
parse arg fun, out
call readDsn m.skels'(nakJobCa)', m.jc.
call readDsn m.skels'(nak'fun'Ut)', m.skSt.
call readDsn m.skels'(nak'fun'TS)', m.skTs.
call readDsn m.skels'(nak'fun'Tb)', m.skTb.
m.o.0 = 0
jj = ''
call envPut 'STEP', 'S01'
call envPut 'DBSYS', m.dbSys
call envPut 'DSNPRE', m.dPre'.UNL'
do nx=1 to m.newTs.0
ns = newTs'.'nx
if jj <> m.ns.job then do
jj = m.ns.job
call envPut 'JOBNAME', 'Y' || m.tas3 || fun || jj
call envExpAll o, jc
call envExpAll o, skSt
end
call envPut 'TREC', TREC || nx
call envPut 'TS', m.ns
tt = word(m.ns.tbNds, 1)
oo = m.tt.oldNd
call envPut 'OLDTS', m.oo.ts
call envExpAll o, skTS
do tx=1 to words(m.ns.tbNds)
tt = word(m.ns.tbNds, tx)
call envPut 'TB', m.tt
call envExpAll o, skTb
call mAddSt o, m.tt.oldNd'.LO'
say 'job' jj 'ts' m.ns 'tb' m.tt
end
end
call writeDsn out, m.o., ,1
return
endProcedure load
check: procedure expose m.
parse arg out
call readDsn m.skels'(nakJobCa)', m.jc.
call readDsn m.skels'(nakChKSt)', m.skut.
call readDsn m.skels'(nakChKTb)', m.sktb.
call envPut 'STEP', 'S01'
call envPut 'DBSYS', m.dbSys
call envPut 'JOBNAME', 'Y' || m.tas3 || 'CHK' || jj
m.o.0 = 0
call envExpAll o, jc
call envExpAll o, skCh
do rx=1 to m.ri.0
rr = 'RI.'rx
dbTs = m.rr.db'.'m.rr.ts
if R.dbTs == 1 then
iterate
R.dbTs = 1
call envPut 'TS', dbTs
call envExpAll o, skTb
end
call writeDsn out, m.o., ,1
return
endProcedure check
err:
call errA arg(1), 1
endSubroutine err
envPut: procedure expose m.
parse arg na, va
call mapPut m.vars, na, va
return
endProcedure envPut
envIsDefined: procedure expose m.
parse arg na
return mapHasKey(m.vars, na)
endProcedure envIsDefined
envGet: procedure expose m.
parse arg na
return mapGet(m.vars, na)
endProcedure envGet
envRemove: procedure expose m.
parse arg na
return mapRemove(env.vars, na)
endProcedure envRemove
envExpand: procedure expose m.
parse arg src
cx = pos('$', src)
if cx < 1 then
return strip(src, 't')
res = left(src, cx-1)
do forever
if substr(src, cx+1, 1) = '{' then do
ex = pos('}', src, cx+2)
if ex < 1 then
call err 'missing } after' substr(src, cx) 'in' src
res = res || envGet(substr(src, cx+2, ex-cx-2))
ex = ex + 1
end
else do
ex = verify(src, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_',
|| 'abcdefghijklmnopqrstuvwxyz', 'n', cx+1)
if ex < 1 then
return strip(res || envGet(substr(src, cx+1)), 't')
res = res || envGet(substr(src, cx+1, ex-cx-1))
end
cx = pos('$', src, ex)
if cx < 1 then
return strip(res || substr(src, ex), 't')
res = res || substr(src, ex, cx-ex)
end
endProcedure envExpand
envExpAll: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx+1
m.dst.dx = envExpand(m.src.sx)
end
m.dst.0 = dx
return
endProcedure envExpAll
testExp: procedure
call mIni
m.xx.0 = 0
call envPut 'v1', eins
call envPut 'v2', zwei
call testExp1 'ohne variabeln'
call testExp1 '$v1 variabeln'
call testExp1 'mit $v1 iabeln'
call testExp1 'mit variab$v1'
call testExp1 '${v2}variabeln'
call testExp1 'mit vari${v1}'
call testExp1 'mit v${v2}eln'
call testExp1 'mit v${v1}eln'
call testExp1 'mit $v1 viel${v2}+$v1-vars${v2}'
call envExpAll mCut(yy, 0), xx
do x=1 to m.yy.0
say 'tesStem exp' m.yy.x'|'
end
return
endProcedure testExp
testExp1: procedure expose m.
parse arg src
call mAdd xx, src
say 'testExp src' src'|'
say 'testExp exp' envExpand(src)'|'
return
endProcedure testExp1
/* copy scanSql begin *************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanSqlReader: procedure expose m.
parse arg m, inRdr
call scanReader m, inRdr
call scanOptions m, , '0123456789_' , '--'
m.scan.m.sqlBrackets = 0
return m
endProcedure scanSqlReader
scanSqlSeekId: procedure expose m.
parse arg m, lx, cmd
call adrEdit "cursor =" lx
do while adrEdit("seek" cmd 'word', 4) = 0 /* find each command*/
call adrEdit "(fx) = cursor"
call debug 'scanSqlSeekId after' lx 'found' cmd 'at' fx
call editReadDefine m, fx
call scanSqlReader m, m
do while m.m.editReadLx <= fx
if scanSql(scanSkip(m)) = '' then
return -1
if m.sqlType = 'i' & m.val == cmd then
return fx
end
end
return -1
endProcedure scanSqlSeekId
ePos: procedure expose m.
parse arg m
return m.m.editReadLx m.scan.m.pos
endProcedure ePos
/*--- scan a sql token put type in m.sqltype:
'i': ordinary identifier e.g. Name
'd': delimited identifier e.g. "Delimited"
'q': quantified identifier e.g. abc."efg"
'u': integer units e.g. 8G
'n': number e.g. -234
"'": string e.g. 'abc''ef'
'' : at end
: any other character e.g. ;
----------------------------------------------------------------*/
scanSql: procedure expose m.
parse arg m
if scanAtEnd(m) then do
m.sqlType = ''
m.val = ''
end
else if scanString(m, "'") then
m.sqlType = "'"
else if scanSqlQuId(m) ^== '' then
nop
else if scanSqlNumUnit(m, 1) ^== '' then
nop
else if scanChar(m, 1) then do
m.sqlType = m.tok
m.val = ''
if m.tok = '(' then
m.scan.m.sqlBrackets = m.scan.m.sqlBrackets + 1
else if m.tok = ')' then
m.scan.m.sqlBrackets = m.scan.m.sqlBrackets - 1
end
else
call scanErr m, 'cannot scan sql'
return m.sqlType
endProcedure scanSql
/*--- scan an ordinary sql identifier e.g. abc, ef_12 ----------------*/
scanSqlId: procedure expose m.
parse arg m
if ^ scanName(m) then
return ''
m.val = translate(m.tok)
m.sqlType = 'i'
return m.val
endProcedure scanSqlId
/*--- scan a delimited or ordinay sql identifier ---------------------*/
scanSqlDeId: procedure expose m.
parse arg m
if scanSqlId(m) == '' then do
if scanString(m, '"') then do
val = strip(val, 't')
m.sqlType = 'd'
end
end
return m.val
endProcedure scansqlDeId
/*--- scan a qualified sql identifier --------------------------------*/
scanSqlQuId: procedure expose m.
parse arg m
if scanSqlDeId(m) == '' then
return ''
res = ''
do qx=1 by 1
m.val.qx = m.val
res = res'.'m.val
if ^ scanLit(scanSkip(m), '.') then do
m.val.0 = qx
if qx > 1 then
m.sqlType = 'q'
m.val = substr(res, 2)
return m.val
end
if scansqlDeId(scanSkip(m)) == '' then
call scanErr m, 'id expected after .'
end
endProcedure scanSqlQuId
/*--- scan a sql number ----------------------------------------------*/
scanSqlNum: procedure expose m.
parse arg m, checkEnd
c3 = left(scanLook(m, 3), 3)
p = left(c3, 1) == '+' | left(c3, 1) == '-'
p = p + (substr(c3, p + 1, 1) == '.')
if pos(substr(c3, p+1, 1), '0123456789') < 1 then
return ''
n = ''
if p > 0 & left(c3, 1) ^== '.' then do
call scanChar m, 1
n = m.tok
end
if scanVerify(m, '0123456789') then
n = n || m.tok
if scanLit(m, '.') then do
n = n'.'
if scanVerify(m, '0123456789') then
n = n || m.tok
end
c3 = left(translate(scanLook(m, 3)), 3)
if left(c3, 1) == 'E' then do
p = substr(c3, 2, 1) == '+' | substr(c3, 2, 1) == '-'
if pos(substr(c3, p+2, 1), '0123456789') > 0 then do
call scanChar m, p+1
n = n || m.tok
if scanVerify(m, '0123456789') then
n = n || m.tok
c3 = scanLook(m, 1)
end
end
if checkEnd ^= 0 then
if pos(left(c3, 1), m.scan.m.name) > 0 then
call scanErr m, 'end of number' n 'expected'
m.val = n
return n
endProcedure scanSqlNum
/*--- scan a sql number with unit K M or G ---------------------------*/
scanSqlNumUnit: procedure expose m.
parse arg m, both
nu = scanSqlNum(m, 0)
if nu = '' then
return ''
sp = scanSpaceNl(m)
af = translate(scanSqlId(m))
if wordPos(af, "K M G") > 0 then do
m.sqlType = 'u'
m.val = nu || af
return m.val
end
else if af <> '' & ^ sp then
call scanErr m, 'end of number' nu 'expected'
if both ^== 1 then
call scanErr m, 'unit K M or G expected'
else if af ^== '' then
call scanBack m, m.tok
m.sqlType = 'n'
m.val = nu
return nu
endProcedure scanSqlNumUnit
scanSqlskipBrackets: procedure expose m.
parse arg m, br
call scanSpaceNl m
if br ^== '' then
nop
else if ^ scanLit(m, '(') then
return 0
else
br = 1
do forever
t = scanSql(scanSpaceNl(m))
if t = '' | t = ';' then
call scanErr m, 'closing )'
else if t = '(' then
br = br + 1
else if t ^== ')' then
nop
else if br > 1 then
br = br - 1
else if br = 1 then
return 1
else
call scanErr m, 'skipBrackets bad br' br
end
endProcedure skipBrackets
/* copy scanSql end *************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanReader(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
m.scan.m.pos = 1
if symbol('m.scan.m.name') ^== 'VAR' then
call scanInit m
return m
endProcedure scanLine
/*--- switch to next line if atEnd of line or unCond=1 ---------------*/
scanNL: procedure expose m.
parse arg m, unCond
if m.scan.m.reading then do
interpret m.scan.m.scanNl
end
else do
np = 1 + length(m.scan.m.src)
if np <= m.scan.m.pos then
return 0
if unCond == 1 then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' ,
& abbrev(m.scan.m.src, m.scan.m.comment) then nop
else
return 0
m.scan.m.pos = np
return 1
end
endProcedure scanNL
scanAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.reading then
interpret m.scan.m.scanAtEnd
else
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEnd
/*--- initialize scanner for m --------------------------------------*/
scanInit: procedure expose m.
parse arg m, rdng
m.scan.m.reading = rdng == 1
m.tok = ''
m.val = ''
m.key = ''
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
return
endProcedure scanInit
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, m.scan.m.comment
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanInit m
if nameOne ^== '' then do
m.scan.m.Name1 = nameOne
m.scan.m.name = m.scan.m.name1 || '0123456789'
end
if namePlus ^== '' then
m.scan.m.name = m.scan.m.name1 || namePlus
return
endProcedure scanOptions
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
return substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
m.tok = scanLook(m, len)
m.scan.m.pos = m.scan.m.pos + length(m.tok)
return length(m.tok) > 0
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
ScanNat: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok 'scanPosition' ,
strip(left(substr(m.scan.m.src, m.scan.m.pos), 40), 't')
if m.scan.m.reading then
interpret 'say " "' m.scan.m.scanLinePos
else
say ' pos' m.scan.m.Pos 'in string' strip(m.scan.m.src, 't')
call err 'scanErr' txt
return
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
res = 0
do forever
if scanVerify(m, ' ') then nop
else if ^ scanNL(m) then leave
res = 1
end
m.tok = lastTok
return res
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- begin scanning the lines of a reader ---------------------------*/
scanReader: procedure expose m.
parse arg m, m.scan.m.rdr
call scanInit m, 1
m.scan.m.atEnd = 0
m.scan.m.lineX = 0
m.scan.m.scanNl = 'return scanReaderNl(m, unCond)'
m.scan.m.scanAtEnd = 'return scanReaderAtEnd(m, what)'
m.scan.m.scanLinePos = "scanReaderLinePos(m)"
call scanReaderNl m, 1
return m
endProcedure scanReader
/*--- return true/false whether we are at the end of line / reader ---*/
scanReaderAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if what == 'l' then
return 1
return m.scan.m.atEnd
endProcedure scanReaderAtEnd
scanReaderNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then nop
else if unCond ^= 2 & m.scan.m.pos > length(m.scan.m.src) then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' & abbrev(substr( ,
m.scan.m.src, m.scan.m.pos), m.scan.m.comment) then nop
else
return 0
if m.scan.m.atEnd then
return 0
m.scan.m.atEnd = ^ jRead(m.scan.m.rdr, 'SCAN.'m'.SRC')
if m.scan.m.atEnd then do
m.scan.m.pos = 1 + length(m.scan.m.src)
end
else do
m.scan.m.pos = 1
m.scan.m.lineX = m.scan.m.lineX + 1
end
return ^ m.scan.m.atEnd
endProcedure scanReaderNL
scanReaderLinePos: procedure expose m.
parse arg m
if m.scan.m.atEnd then
qq = 'atEnd after'
else
qq = 'pos' m.scan.m.pos 'in'
return qq 'line' m.scan.m.lineX':' strip(m.scan.m.src, 't')
endProcedure scanReaderLinePos
/* copy scan end ****************************************************/
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jNew: procedure expose m.
if m.j.jIni ^== 1 then
call jIni
return 'J.'mInc(j)
endProcedure jNew
jFree: procedure expose m.
parse arg m
return
endProcedure jFree
jRead: procedure expose m.
parse arg m, arg
res = '?'
interpret m.j.m.read
return res
endProcedure jRead
jWrite: procedure expose m.
parse arg m, arg
interpret m.j.m.write
return
endProcedure jWrite
jReset: procedure expose m.
parse arg m, arg
interpret 'call' m.j.m.pref'Reset m, arg'
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret 'call' m.j.m.pref'Open m, arg'
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
interpret 'call' m.j.m.pref'Close m'
m.j.m.read = 'call err "read('m') when closed"'
m.j.m.write = 'call err "write('m') when closed"'
return m
endProcedure jClose
jDefine: procedure expose m.
parse arg m, m.j.m.pref
m.j.m.read = 'call err "read('m') when closed"'
m.j.m.write = 'call err "write('m') when closed"'
return m
endProcedure jDefine
jDefRead: procedure expose m.
parse arg m, m.j.m.read
m.j.m.write = 'call err "write('m') when reading"'
return m
endProcedure jDeRead
jDefWrite: procedure expose m.
parse arg m, m.j.m.write
m.j.m.read = 'call err "read('m') when writing"'
return m
endProcedure jDeWrite
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jIni: procedure expose m.
parse arg force
if m.j.jIni == 1 & force ^== 1 then
return
m.j.jIni = 1
m.j.0 = 0
m.j.defDD.0 = 0
m.j.jIn = jNew()
m.j.jOut = jNew()
call jDefine m.j.jIn, "jStdIOError "
call jDefRead m.j.jIn, "res = 0"
call jDefine m.j.jOut, "jStdIOError "
call jDefWrite m.j.jOut, "say arg"
return
endProcedure jIni
jStdIOError: procedure expose m.
parse arg fun m, arg
call err 'do not j'fun'('m',' arg') base stdIn/stdOut'
return
endSubroutine
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
jBuf: procedure expose m.
m = jNew()
call jDefine m, "jBuf"
do ax=1 to arg()
m.j.m.buf.ax = arg(ax)
end
m.j.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
do ax=1 to arg() - 1
m.j.m.buf.ax = arg(ax+1)
end
m.j.m.buf.0 = ax-1
return m
endProcedure jBufReset
jBufOpen: procedure expose m.
parse arg m, opt
if opt == 'r' then do
call jDefRead m, "res = jBufRead(m , arg)"
m.j.m.bufIx = 0
return m
end
if opt == 'w' then
m.j.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
call jDefWrite m, "call mAdd 'J.'m'.BUF', arg"
return m
endProcedure jBufOpen
jBufClose:
return arg(1)
endProcedure jBufClose
jBufStem: procedure expose m.
parse arg m
return 'J.'m'.BUF'
endProcedure jBufStem
jBufRead: procedure expose m.
parse arg m, var
ix = m.j.m.bufIx + 1
if ix > m.j.m.buf.0 then
return 0
m.j.m.bufIx = ix
m.var = m.j.m.buf.ix
return 1
endProcedure jBufRead
jDsn: procedure expose m.
parse arg spec
m = jNew()
m.j.m.state = ''
call jDefine m, "jDsn"
m.j.m.defDD = 'J'mInc('J.DEFDD')
call jDsnReset m, spec
return m
endProcedure jDsn
jDsnReset: procedure expose m.
parse arg m, spec
call jClose m
m.j.m.dsnSpec = spec
return m
endProcedure jDsnReset
jDsnOpen: procedure expose m.
parse arg m, opt
call jDsnClose m
if opt == 'r' then do
aa = dsnAlloc(m.j.m.dsnSpec, 'SHR', m.j.m.defDD)
call readDDBegin word(aa, 1)
call jDefRead m, "res = jDsnRead(m , arg)"
end
else do
if opt == 'w' then
aa = dsnAlloc(m.j.m.dsnSpec, 'OLD', m.j.m.defDD)
else if opt == 'a' then
aa = dsnAlloc(m.j.m.dsnSpec, 'MOD', m.j.m.defDD)
else
call err 'jBufOpen('m',' opt') with bad opt'
call writeDDbegin word(aa, 1)
call jDefWrite m, "call jDsnWrite m , arg"
end
m.j.m.state = opt
m.j.m.dd = word(aa, 1)
m.j.m.free = subword(aa, 2)
return m
endProcedure jBufOpen
jDsnClose:
parse arg m
if m.j.m.state ^== '' then do
if m.j.m.state == 'r' then do
call readDDend m.j.m.dd
end
else do
if m.j.m.buf.0 > 0 then
call writeDD m.j.m.dd, 'M.J.'m'.BUF.'
call writeDDend m.j.m.dd
end
interpret m.j.m.free
end
m.j.m.buf.0 = 0
m.j.m.bufIx = 0
m.j.m.state = ''
m.j.m.free = ''
m.j.m.dd = ''
return m
endProcedure jDsnClose
jDsnRead: procedure expose m.
parse arg m, var
ix = m.j.m.bufIx + 1
if ix > m.j.m.buf.0 then do
res = readDD(m.j.m.dd, 'M.J.'m'.BUF.')
if ^ res then
return 0
ix = 1
end
m.j.m.bufIx = ix
m.var = m.j.m.buf.ix
return 1
endProcedure jDsnRead
jDsnWrite: procedure expose m.
parse arg m, var
ix = m.j.m.buf.0 + 1
m.j.m.buf.0 = ix
m.j.m.buf.ix = var
if ix > 99 then do
call writeDD m.j.m.dd, 'M.J.'m'.BUF.'
m.j.m.buf.0 = 0
end
return
endProcedure jDsnWrite
/* copy j end *********************************************************/
/* copy adrSql begin *************************************************/
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then do
return 0
end
else if rc < 0 then do
if ggRet == '*' then nop
else if wordPos(sqlCode, ggRet) > 0 then nop
else
call err "sql rc" rc sqlmsg() ggNo
end
else if sqlWarn.0 ^== ' ' then do
say 'warning' sqlMsg() ggNo
end
return sqlCode
endSubroutine adrSql
adrSqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call adrSql "connect" ggSys, ggRetCon ,1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
parse arg ggRet
call adrSql "disconnect ", ggRet, 1
return
endProcedure adrSqlDisconnect
sqlFields: procedure
parse arg flds
sql = ''
do wx=1 to words(flds)
sql = sql', :'word(flds, wx)
end
if wx > 1 then
sql = substr(sql, 3)
return sql
endProcedure sqlFields
sqlMsg: /* no procedure, to keep variables sql... */
ggW = ''
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggw = ggw ggx'='sqlWarn.ggx
end
ggXX = pos(':', ggSqlStmt)
ggVV = ''
if ggXX > 0 then do
ggVV = word(substr(ggSqlStmt, ggXX + 1), 1)
ggXX = verify(ggVV, ' ,:+-*/&%?|', 'm')
if ggXX > 0 then
ggVV = left(ggVV, ggXX-1)
ggVV = 'with' ggVV '=' value(ggVV)
end
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x)) ,
'stmt = ' ggSqlStmt ggVV
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/* copy adrSql 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 -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
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 ds = '' then
ds = dsn2jcl(w)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
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)'
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 m begin ********************************************************
stem and type handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a.0 = m.a.0 + 1
return m.a.0
endProcedure mInc
mDefIfNot: procedure expose m.
parse arg a, put
if symbol('m.a') == 'VAR' then
return 0
m.a = put
return 1
endProcedure mDefIfNot
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- put into stem a the fields flds from arguments -----------------*/
mPut: procedure expose m.
parse arg a, flds
do wx = 1 to words(flds)
f = word(flds, wx)
m.a.f = arg(wx+2)
end
return a
endProcedure mPut
/*--- put into stem a the fields flds from stem b --------------------*/
mPutSt: procedure expose m.
parse arg a, flds, b
do wx = 1 to words(flds)
f = word(flds, wx)
m.a.f = m.b.f
end
return a
endProcedure mPutSt
/*--- put into stem a the fields flds from variable pool -------------*/
mPutVars:
parse arg ggA, ggFlds
do ggWx = 1 to words(ggFlds)
ggF = word(ggFlds, ggWx)
m.ggA.ggF = value(ggF)
end
return ggA
endProcedure mPutVars
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
if m.m.mIni ^== 1 then
call mIni
return mapReset(mAdd(m.map, 'map'))
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.a.mapKey') == 'VAR' then
call mapClear a
m.a.mapKey = translate(opt) = 'K'
if m.a.mapKey then
m.a.mapKey.0 = 0
else
m.a.mapKey.0 = 'noMapKeys'
return a
endProcedure
mapClear: procedure expose m.
parse arg a
do kx=1 to m.a.mapKey.0
k = m.a.mapKey.kx
drop m.a.mapK2V.k m.a.mapKey.kx
end
m.a.mapKey.0 = 0
return a
endProcedure mapClear
mapAdd: procedure expose m.
parse arg a, ky, val
if symbol('m.a.mapK2V.ky') == 'VAR' then
call err 'duplicate key in mAdd('a',' ky',' val')'
m.a.mapK2V.ky = val
if m.a.mapKey then
call mAdd a.mapKey, ky
return
endProcedure mapAdd
mapPut: procedure expose m.
parse arg m, ky, val
if m.m.mapKey then
if symbol('m.m.mapK2V.ky') ^== 'VAR' then
call mAdd m.mapKey, ky
m.m.mapK2V.ky = val
return
endProcedure mapPut
mapHasKey: procedure expose m.
parse arg m, ky
return symbol('m.m.mapK2V.ky') == 'VAR'
endProcedure mapHasKey
mapGet: procedure expose m.
parse arg m, ky
if symbol('m.m.mapK2V.ky') ^== 'VAR' then
call err 'missing key in mapGet('m',' ky')'
return m.m.mapK2V.ky
endProcedure mapGet
mapGetOr: procedure expose m.
parse arg m, ky, orDef
if symbol('m.m.mapK2V.ky') == 'VAR' then
return m.m.mapK2V.ky
else
return orDef
endProcedure mapGetOr
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mGetType:
parse arg name
return mapGet(m.type, name)
endProcedure mGetType
mTypeNew: procedure expose m.
parse arg name, stem, flds, types
if m.m.ini ^== 1 then
call mIni
ty = mAdd(m.type, name)
call mapAdd m.type, name, ty
m.ty.ass = '='
m.ty.type = stem
m.ty.0 = words(flds)
m.ty.type.0 = m.ty.0
do y=1 to m.ty.0
m.ty.y = word(flds, y)
if word(types, y) = '' then
m.ty.type.y = m.type.1
else
m.ty.type.y = word(types, y)
end
return ty
endProcedure mTypeNew
mShow: procedure expose m.
parse arg ty, a, lv
if lv='' then
lv = 0
pr = a
if lv > 0 & lastPos('.', pr) > 0 then
pr = substr(pr, lastPos('.', pr))
say left('', lv)pr '=' m.a
do y=1 to m.ty.0
call mShow m.ty.type.y, a'.'m.ty.y, lv+1
end
if m.ty.type ^== '' then do
do y=1 to m.a.0
call mShow m.ty.type, a'.'y, lv+1
end
end
return
endProcedure mShow
mClear: procedure expose m.
parse arg ty, a, val
m.a = val
do y=1 to m.ty.0
call mClear m.ty.type.y, a'.'m.ty.y
end
if m.ty.type ^== '' then
m.a.0 = 0
return
endProcedure mClear
mTypeSay: procedure expose m.
parse arg t
say 'type' t'='m.t 'ass' m.t.ass '#' m.t.0 'tys' m.t.type
return
endProcedure mInit
mTypeCopy: procedure expose m.
parse arg ty, t, f
if m.ty.ass == '=' then
m.t = m.f
else
call err 'type.ass' m.ty.ass 'not supported'
do x = 1 to m.ty.0
fld = m.ty.x
call mTypeCopy m.ty.type.x, t'.'fld, f'.'fld
end
if m.ty.type ^== '' then do
do y = 1 to m.f.0
call mTypeCopy m.ty.type, t'.'y, f'.'y
end
m.t.0 = m.f.0
end
return t
endProcedure mTypeCopy
mIni: procedure expose m.
m.m.ini = 1
m.m.type.0 = 0
m.m.map.0 = 0
call mapReset m.type
call mapReset m.vars
siTy = mTypeNew('Simple')
stTy = mTypeNew('Stem', siTy)
tyTy = mTypeNew('Type', siTy, 'ASS TYS', siTy stTy)
ttTy = mTypeNew('StemType', tyTy)
return
endProcedure mIni
mTest: procedure
call mIni
siTy = mGetType('Simple')
tyTy = mGetType('Type')
ttTy = mGetType('StemType')
say 'siTy' siTy 'tyTy' tyTy 'stTyTy' ttTy
call mTypeSay siTy
call mTypeCopy siTy, nnn, siTy'.'ass
say 'm.nnn nach copy' m.nnn
call mTypeCopy tyTy, mmm, siTy
call mTypeSay mmm
call mTypeCopy tyTy, qqq, tyTy
call mTypeSay qqq
call mShow tyTy, qqq
call mShow ttTy, m.type
return
endProcedure mTest
/* copy m end *********************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(NN) cre=2007-06-25 mod=2007-06-25-15.06.34 F540769 ---
}¢--- A540769.WK.REXX.O08(NUM) cre=2006-07-31 mod=2006-08-02-07.12.21 F540769 ---
/* rexx ****************************************************************00010000
line- word and character count 00020000
***********************************************************************/00030000
say 'num begin' 00040000
/* call adrTso 'alloc dd(ddIn) shr reuse dsn(wk.Text(testIn)' 00050002
call adrTso 'alloc dd(ddOut) shr reuse dsn(wk.Text(testOut)' 00060002
*/ 00070002
call readDDBegin ddIn 00080000
call writeDDBegin ddOut 00090000
cc = 0 00100000
lc = 0 00110000
lx = 0 00120000
wc = 0 00130000
do bc=1 by 1 while readDD(ddIn, r.) 00140000
lc = lc + r.0 00150000
do rx = 1 to r.0 00160000
lx = lx + 1 00170000
cc = cc + length(r.rx) 00180000
wc = wc + words(r.rx) 00190000
/* r.rx = overlay(lx*lx, r.rx, 10, 5) */ 00200002
r.rx = overlay(d2c(lx*lx, 4), r.rx, 16, 4) 00210001
end 00220000
call writeDD ddOut, r. 00230000
end 00240000
call readDDEnd ddIn 00250000
call writeDDEnd ddOut 00260000
call adrTso 'free dd(ddIN ddOut)' 00270000
say 'lc' lc 'wc' wc 'cc' cc 'for' dsn 00280000
exit 00290000
err: 00300000
parse arg ggMsg 00310000
call errA ggMsg 00320000
exit 12 00330000
endSubroutine err 00340000
/* copy adrTso begin *************************************************/ 00350000
/*--- format dsn from tso format to jcl format -----------------------*/00360000
dsn2jcl: procedure 00370000
parse arg dsn . 00380000
if left(dsn,1) = "'" then 00390000
return strip(dsn, 'b', "'") 00400000
else if sysvar('SYSPREF') = '' then 00410000
return dsn 00420000
else 00430000
return sysvar('SYSPREF')'.'dsn 00440000
endProcedure dsn2Jcl 00450000
00460000
/*--- format dsn from jcl format to tso format -----------------------*/00470000
dsnFromJcl: procedure 00480000
parse arg dsn . 00490000
return "'"dsn"'" 00500000
endProcedure dsnFromJcl 00510000
00520000
/********************************************************************** 00530000
io: read or write a dataset with the following callsequences: 00540000
read: readDDBegin, readDD*, readDDEnd 00550000
write: writeBegin, writeDD*, writeEnd 00560000
00570000
readDD returns true if data read, false at eof 00580000
***********************************************************************/00590000
00600000
/*--- prepare reading from a DD --------------------------------------*/00610000
readDDBegin: procedure 00620000
return /* end readDDBegin */ 00630000
00640000
/*--- read from DD ggDD into ggSt, return false at eof ---------------*/00650000
readDD: 00660000
parse arg ggDD, ggSt, ggCnt 00670000
if ggCnt = '' then 00680000
ggCnt = 100 00690000
call adrTso 'execio' ggCnt 'diskr' ggDD '(stem' ggSt')', 2 00700000
return (value(ggSt'0') > 0) 00710000
return /* end readDD */ 00720000
00730000
readDDall: 00740000
parse arg ggDD, ggSt 00750000
call adrTso 'execio * diskr' ggDD '(stem' ggSt' finis)' 00760000
return 00770000
endSubroutine readDDall 00780000
00790000
readDSN: 00800000
parse arg dsn, ggSt 00810000
call adrTso 'alloc dd(readDsn) shr dsn('dsn')' 00820000
call readDDall readDsn, ggSt 00830000
call adrTso 'free dd(readDsn)' 00840000
return 00850000
endSubroutine readDsn 00860000
00870000
/*--- finish reading DD ggDD ----------------------------------------*/00880000
readDDEnd: procedure 00890000
parse arg ggDD 00900000
call adrTso 'execio 0 diskr' ggDD '(finis)' 00910000
return /* end readDDEnd */ 00920000
00930000
/*--- prepare writing to DD ggDD -------------------------------------*/00940000
writeDDBegin: procedure 00950000
parse arg ggDD 00960000
/* ensure file is erased, if no records are written */00970000
call adrTso 'execio' 0 'diskw' ggDD '(open)' 00980000
return /* end writeDDBegin */ 00990000
01000000
/*--- write to gg ggDD from stem ggSt, ggCnt records -----------------*/01010000
writeDD: 01020000
parse arg ggDD, ggSt, ggCnt 01030000
if ggCnt == '' then 01040000
ggCnt = value(ggst'0') 01050000
call adrTso 'execio' ggCnt 'diskw' ggDD '(stem' ggSt')' 01060000
return 01070000
endSubroutine writeDD 01080000
01090000
/*--- end writing to dd ggDD (close) --------------------------------*/ 01100000
writeDDEnd: procedure 01110000
parse arg ggDD 01120000
call adrTso 'execio 0 diskw' ggDD '(finis)' 01130000
return /* end writeDDEnd */ 01140000
01150000
/*--- end write a stem to a dsn -------------------------------------*/ 01160000
writeDSN: 01170000
parse arg dsn, ggSt 01180000
call adrTso 'alloc dd(wriDsn) shr dsn('dsn')' 01190000
call adrTso 'execio' value(ggSt'0') , 01200000
'diskw wriDsn (stem' ggSt 'finis)' 01210000
call adrTso 'free dd(wriDsn)' 01220000
return 01230000
/*--- send ggTsoCmd to tso, fail if rc <> 0 or not listed in ggRet ---*/01240000
adrTso: 01250000
parse arg ggTsoCmd, ggRet 01260000
address tso ggTsoCmd 01270000
if rc == 0 then return 0 01280000
else if ggRet == '*' then return rc 01290000
else if wordPos(rc, ggRet) > 0 then return rc 01300000
else 01310000
call err 'adrTso rc' rc 'for' ggTsoCmd 01320000
return /* end adrTso */ 01330000
/* copy adrTso end ****************************************************/01340000
/* copy err begin ******************************************************01350000
messages, errorhandling,help 01360000
***********************************************************************/01370000
/* caller should define err as follows ---------------------------------01380000
err: 01390000
parse arg ggMsg 01400000
call errA ggMsg 01410000
exit 12 01420000
endSubroutine err 01430000
end call should define err ----------------------------------------*/01440000
01450000
/*--- error routine: abend with message ------------------------------*/01460000
errA: 01470000
parse arg ggTxt 01480000
parse source . . ggS3 . /* current rexx */01490000
say 'fatal error in' ggS3':' ggTxt 01500000
x = x / 0 01510000
exit setRc(12) 01520000
endSubroutine errA 01530000
01540000
/*--- abend with Message after displaying help -----------------------*/01550000
errHelp: procedure 01560000
parse arg ggMsg 01570000
say 'fatal error:' ggMsg 01580000
call help 01590000
call err ggMsg 01600000
endProcedure errHelp 01610000
01620000
/*--- set rc for ispf: -------------------------------------------------01630000
if a cmd is run by ispStart, its RC is ignored, 01640000
but ISPF passes the value of the shared varible zIspfRc 01650000
back as return code 01660000
----------------------------------------------------------------------*/01670000
setRc: procedure 01680000
parse arg zIspfRc 01690000
if sysVar('sysISPF') = 'ACTIVE' then do 01700000
say 'exitRc setting zIspfRc='zIspfRc 01710000
address ispExec vput 'zIspfRc' shared 01720000
end 01730000
return zIspfRc 01740000
endProcedure setRc 01750000
01760000
/*--- output a trace message if m.trace is set -----------------------*/01770000
trc: procedure expose m. 01780000
parse arg msg 01790000
if m.trace == 1 then 01800000
say 'trc:' msg 01810000
return 01820000
endProcedure trc 01830000
01840000
/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/01850000
quote: procedure 01860000
parse arg txt, qu 01870000
if qu = '' then 01880000
qu = '"' 01890000
res = qu 01900000
ix = 1 01910000
do forever 01920000
qx = pos(qu, txt, ix) 01930000
if qx = 0 then 01940000
return res || substr(txt, ix) || qu 01950000
res = res || substr(txt, ix, qx-ix) || qu || qu 01960000
ix = qx + length(qu) 01970000
end 01980000
endProcedure quote 01990000
02000000
/*--- return current time and cpu usage ------------------------------*/02010000
showtime: procedure 02020000
parse arg showmsg 02030000
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg 02040000
02050000
/--- display the first comment block of the source as help -----------*/02060000
help: procedure 02070000
parse source . . s3 . 02080000
say 'help for rexx' s3 02090000
do lx=1 by 1 02100000
if pos('/*', sourceLine(lx)) > 0 then 02110000
leave 02120000
else if lx > 10 then do 02130000
say 'initial commentblock not found for help' 02140000
return 02150000
end 02160000
end 02170000
do lx=lx+1 by 1 02180000
li = strip(sourceLine(lx), 't', ' ') 02190000
if pos('*/', li) > 0 then 02200000
leave 02210000
say li 02220000
end 02230000
return 4 02240000
endProcedure help 02250000
/* copy err end *****************************************************/02260000
}¢--- A540769.WK.REXX.O08(O) cre=2007-12-27 mod=2008-02-25-16.22.32 F540769 ----
/* copy o begin ********************************************************
object layer has three freatures
* an object may have a class which has methods
* an object may have a parmeterized type
* a class may contain field descriptions
***********************************************************************/
oClaMethod: procedure expose m.
parse arg cl, me
if symbol('m.o.cla.cl.met.me') = 'VAR' then
return m.o.cla.cl.met.me
else
call err 'no method' me 'in class' cl
endProcedure oClaMethod
oHasMethod: procedure expose m.
parse arg obj, me
cla = oGetClass(obj)
return symbol('m.o.cla.cl.met.me') = 'VAR'
endProcedure oHasMethod
oGetClass: procedure expose m.
parse arg Obj
if symbol('m.o.obj2cla.Obj') = 'VAR' then
return m.o.obj2cla.Obj
call err 'no class found for object' obj
endProcedure oGetClass
oObjMethod: procedure expose m.
parse arg obj, me
if symbol('m.o.obj2cla.obj') = 'VAR' then
return oClaMethod(m.o.obj2cla.obj, me)
if abbrev(obj, 'oCast:') then do
cx = pos(':', obj, 7)
return 'M="'substr(obj, cx+1)'";' ,
oClaMethod(substr(obj, 7,cx-7), me)
end
call err 'no class found for object' obj
endProcedure oObjMethod
oCast: procedure
parse arg obj, cl
if abbrev(obj, 'oCast:') then
obj = substr(obj, 1 + pos(':', obj, 7))
return 'oCast:'cl':'obj
endProcedure oCast
oNewClass: procedure expose m.
parse arg name, super
/* call oIni */
name = oFldNew(name)
neMe = 'O.CLA.'name'.MET'
neFi = 'O.CLA.'name'.FLD'
do sx=1 to words(super)
sup = word(super, sx)
if symbol('m.o.cla.sup') ^== 'VAR' then
call err 'superclass' sup 'is not defined'
if m.o.cla.sup.val ^== '' then
m.o.cla.name.val = m.o.cla.sup.val
if m.o.cla.sup.stem ^== '' then
m.o.cla.name.stem = m.o.cla.sup.stem
st = 'O.CLA.'sup'.MET'
do x=1 to m.st.0
olMe = m.st.x
call oPut neMe, olMe, m.st.olMe
end
st = 'O.CLA.'sup'.FLD'
do x=1 to m.st.0
olFi = m.st.x
call oPut neFi, olFi, m.st.olFi
end
end
call oMutate 'O.CLA.'name, 'Class'
return name
endProcedure oNewClass
oValStemFldsWKOLD: procedure expose m.
parse arg cl, m.o.cla.cl.val, m.o.cla.cl.stem, flds
st = 'O.CLA.'cl'.FLD'
do wx=1 by 2 to words(flds)
call oPut st, word(flds, wx), word(flds, wx+1)
end
return cl
endProcedure oValStemFlds
oNewTypeWKOLD: procedure expose m.
parse arg cl, va, st, flds
return oValStemFlds(oNewClass(cl), va, st, flds)
/*--- a field type has only fields of type '='
finds or creates a field Type with the fields of types tps
and the field list aFl.
if dup = 'e' duplicate field names are resolved ------------*/
oFiTypeWKOLD: procedure expose m.
parse arg tps, aFl, dup
if symbol('m.o.cla.fiType.tps.aFl.dup') = 'VAR' then
return m.o.cla.fiType.tps.aFl.dup
fs = ''
do wx=1 to words(tps)
t1 = oFlds(word(tps, wx))
do fx=1 to m.t1.0
fs = fs m.t1.fx
end
end
fs = fs aFl
fd = ''
do wx=1 to words(fs)
f1 = word(fs, wx)
if wordPos(f1, fd) < 1 then do
fd = fd f1
end
else if dup == 'e' then do
do dx=2 by 1 while wordPos(f1 || dx, fn fs) > 0
end
fd = fd f1 || dx
end
end
fd = space(fd aFl)
if symbol('m.o.cla.fiType.fd') = 'VAR' then do
res = m.o.cla.fiType.fd
end
else do
res = oNewClass("FiType*")
m.o.cla.fiType.fd = res
st = 'O.CLA.'res'.FLD'
do wx=1 to words(fd)
call oPut st, word(fd, wx), '='
end
end
m.o.cla.fiType.tps.aFl = res
return res
endProcedure oFiType
oDecMethods: procedure expose m.
parse arg cla
st = 'O.CLA.'cla'.MET'
do ax=2 to arg()
call oPut st, word(arg(ax), 1), subWord(arg(ax), 2)
end
return
endProcedure oDecMethods
oNew: procedure expose m.
parse arg cla
st = 'O.CLA.'cla
if symbol('M.st') ^== 'VAR' then
call err 'class' cla 'is not initialized'
nn = m.st.inst + 1
m.st.inst = nn
nn = 'O.C' || m.st || 'I' || nn
if symbol('m.o.obj2cla.nn') == 'VAR' then
call err 'oNew already defined:' nn
m.o.obj2cla.nn = cla
return nn
endProcedure oNew
oMutate: procedure expose m.
parse arg obj, class
if obj == 'O.C13I12' then do
end
if symbol('M.O.CLA.class') ^== 'VAR' then
call err 'class' class 'is not initialized'
m.o.obj2cla.obj = class
return obj
endProcedure oMutate
oSay: procedure expose m.
parse arg type, a, aPr, mPr
ty = 'O.CLA.'type
msg = mPr || substr(a, length(aPr)+1)
redir = 0
do forever
if type == '=' then do
say msg '=' m.a
return
end
else if abbrev(type, '=') then do
a = m.a
msg = msg '==>' a
redir = 1
type = substr(type, 2)
end
else if left(type, 2) = '<>' then do
k = m.a
a = left(a, lastPos('.', a))k
msg = msg '=<>' k
redir = 1
type = substr(type, 3)
end
else if left(type, 1) = '.' then do
if ^ datatype(m.a.0, 'n') then
call err 'type' type 'not stem but m.'a'.0 is' m.a.0
type = substr(type, 2)
if redir then do
say msg 'stem 1..'m.a.0':' type
end
else do
do y=1 to m.a.0
call oSay type, a'.'y, a'.', mPr' '
end
end
return
end
else if redir then do
say msg':' type
return
end
else do
leave
end
end
if m.ty.val = '=' then
say msg '=' m.a
else
say msg '=' m.a':' m.ty.val
/* call oSay m.ty.val, a,==>' m.a '(to' m.ty.val')' */
do y=1 to m.ty.fld.0
f = m.ty.fld.y
call oSay m.ty.fld.f , a'.'f, a'.', mPr' '
end
if m.ty.stem ^== '' then
call oSay '.'m.ty.stem, a, a, mPr
return
endProcedure oSay
oClear: procedure expose m.
parse arg type, a, val
if abbrev(type, '.') then do
m.a.0 = 0
end
else if abbrev(type, '<>') then do
m.a = val
call oClear substr(type, 3), left(a, lastPos('.', a))val, val
end
else if abbrev(type, '=') then do
m.a = ''
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.a = val
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oClear m.ty.fld.k, a'.'k, val
end
if m.ty.stem ^== '' then
call m.a.0 = 0
end
return a
endProcedure oClear
oCopy: procedure expose m.
parse arg t, f
if symbol('m.o.obj2cla.f') ^== 'VAR' then
call err f 'has no class'
cl = m.o.obj2cla.f
m.o.obj2cla.t = m.o.obj2cla.f
return oTyCopy(cl, t, f)
endProcedure oCopy
oTyCopy: procedure expose m.
parse arg type, t, f
if abbrev(type, '.') then do
do y=1 to m.f.0
call oTyCopy substr(type, 2), t'.'y, f'.'y
end
m.t.0 = m.f.0
end
else if abbrev(type, '<>') then do
k = m.f
m.t = k
call oTyCopy substr(type, 3), left(t, lastPos('.', t))k,
, left(f, lastPos('.', f))k
end
else if abbrev(type, '=') then do
m.t = m.f
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.t = m.f
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oTyCopy m.ty.fld.k, t'.'k, f'.'k
end
if m.ty.stem ^== '' then
call oTyCopy '.'m.ty.stem, t, f
end
return t
endProcedure oTyCopy
/*--- Run ------------------------------------------------------------*/
oRunner: procedure expose m.
parse arg code
return oRunnerReset(oNew('ORunner'), code)
oRunnerReset: procedure expose m.
parse arg m, pCode
m.m.code = pCode
return m
endProcedure oRunnerReset
oRun: procedure expose m.
parse arg m
interpret m.m.code
return
endProcedure oRun
oIni: procedure expose m.
if m.o.ini = 1 then
return
m.o.ini = 1
call oFldIni
call mapIni
m.o.paTy.0 = 0
call oFldNew '=', '='
call oDecMethods oNewClass('ORunner'), 'oRun call oRun m'
return
endProcedure oIni
/* copy o end *********************************************************/
}¢--- A540769.WK.REXX.O08(OFLD) cre=2008-04-29 mod=2008-05-16-11.06.33 F540769 ---
/* copy oFld begin *****************************************************
defines classes with field names
is the base for the oo layer in copy o
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
oFldIni: procedure expose m.
if m.oFld.ini = 1 then
return
m.oFld.ini = 1
call mapIni
m.o.fldOnly = mapNew() /* map fields -> class */
m.o.cla.0 = 0 /* the stem for classes */
call oFldNew 'Class', '=', , , /* MetaClass definieren */
'INST = MET .<>= FLD .<>=Class STEM =Class'
return
endProcedure oFldIni
/*--- create a new class
name: name of new class, a star will be replaced by a number
va: type of value
st: type of stem
flds: pairs of field names and types
dup: duplicate resolver -----------------------------------*/
oFldNew: procedure expose m.
parse arg name, va, st, flds, dup
if pos('*', name) > 0 then
name = oPut('O.CLA', name, , '*')
else
call oPut 'O.CLA', name, , 'n'
m.o.cla.name.inst = 0
m.o.cla.name.val = va
m.o.cla.name.stem = st
m.o.cla.name.FLD.0 = 0
m.o.cla.name.MET.0 = 0
return oFldAdd(name, flds, dup)
endProcedure oFldNew
/*--- create or find a class with only simple fields fs --------------*/
oFldOnly: procedure expose m.
parse arg fs, dup
kk = space(fs '?'dup, 1)
if mapHasKey(m.o.fldOnly, kk) then
return mapGet(m.o.fldOnly, kk)
if dup ^== 'e' then do
ll = space(fs, 1)
end
else do
ll = ''
do wx=1 to words(fs)
w = word(fs, wx)
v = w
do x=2 while wordPos(v, ff) > 0
v = w || x
end
ll = space(ll v, 1)
end
end
if mapHasKey(m.o.fldOnly, ll) then do
nn = mapGet(m.o.fldOnly, ll)
end
else do
nn = oFldNew('FldType*')
st = 'O.CLA.'nn'.FLD'
do lx=1 to words(ll)
call oPut st, word(ll, lx), '=', dup
end
call mapPut m.o.fldOnly, ll, nn
end
call mapPut m.o.fldOnly, kk, nn
return nn
endProcedure oFldOnly
/*--- return the stem of flds of class type --------------------------*/
oFlds: procedure expose m.
parse arg type
return 'O.CLA.'type'.FLD'
/*--- return the concatenation of the fields of type ty in stem st
formated by fmt -------------------------------------------*/
oFldCat: procedure expose m.
parse arg ty, st, fmt
flds = oFlds(ty)
res = ''
do ix=1 to m.flds.0
f = m.flds.ix
if fmt == '' then
res = res m.st.f
else
res = res fmt(m.st.f, m.fmt.ix)
end
return substr(res, 2)
endProcedure oFldCat
/*--- add fields to class cl given as name type pairs in fs ----------*/
oFldAdd: procedure expose m.
parse arg cla, fs, dup
st = 'O.CLA.'cla'.FLD'
do ix=1 by 2 to words(fs)
call oPut st, word(fs, ix), word(fs, ix+1), dup
end
return cla
endProcedure oFldAdd
/*--- add/put key k with value v to stem st
duplicate handling dup:
* replace * in k by a number until it is new
e add a number in it is not new
o replace old value at existing key
= add a new key, fail if key exists and value is different
------------------------------------------------------------*/
oPut: procedure expose m.
parse arg st, k, v, dup
if dup = '*' then do
cx = pos('*', k)
if cx < 1 then
call err 'no * in key' k
k = oPutDupResolve(st, left(k, cx-1), 1)
end
else if symbol('m.st.k') = 'VAR' then do
if dup = '' | dup = 'o' then do
m.st.k = v
return k
end
if dup = '=' then do
if v <> m.st.k | ^ (v = '' & datatype(m.st.k, 'n')) then
call err 'not =: m.'st'.'k '=>' m.st.k '<>' v
return k
end
if dup = 'e' then
k = oPutDupResolve(st, k, 2)
else
call err 'key' k 'exists in' st 'but dup' dup
end
else if dup = 'o' then
call err 'old key' k 'does not exist in' st
if datatype(k, 'n') | words(k) <> 1 | pos('.', k) > 0 then
call err 'illegal name' k
x = m.st.0 + 1
m.st.0 = x
m.st.x = k
if v == '' then
m.st.k = x
else
m.st.k = v
return k
endProcedure oPut
oPutDupResolve: procedure expose m.
parse arg st, k, b
do ix=b
a = k || ix
if symbol('m.st.a') <> 'VAR' then
return a
end
endProcedure oPutDupResolve
/*--- parameterized types --------------------------------------------*/
oGetTypePara: procedure expose m.
parse arg m
if symbol('m.o.tyPa.m') == 'VAR' then
return m.o.tyPa.m
else
return '='
endProcedure oGetTypePara
oSetTypePara: procedure expose m.
parse arg m, type, noCall
if type = '' then
type = '='
if oGetTypePara(m) == type then
return
if noCall ^== 'noCall' then
interpret oObjMethod(m, 'oSetTypePara')
m.o.tyPa.m = type
return
endProcedure oSetTypePara
/* copy oFld end ***************************************************/
}¢--- A540769.WK.REXX.O08(ONSYNTAX) cre=2008-04-15 mod=2008-04-15-12.17.23 F540769 ---
say 'onSyntax calling testSyn'
call testSyn
say 'onSyntax after testSyn'
exit
testSyn:
signal on syntax name errTrap
say 'before noexist(eins)'
x = noexist(eins)
signal off syntax
say 'nach noexist(eins)' x
return
errTrap:
signal off syntax
say 'errTrap sigl' sigl 'cond' condition()
say 'errTrap sigl' sigl 'cond' condition()
return
}¢--- A540769.WK.REXX.O08(OO) cre=2006-08-28 mod=2006-09-04-09.31.18 F540769 ---
/* copy oo begin ******************************************************/
call ooIni
/* ri = readDsnOpen(ooNew(), 'wk.text(testin)') */
call ooArgs2Stem aaa, 1, 'aaa.1 eins', 'aaa.2 zwei', 'aaa.3 drei'
ri = readCatOpen(ooNew(), "&AAA $ wk.text(testin) ",,'&' aaa,
, 'wk.text(msk1) $ &AAA')
do i=1 by 1 while ooRead(ri, line)
say 'line' i strip(m.line, 't')
end
call ooReadClose ri
exit
ooIni: procedure expose m.
m.oo.lastId = 1
return
endProcedure ooIni
ooNew: procedure expose m.
m.oo.lastId = m.oo.lastId + 1
return m.oo.lastId
endProcedure newoo
ooFree: procedure expose m.
parse arg id
return
endProcedure ooFree
ooRead: procedure expose m.
parse arg oid, var
res = '?'
interpret m.oo.oid.read
return res
endProcedure ooRead
ooReadClose: procedure expose m.
parse arg oid
stem = ''
interpret m.oo.oid.readClose
m.oo.oid.read = 'res=0'
m.oo.oid.readClose = ''
return
endProcedure ooReadClose
ooDefRead: procedure expose m.
parse arg oid, m.oo.oid.read, m.oo.oid.readClose
return oid
endProcedure ooDefRead
ooDefReadStem: procedure expose m.
parse arg oid, m.oo.oid.readStem, close
m.oo.oid.0 = 0
m.oo.oid.readStemCx = 0
return ooDefRead(oid, 'res = ooReadStem2Ln("'oid'", var);', close)
endProcedure ooDefReadStem
ooReadStem2Ln: procedure expose m.
parse arg oid, v
cx = m.oo.oid.readStemCx
if cx >= m.oo.oid.0 then do
res = '?'
stem = 'OO.'oid
m.stem.0 = 0
m.oo.oid.stCx = 0
interpret m.oo.oid.readStem
if ^ res then
return 0
else if m.stem.0 < 1 then
call err 'stem.0='m.stem.0 'after 1 from' m.oo.oid.readStem
cx = 0
end
cx = cx + 1
m.v = m.oo.oid.cx
m.oo.oid.readStemCx = cx
return 1
endProcedure ooReadStem2Ln
ooReadStemOpen: procedure expose m.
parse arg oid, stem
call ooDefReadStem oid, 'res = 0;'
do ix=0 by 1 to m.stem.0
m.oo.oid.ix = m.stem.ix
end
m.oo.oid.0 = m.stem.0
return oid
endProcedure ooReadStemOpen
ooReadArgsOpen: procedure expose m.
parse arg oid, ox
call ooDefReadStem oid, 'res = 0;'
if ox = '' then
ox = m.oo.oid.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.oo.oud.ox = arg(ax)
end
m.oo.oid.0 = ox
return oid
endProcedure ooReadArgsOpen
ooArgs2Stem: procedure expose m.
parse arg stem, ox
if ox = '' then
ox = m.stem.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.stem.ox = arg(ax)
end
m.stem.0 = ox
return stem
endProcedure ooArgs2Stem
/* copy oo end ********************************************************/
}¢--- A540769.WK.REXX.O08(OODIV) cre=2006-09-01 mod=2006-09-01-14.53.14 F540769 ---
/* copy ooDiv begin ****************************************************
***********************************************************************/
readDsnOpen: procedure expose m.
parse arg oid, spec
x = dsnAlloc(spec, 'SHR', 'RE'oid)
dd = word(x, 1)
call readDDBegin dd
return ooDefReadStem(oid, 'res = readDD('dd', "M."stem".")',
, 'call readDDEnd' dd';' subword(x, 2))
endProcedure readDsnOpen
readCatOpen: procedure expose m.
parse arg oid, src
if symbol("m.oo.oid.readCatOid") ^= 'VAR' then
m.oo.oid.readCatOid = ooNew()
catOid = m.oo.oid.readCatOid
ox = 0
do ix=2 to arg()
s = arg(ix)
do while s <> ''
ex = pos('$', s)
if ex > 0 then do
w = strip(left(s, ex-1))
s = substr(s, ex+1)
end
else do
w = strip(s)
s = ''
end
if w ^= '' then do
ox = ox + 1
m.oo.oid.readCat.ox = w
end
end
end
m.oo.oid.readCat.0 = ox
m.oo.oid.readCatIx = 0
call ooDefRead catOid, 'res=0'
return ooDefRead(oid, 'res = readCat("'oid'", var);',
, 'call readCatClose "'oid'";')
endProcedure readCatOpen
readCat: procedure expose m.
parse arg oid, var
catOid = m.oo.oid.readCatOid
do forever
if ooRead(catOid, var) then
return 1
catIx = m.oo.oid.readCatIx + 1
if catIx > 1 then
call ooReadClose catOid
if catIx > m.oo.oid.readCat.0 then
return 0
m.oo.oid.readCatIx = catIx
src = m.oo.oid.readCat.catIx
if left(src, 1) = '&' then
call ooReadStemOpen catOid, strip(substr(src, 2))
else
call readDsnOpen catOid, src
end
endProcedure readCat
readCatClose: procedure expose m.
parse arg oid
if m.oo.oid.readCatIx > 0 then
call ooReadClose m.oo.oid.readCatOid
return
endProcedure readCatClose
/* copy ooDiv end ***************************************************/
}¢--- A540769.WK.REXX.O08(O3) cre=2008-12-07 mod=2008-12-23-18.38.51 F540769 ---
call errReset 'h'
call o3Ini
call typ3New 'n Eins u f FEINS v,f FZWEI v',
, 'm','eins say "met eins"', 'zwei say "met zwei"'
say 'eins' o3ClaMet('Eins', 'eins')
o = o3New('Eins')
say 'o = new eins = ' o
say 'o.zwei' o3ObjMet(o, 'zwei')
call typ3New 'n Elf u Eins', 'm', 'zwei say "met Elf.zwei"',
, 'drei say "met Elf.drei"'
say 'Elf.zwei' o3ClaMet('Elf', 'zwei')
o11 = o3New('Elf')
say 'o11 = new eins = ' o11
say 'o11.eins' o3ObjMet(o11, 'eins')
say 'o11.zwei' o3ObjMet(o11, 'zwei')
say 'o11.drei' o3ObjMet(o11, 'drei')
say 'cast(o11).zwei' o3ObjMet(o3Cast(o11, 'Eins'), 'zwei')
say 'cast(o11).zwei' o3ObjMet(o3Cast(o3Cast(o11, 'Elf'),'Eins'), 'zwei')
say 'o3Copy(a, b)' o3Copy(a,b) 'm.b' m.b
say 'o3Copy('o', p)' o3Copy(o, p) m.p.fEins m.p.fZwei
c = o3CopyNew(a)
say 'o3CopyNew(a) m.'c m.c
exit
/* copy o begin ********************************************************
object layer has three freatures
* an object may have a class which has methods
* an object may have a parmeterized type
* a class may contain field descriptions
***********************************************************************/
o3Ini: procedure expose m.
if m.o3.ini = 1 then
return
call typ3RegisterAdd 'call o3Register m'
return
o3Register: procedure expose m.
parse arg t
m.o3.o.t.0 = 0
if m.t = 'n' then do
call o3AddMethod 'O3.MET.'t, t
co = o3GenCopy(t)
say 'o3GenCopy('t')' co
p = 'O3.MET.'t'.o3Copy'
if symbol('m.p') ^== VAR then
m.p = co
end
return
o3AddMethod: procedure expose m.
parse arg md, t
if pos(m.t, 'rv') > 0 then
return
if m.t = 'm' then do
nm = m.t.name
m.md.nm = m.t.met
say 'add method' md'->'nm '=' m.md.nm
return
end
if m.t.type ^== '' then
call o3AddMethod md, m.t.type
if m.t.0 ^== '' then
do x=1 to m.t.0
call o3AddMethod md, m.t.x
end
return
endProcedure o3AddMethod
o3GenCopy: procedure expose m. done.
parse arg t, nm
if pos(m.t, 'rv') > 0 then do
if done.nm == 1 then
return ''
done.nm = 1
if translate(nm) == nm & pos('.M.', nm'.') < 1 & 0 ,
& pos('.f.', nm'.') < 1 & pos('.F.', nm'.') < 1 then
return 'm.t'nm '= m.m'nm';'
else
return 'f =' quote(substr(nm, 2))';m.t.f = m.m.f;'
end
if m.t = 'f' then
return o3GenCopy(m.t.type, nm'.'m.t.name)
if m.t.type ^== '' then
return o3GenCopy(m.t.type, nm)
if m.t.0 = '' then
return ''
res = ''
do tx=1 to m.t.0
res = strip(res o3GenCopy(m.t.tx, nm))
end
return res
endProcedure o3GenCopy
o3ClaMet: procedure expose m.
parse arg cl, me
if symbol('m.typ3.n2t.cl') ^== 'VAR' then
call err 'no type' cl 'in o3ClaMet('cl',' me')'
ty = m.typ3.n2t.cl
if symbol('m.o3.met.ty.me') ^== 'VAR' then
call err 'no method' me 'in type' cl 'in o3ClaMet('cl',' me')'
return m.o3.met.ty.me
endProcedure o3ClaMethod
o3New: procedure expose m.
parse arg className
if className == '' then
t = typ34Name('v')
else
t = typ34Name(className)
p = 'O3.O.'t
m.p.0 = m.p.0+1
obj = p'.'m.p.0
if className == '' then
drop m.typ3.o2t.obj
else
m.typ3.o2t.obj = t
say 'new' obj 'of class' className
return obj
endProcedure o3New
o3ObjMet: procedure expose m.
parse arg obj, me
if symbol('m.typ3.o2t.obj') == 'VAR' then do
c = m.typ3.o2t.obj
if symbol('m.o3.met.c.me') == 'VAR' then
return m.o3.met.c.me
call err 'no method' me 'in class' c 'of object' obj
end
if abbrev(obj, 'O3.CAST.') then do
cx = pos('.', obj, 9)
return 'M="'substr(obj, cx+1)'";' ,
o3ClaMet(substr(obj, 9,cx-9), me)
end
end
call err 'no class found for object' obj
endProcedure o3ObjMet
o3Cast: procedure
parse arg obj, cl
if abbrev(obj, 'O3.CAST.') then
obj = substr(obj, 1 + pos('.', obj, 9))
return 'O3.CAST.'cl'.'obj
endProcedure oCast
o3Copy: procedure expose m.
parse arg m, t
if symbol('m.typ3.o2t.m') == 'VAR' then
c = m.typ3.o2t.m
else if abbrev(m, 'O3.CAST.') then
parse var m 'O3.CAST.' c ':' m
else do
m.t = m.m
drop m.o3.o2t.t
return t
end
p = 'O3.MET.'m.typ3.o2t.m'.o3Copy'
if symbol('m.p') == 'VAR' then
interpret m.p
else
m.t = m.m
m.o3.o2t.t = m.o3.o2t.m
return t
endProcedure o3Copy
o3CopyNew: procedure expose m.
parse arg m
if symbol('m.o3.o2c.m') == 'VAR' then
return o3Copy(m, o3New(m.o3.o2c.m))
return o3Copy(m, o3New(''))
endProcedure o3CopyNew
oHasMethod: procedure expose m.
parse arg obj, me
cla = oGetClass(obj)
return symbol('m.o.cla.cl.met.me') = 'VAR'
endProcedure oHasMethod
oGetClass: procedure expose m.
parse arg Obj
if symbol('m.o.obj2cla.Obj') = 'VAR' then
return m.o.obj2cla.Obj
call err 'no class found for object' obj
endProcedure oGetClass
oValStemFldsWKOLD: procedure expose m.
parse arg cl, m.o.cla.cl.val, m.o.cla.cl.stem, flds
st = 'O.CLA.'cl'.FLD'
do wx=1 by 2 to words(flds)
call oPut st, word(flds, wx), word(flds, wx+1)
end
return cl
endProcedure oValStemFlds
oNewTypeWKOLD: procedure expose m.
parse arg cl, va, st, flds
return oValStemFlds(oNewClass(cl), va, st, flds)
/*--- a field type has only fields of type '='
finds or creates a field Type with the fields of types tps
and the field list aFl.
if dup = 'e' duplicate field names are resolved ------------*/
oFiTypeWKOLD: procedure expose m.
parse arg tps, aFl, dup
if symbol('m.o.cla.fiType.tps.aFl.dup') = 'VAR' then
return m.o.cla.fiType.tps.aFl.dup
fs = ''
do wx=1 to words(tps)
t1 = oFlds(word(tps, wx))
do fx=1 to m.t1.0
fs = fs m.t1.fx
end
end
fs = fs aFl
fd = ''
do wx=1 to words(fs)
f1 = word(fs, wx)
if wordPos(f1, fd) < 1 then do
fd = fd f1
end
else if dup == 'e' then do
do dx=2 by 1 while wordPos(f1 || dx, fn fs) > 0
end
fd = fd f1 || dx
end
end
fd = space(fd aFl)
if symbol('m.o.cla.fiType.fd') = 'VAR' then do
res = m.o.cla.fiType.fd
end
else do
res = oNewClass("FiType*")
m.o.cla.fiType.fd = res
st = 'O.CLA.'res'.FLD'
do wx=1 to words(fd)
call oPut st, word(fd, wx), '='
end
end
m.o.cla.fiType.tps.aFl = res
return res
endProcedure oFiType
oNew: procedure expose m.
parse arg cla
st = 'O.CLA.'cla
if symbol('M.st') ^== 'VAR' then
call err 'class' cla 'is not initialized'
nn = m.st.inst + 1
m.st.inst = nn
nn = 'O.C' || m.st || 'I' || nn
if symbol('m.o.obj2cla.nn') == 'VAR' then
call err 'oNew already defined:' nn
m.o.obj2cla.nn = cla
return nn
endProcedure oNew
oSay: procedure expose m.
parse arg type, a, aPr, mPr
ty = 'O.CLA.'type
msg = mPr || substr(a, length(aPr)+1)
redir = 0
do forever
if type == '=' then do
say msg '=' m.a
return
end
else if abbrev(type, '=') then do
a = m.a
msg = msg '==>' a
redir = 1
type = substr(type, 2)
end
else if left(type, 2) = '<>' then do
k = m.a
a = left(a, lastPos('.', a))k
msg = msg '=<>' k
redir = 1
type = substr(type, 3)
end
else if left(type, 1) = '.' then do
if ^ datatype(m.a.0, 'n') then
call err 'type' type 'not stem but m.'a'.0 is' m.a.0
type = substr(type, 2)
if redir then do
say msg 'stem 1..'m.a.0':' type
end
else do
do y=1 to m.a.0
call oSay type, a'.'y, a'.', mPr' '
end
end
return
end
else if redir then do
say msg':' type
return
end
else do
leave
end
end
if m.ty.val = '=' then
say msg '=' m.a
else
say msg '=' m.a':' m.ty.val
/* call oSay m.ty.val, a,==>' m.a '(to' m.ty.val')' */
do y=1 to m.ty.fld.0
f = m.ty.fld.y
call oSay m.ty.fld.f , a'.'f, a'.', mPr' '
end
if m.ty.stem ^== '' then
call oSay '.'m.ty.stem, a, a, mPr
return
endProcedure oSay
oClear: procedure expose m.
parse arg type, a, val
if abbrev(type, '.') then do
m.a.0 = 0
end
else if abbrev(type, '<>') then do
m.a = val
call oClear substr(type, 3), left(a, lastPos('.', a))val, val
end
else if abbrev(type, '=') then do
m.a = ''
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.a = val
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oClear m.ty.fld.k, a'.'k, val
end
if m.ty.stem ^== '' then
call m.a.0 = 0
end
return a
endProcedure oClear
oCopy: procedure expose m.
parse arg t, f
if symbol('m.o.obj2cla.f') ^== 'VAR' then
call err f 'has no class'
cl = m.o.obj2cla.f
m.o.obj2cla.t = m.o.obj2cla.f
return oTyCopy(cl, t, f)
endProcedure oCopy
oTyCopy: procedure expose m.
parse arg type, t, f
if abbrev(type, '.') then do
do y=1 to m.f.0
call oTyCopy substr(type, 2), t'.'y, f'.'y
end
m.t.0 = m.f.0
end
else if abbrev(type, '<>') then do
k = m.f
m.t = k
call oTyCopy substr(type, 3), left(t, lastPos('.', t))k,
, left(f, lastPos('.', f))k
end
else if abbrev(type, '=') then do
m.t = m.f
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.t = m.f
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oTyCopy m.ty.fld.k, t'.'k, f'.'k
end
if m.ty.stem ^== '' then
call oTyCopy '.'m.ty.stem, t, f
end
return t
endProcedure oTyCopy
/*--- Run ------------------------------------------------------------*/
oRunner: procedure expose m.
parse arg code
return oRunnerReset(oNew('ORunner'), code)
oRunnerReset: procedure expose m.
parse arg m, pCode
m.m.code = pCode
return m
endProcedure oRunnerReset
oRun: procedure expose m.
parse arg m
interpret m.m.code
return
endProcedure oRun
/* copy o end *********************************************************/
/*---------------------------------------------------------------------
type with generic Types
---------------------------------------------------------------------*/
call errReset 'h'
call typ3Test
exit
typ3Test: procedure expose m.
call typ3Ini
meta = typ3New('t')
t1 = typ3New('n tf12 f eins f zwei v')
say 'f**2 ' t1
call typ3Say meta, t1
say 'f**2 ' typ3New('n tf2 f zwei v')
say 'f**2 ' typ3New('f eins f zwei v ')
say 'r s f**2' typ3New('r s f eins f zwei v ')
t2 = typ3New('n rs1 u s f eins f zwei v ',
, 'm', 'mEins mEins code','mEmpty')
call typ3Say meta, t2
call typ3Say meta, meta, 'meta'
say 'r s f**2' t2
say 's rs1 ' typ3New('s rs1')
m.qq.0 = 2
call typ3Dump
call typ3Say meta, typ3New(' rs1'), 't rs1 '
call typ3Say typ3New(' rs1 '), qq, 's rs1 '
say 'union' m.x m.x.name m.x.type
say 'meta@u' typ3New('meta@u', typ3New(,'u',,
, typ3New(,'f', v, 'name') ,
typ3New(,'s', v)))
say 'meta@f' typ3New('meta@f', typ3New(,'u',,
, typ3New(,'f', v, 'name') ,
typ3New(,'f', v, 'field')))
exit
qq1 = typ3New('u(f fEins pEins, f fZwei pZwei)',
, 'qq1', 'pEins pZwei')
say 'qq1 ' qq1
call typ3Say meta, qq1
pp1 = typ3New('qq1(v, r v)')
say 'pp1 ' pp1
call typ3Say meta, pp1
call typ3Say pp1, 'v'
qq2 = typ3New('u(f fEZ qq1(qEins,qZwei),f fZD qq1(qZwei,qDrei))',
, 'qq2', 'qEins qZwei qDrei')
say 'qq2 ' qq2
call typ3Say meta, qq2
pp2 = typ3New('qq2(f ppEins v, f ppZwei r v, f ppDrei r r v)')
say 'pp2 ' pp2
call typ3Say meta, pp2
call typ3Say pp2, 'v'
exit
return
/* copy typ3 begin *****************************************************
meta
c choice name type
f field name type
n name name type
p parameter name type
q param type name type stem
r reference type
s stem type
u union stem
v value
***********************************************************************/
typ3Ini: procedure expose m.
if m.typ3.ini == 1 then
return
m.typ3.ini = 1
call mapIni
m.typ3.0 = 0
m.typ3.tmp.0 = 0
call mapReset 'TYP3.N2T'
m.typ3.register = ''
meta = typ3New('n t u' ,
'c v n v v,' ,
'c r n r r,' ,
'c s n s r,' ,
'c u n u s r,',
'c f n f' typ3New('u f NAME v, f TYPE r')',',
'c n n n' typ3New('u f NAME v, f TYPE r')',',
'c c n c' typ3New('u f NAME v, f TYPE r')',',
'c m n m' typ3New('u f NAME v, f MET v') )
call typ3RegisterAdd "m.typ3.o2t.m = '"typ34Name('t')"'"
return
endProcedure typ3Ini
typ3Mutate: procedure expose m.
parse arg m, name
m.typ3.o2t.m = typ34Name(name)
return
endProcedure typ3Mutate
typ3Register: procedure expose m.
parse arg m
interpret m.typ3.register
return
endProcedure typ3Register
typ3RegisterAdd: procedure expose m.
parse arg code
call typ3Ini
regOld = m.typ3.register
m.typ3.register = code
do y = 1 to m.typ3.0
call typ3Register 'TYP3.'y
end
m.typ3.register = regOld code';'
return
endProcedure typ3RegisterAdd
typ3Dump: procedure expose m.
parse arg f, t
if f = '' then
f = 1
if t = '' then
t = m.typ3.0
do y=f to t
a = 'TYP3.'y
l = ''
if m.a.0 > 0 then
l = mCat(a, ', ')
say a m.a m.a.name m.a.type m.a.0 l
end
return
endProcedure typ3Dump
typ34Name: procedure expose m.
parse arg nm
if symbol('m.typ3.n2t.nm') == 'VAR' then
return m.typ3.n2t.nm
call err 'no type' nm
endProcedure typ34Name
typ34Obj: procedure expose m.
parse arg m
if symbol('m.typ3.o2t.m') == 'VAR' then
return m.typ3.o2t.m
call err 'typ34Obj('m') object not found'
endProcedure typ34Name
typ3New: procedure expose m.
parse arg tyEx
/* say left('typ3New', 20) tyEx */
if arg() <= 1 then
if mapHasKey(typ3.n2t, tyEx) then
return mapGet(typ3.n2t, tyEx)
t = typ3NewTmp(tyEx)
if arg() > 1 then do
pr = copies(arg(2) || ' ', length(arg(2)) == 1)
u = t
do while m.u ^== 'u'
if m.u.type == '' then
call err 'no union found' tyEx
u = m.u.type
end
do ax = 2+(pr ^== '') to arg()
call mAdd u, typ3New(pr || arg(ax))
end
end
p = typ3Permanent(t, 1)
if arg() <= 1 then
call mapAdd typ3.n2t, tyEx, p
/* say left('typ3New' p, 20) tyEx */
return p
endProcedure typ3New
typ3NewTmp: procedure expose m.
parse arg t3 nm re
if length(t3) > 1 then do
if nm ^== '' then
call err 'type' t3 'should stand alone:' t3 nm re
if abbrev(t3, 'TYP3.') then
return t3
if ^mapHasKey(typ3.n2t, t3) then
call err 'undefined type' t3
return mapGet(typ3.n2t, t3)
end
t = mAdd(typ3.tmp, t3)
m.t.name = ''
m.t.type = ''
m.t.met = ''
m.t.0 = ''
if pos(t3, 'v') > 0 then do
if nm ^== '' then
call err 'basicType' t3 'end of Exp expected:' t3 nm re
end
else if t3 = 'u' then do
fx = 0
m.t.0 = 0
re = nm re
ux = 0
do until fx = 0
tx = pos(',', re, fx+1)
if tx > fx then
sub = strip(substr(re, fx+1, tx-fx-1))
else
sub = strip(substr(re, fx+1))
if sub ^== '' then do
ux = ux + 1
m.t.ux = typ3New(sub)
end
fx = tx
end
m.t.0 = ux
end
else if nm == '' & t3 ^== 'r' then do
call err 'basicType' t3 'name or type Exp expected:' t3 nm re
end
else do
if pos(t3, 'sr') > 0 then do
if nm ^== '' then
m.t.type = typ3NewTmp(nm re)
end
else do
if pos(t3, 'cfmn') < 1 then
call err 'unsupported basicType' t3 'in' t3 nm re
m.t.name = nm
if t3 = 'm' then
m.t.met = re
else if re = '' then
call err 'basicType' t3 'type Exp expected:' t3 nm re
else
m.t.type = typ3NewTmp(re)
end
end
return t
endProcedure typ3NewTmp
typ3Permanent: procedure expose m.
parse arg t, free
if ^ abbrev(t, 'TYP3.TMP.') then
return t
if m.t.type ^== '' then
m.t.type = typ3Permanent(m.t.type)
if m.t.0 ^== '' then do
do tx=1 to m.t.0
m.t.tx = typ3Permanent(m.t.tx)
end
end
/* search equal permanent type */
do vx=1 to m.typ3.0
p = typ3'.'vx
if typ3Equal(t, p) then
leave
end
if vx > m.typ3.0 then do
p = mAdd(typ3, m.t)
m.p.name = m.t.name
m.p.type = m.t.type
m.p.met = m.t.met
if m.t.0 > 0 then
call mAddSt mCut(p, 0), t
else
m.p.0 = m.t.0
if m.p = 'n' then do
if mapHasKey(typ3.n2t, m.p.name) then
call err 'type' m.p.name 'already defined'
else
call mapAdd typ3.n2t, m.p.name, p
end
end
if free == 1 then
m.typ3.tmp.0 = substr(t, 10) - 1
call typ3Register p
return p
endProcedure typ3Permanent
typ3Equal: procedure expose m.
parse arg l, r
if m.l ^== m.r | m.l.type ^== m.r.type | m.l.0 ^= m.r.0,
| m.l.name ^== m.r.name | m.l.met ^== m.r.met then
return 0
if m.l.0 == '' then
return 1
do sx=1 to m.l.0
if m.l.sx ^== m.r.sx then
return 0
end
return 1
endProcedure typ3Equal
typ3Say: procedure expose m.
parse arg t, a, pr
call typ3SayDone t, a, pr, pr
return
endProcedure typ3Say
typ3SayDone: procedure expose m. done.
parse arg t, a, pr, p1
if pos('.type', t a) > 0 then call err '?????? .type'
if p1 == '' then
p1 = pr
if right(p1, 1) ^== ' ' then
p1 = p1' '
if done.t.a == 1 then do
say p1'done @'a
return 0
end
done.t.a = 1
if m.t == 'v' then do
say p1'=' m.a
return 0
end
if m.t == 'n' then
return typ3SayDone(m.t.type, a, pr, p1'typeName' m.t.name)
if m.t == 'f' then
return typ3SayDone(m.t.type, a'.'m.t.name, pr, p1'.'m.t.name)
if m.t == 'r' then do
reTo = m.a
if reTo == '' then
say p1'refTo' m.t.type '@null@'
else if m.t.type ^== '' then
return typ3SayDone(m.t.type, reTo, pr,
, p1'refTo' m.t.type '@'m.a)
else if symbol('m.typ3.o2t.reTo') == 'VAR' then
return typ3SayDone(m.typ3.o2t.reTo, reTo, pr,
, p1'refTo dynType' m.typ3.o2t.reTo '@'reTo)
else
say p1'refTo noType' reTo '@'a
return 0
end
if m.t = 'u' then do
say p1'union' m.t.0 '@'a
do ux=1 to m.t.0
call typ3SayDone m.t.ux, a, pr' '
end
return 0
end
if m.t = 's' then do
say p1'stem' m.a.0 m.t.type '@'a
do ux=1 to m.a.0
call typ3SayDone m.t.type, a'.'ux, pr' ', pr' .'ux
end
return 0
end
if m.t = 'c' then do
if m.t.name = m.a then
call typ3SayDone m.t.type, a, pr, p1'c' m.t.name m.t.type
return 0
end
if m.t = 'm' then
return
call err 'bad basic type' m.t
return
endProcedure typ3SayDone
typeTest: procedure
call typeIni
si = 'Simple'
siTy = typeGet(si)
say si '==>' siTy m.type.si m.typeSimple
tyTy = typeGet('Type')
ttTy = typeGet('StemType')
say 'siTy' siTy 'tyTy' tyTy 'stTyTy' ttTy
call typeSay siTy
call typeShow tyTy, tyTy
call typeCopy siTy, nnn, siTy'.'ass
say 'm.nnn nach copy' m.nnn
call typeCopy tyTy, mmm, siTy
call typeSay mmm
call typeCopy tyTy, qqq, tyTy
call typeSay qqq
call typeShow tyTy, qqq
call typeShow ttTy, type
return
endProcedure typeTest
/* copy typ3 end ****************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanRead??(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.m.tok ==> last token
m.m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.m.pos ==> scan position
m.m.src ==> scan source
***********************************************************************/
scanIni: procedure expose m.
if m.scan.ini == 1 then
return
m.scan.ini = 1
m.scan.alfLC = 'abcdefghijklmnopqrstuvwxyz'
m.scan.alfUC = translate(m.scan.alfLC)
m.scan.alfa = m.scan.alfLC || m.scan.alfUC
m.scan.alfNum = m.scan.alfa || '0123456789'
return
endProcedure scanIni
scanReset: procedure expose m.
parse arg m, n1, np, co
m.m.tok = ''
m.m.val = ''
m.m.key = ''
m.m.read = ''
return scanOpts(m, n1, np, co)
endProcedure scanReset
scanOpts: procedure expose m.
parse arg m, m.m.scanName1, namePlus, m.m.scanComment
call scanIni
if m.m.scanName1 == '' then
m.m.scanName1 = m.scan.alfa
if namePlus == '' then
m.m.scanNameR = m.m.scanName1 || '0123456789'
else
m.m.scanNameR = m.m.scanName1 || namePlus
return m
endProcedure scanReset
/*--- begin scanning a single line -----------------------------------*/
scanSrc: procedure expose m.
parse arg m, m.m.src
m.m.atEnd = 1
m.m.pos = 1
return m
endProcedure scanSrc
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
if len == '' then
return substr(m.m.src, m.m.pos)
else
return substr(m.m.src, m.m.pos,
, min(len, 1 + length(m.m.src) - m.m.pos))
endProcedure scanLook
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m
do ax=2 to arg()
if abbrev(substr(m.m.src, m.m.pos), arg(ax)) then do
m.m.tok = arg(ax)
m.m.pos = m.m.pos + length(arg(ax))
return 1
end
end
m.m.tok = ''
return 0
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.m.src)
if len ^= '' then
nx = min(m.m.pos + len, nx)
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanChar
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, prefs
m.m.tok = ''
bx = m.m.pos
if prefs = '' then do
qu = substr(m.m.src, bx, 1)
if pos(qu, "'""") < 1 then
return 0
ax = bx + 1
end
else do
do px=1 until abbrev(substr(m.m.src, bx), p1)
p1 = word(prefs, px)
if p1 = '' then
return 0
end
qu = right(p1, 1)
ax = bx + length(p1)
end
m.m.val = ''
do forever
qx = pos(qu, m.m.src, ax)
if qx < 1 then
return scanErr(m, 'ending Apostroph('qu') missing')
m.m.val = m.m.val || substr(m.m.src, ax, qx-ax)
if qx >= length(m.m.src) then
leave
else if substr(m.m.src, qx+1, 1) <> qu then
leave
ax = qx+2
m.m.val = m.m.val || qu
end
m.m.tok = substr(m.m.src, bx, qx+1-bx)
m.m.pos = qx+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.scanName1, rest in *.scanNameR ----*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.m.src, m.m.pos, 1),
, m.m.scanName1) <= 0 then do
m.m.tok = ''
return 0
end
return scanVerify(m, m.m.scanNameR)
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.m.src, alpha, , m.m.pos)
else
nx = verify(m.m.src, alpha, vOpt, m.m.pos)
if nx = 0 then
nx = length(m.m.src) + 1
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
scanNat: procedure expose m.
parse arg m, chEn
if ^ scanVerify(m, '0123456789') then
return 0
if chEn^==0 & pos(substr(m.m.src, m.m.pos,1), m.m.scanNameR)>0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
scanInt: procedure expose m.
parse arg m, chEn
if scanNat(m, chEn) then
return 1
ox = m.m.pos
if pos(substr(m.m.src, ox, 1) , '+-') < 1 then
return 0
m.m.pos = ox + 1
if | scanNat(m) then do
m.m.pos = ox
return 0
end
m.tok =substr(m.m.src, ox, 1)|| m.tok
return 1
endProcedure scanInt
scanBrackets: procedure expose m.
parse arg m, op, cl, st
sx = m.m.pos
dep = 0
do forever
call scanVerify m, op || cl || st, 'm'
if ^ scanChar(m, 1) then
if dep = 0 then
leave
else
call scanErr m, 'closing bracket' cl 'missing'
if m.m.tok = op then
dep = dep + 1
else if dep < 1 then do
m.m.pos = m.m.pos - 1
leave
end
else if m.m.tok = cl then
dep = dep - 1
end
m.m.tok = substr(m.m.src, sx, m.m.pos-sx)
return m.m.tok ^== ''
endProcedure scanBrackets
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m) then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.m.val = m.m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.m.pos - length(tok)
if substr(m.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.m.key = m.m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.m.val = def
m.m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.m.key '=')
return 1
endProcedure scanKeyValue
scanAtEnd: procedure expose m.
parse arg m
return m.m.atEnd & m.m.pos > length(m.m.src)
endProcedure scanAtEnd
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.m.tok
if m.m.read ^== '' then
interpret 'res = ' oObjMethod(m, 'scanSpaceNl')
else
res = scanSpaceCom(m)
m.m.tok = lastTok
return res
endProcedure scanSpaceNL
scanSpaceCom: procedure expose m.
parse arg m
res = scanVerify(m, ' ')
if m.m.scanComment ^== '' then
if abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
m.m.pos = 1 + length(m.m.src)
return 1
end
return res
endProcedure scanSpaceCom
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
m.m.err.0 = 0
call err 'scanErr' txt'\n'scanInfo(m, m'.ERR')
return 0
endProcedure scanErr
scanPos: procedure expose m.
parse arg m
if m.m.read ^== '' then
interpret 'return' oObjMethod(m, 'scanPos')
else if scanAtEnd(m) then
return E
else
return 1 m.m.pos
endProcedure scanPos
scanInfo: procedure expose m.
parse arg m
msg = 'last token' m.m.tok 'scanPosition' ,
strip(left(substr(m.m.src, m.m.pos), 40), 't')
if m.m.read == '' then
return msg'\npos' m.m.Pos 'in string' strip(m.m.src, 't')
else
interpret 'return msg"\n" ||' oObjMethod(m, 'scanInfo')
endProcedure scanInfo
/* copy scan end ****************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, if opt <> '' maintain stem of keys
('K' in map.keys, '=' in a else in opt) --------------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = opt
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'a')
m.vv = val
return val
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'p')
m.vv = val
return val
endProcedure mapPut
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a if it exists,
else if called with a third argument return third argument
else issue an error ----------------------------------------*/
mapGet: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv ^== '' then
return m.vv
else if arg() > 2 then
return arg(3)
else
call err 'missing key in mapGet('a',' ky')'
endProcedure mapGet
/*--- return a stem of all keys --------------------------------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if m.map.keys ^== '' then
call err 'not implemented mapRemove('a',' ky')'
val = m.a.vv
drop m.a.ky
return val
endProcedure mapRemove
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
if length(k) > 200 then do
k = left(k, 201)
if symbol('m.a.k') == 'VAR' then/* ist noch hier */
call mapClear m.a.k
end
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
/*--- return the value pointer for a key, '' if non existing
with fun = 'a' add a key, with 'p' put a key ------------*/
mapValAdr: procedure expose m.
parse arg pA, pKy, fun
a = pA
ky = pKy
do forever
if length(ky) <= 200 then do
if symbol('m.a.ky') ^== 'VAR' then
leave
if fun == 'a' then
call err 'duplicate key' pKy 'in map' pA
return a'.'ky
end
k1 = left(ky, 201)
if symbol('m.a.k1') ^== 'VAR' then
leave
a = m.a.k1
ky = substr(ky, 202)
end
if fun == '' then
return ''
opt = left('K', m.map.keys.pA ^== '')
if opt == 'K' then
call mAdd m.map.Keys.pA, pKy
do while length(ky) > 200
k1 = left(ky, 201)
n = mapNew(opt)
m.a.k1 = n
if a ^== pA & opt == 'K' then
call mAdd m.map.keys.a, ky
a = n
ky = substr(ky, 202)
end
return a'.'ky
endProcedure mapValAdr
/* copy map end *******************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(P) cre=2006-09-26 mod=2006-09-26-09.10.55 F540769 ----
/* REXX ***************************************************************/
ADDRESS ISREDIT "MACRO (par1)"
IF par1 = ''
THEN DO
ADDRESS ISREDIT "(dsn) = DATASET"
ADDRESS ISREDIT "(member) = MEMBER"
IF member ^= '' THEN member = '('member')'
dsn = ''''||dsn||member||''''
END
ELSE DO
UPPER par1
dsn = par1
IF SUBSTR(dsn,1,1) ^= '''' ,
THEN DO
dsn = userid()||'.'||dsn
dsn = ''''||dsn||''''
end
IF SYSDSN(dsn) ^= 'OK' ,
THEN DO
ZEDSMSG = "Dataset not found"
ZEDLMSG = "Dataset "dsn" not found"
ADDRESS ISPEXEC "SETMSG MSG(ISRZ000)"
EXIT
END
END
ADDRESS TSO
"PRINTDS DSNAME("dsn") CLASS(2) DEST(B610) NOTITLE PAGELEN(63)
FORMS(3820)"
ZEDLMSG = "Dataset "dsn" printed on printer B610"
ADDRESS ISPEXEC "SETMSG MSG(ISRZ000)"
EXIT
}¢--- A540769.WK.REXX.O08(PETRI) cre=2006-07-12 mod=2006-07-12-18.35.22 F540769 ---
/* rexx ****************************************************************00010000
petri net simulator 00020000
***********************************************************************/00030000
call petriTest; 00040000
exit 00050000
00060000
petriTest: procedure expose m. 00070000
call petriIni 00080000
call petriNewTrans 't1', 'p1', 'p2 p3', 'say "firing t1"' 00090001
call petriNewTrans 't2', 'p2', 'p4', 'say "firing t2"' 00100001
call petriNewTrans 't3', 'p4', 'p1' 00110001
call petriNewTrans 't4', 'p3 p3', 'say "firing t4"' 00120001
call petriSetPlace 'p1', 1 00130001
p1 = 'PETRI.PLACE.p1' 00140001
p2 = 'PETRI.PLACE.p2' 00150001
p3 = 'PETRI.PLACE.p3' 00160001
p4 = 'PETRI.PLACE.p4' 00170001
do r = 1 to 10 00180000
say 'fireEE' r 'state' m.p1 m.p2 m.p3 m.p4 00190001
if petriFireEE() < 1 then 00200000
leave 00210000
end 00220000
return 00230000
endProcedure petriTest 00240000
00250000
petriIni: procedure expose m. 00260000
m.petri.place = '' 00270001
m.petri.trans = '' 00280001
return 00290000
endprocedure petriIni 00300000
00310000
petriSetPlace: procedure expose m. 00320001
parse arg nm, val 00330001
m.petri.place.nm = val 00340001
if symbol("m.petri.place.nm") ^= "VAR" then 00350001
m.petri.place = m.petri.place nm 00360001
return 00370001
endProcedure petriSetPlace 00380001
00390001
petriNewPlaces: procedure expose m. 00400001
parse arg names 00410001
do nx=1 to words(names) 00420001
nm = word(names, nx) 00430001
if symbol("m.petri.place.nm") ^= "VAR" then do 00440001
m.petri.place.nm = 0 00450001
m.petri.place = m.petri.place nm 00460001
end 00470001
end 00480001
return nm 00490001
endProcedure petriNewPlace 00500000
00510000
petriNewTrans: procedure expose m. 00520000
parse arg nm, i, o, fi 00530001
m.petri.trans = m.petri.trans nm 00540001
m.petri.trans.nm.in = i 00550001
m.petri.trans.nm.out = o 00560001
m.petri.trans.nm.fire = fi 00570001
call petriNewPlaces i o 00580001
return nn 00590000
endProcedure petriNewTrans 00600000
00610000
petriFireEE: procedure expose m. 00620000
fx = 0 00630000
do tx=1 to words(m.petri.trans) 00640001
t1 = word(m.petri.trans, tx) 00650001
if petriEnabled(t1) then do 00660001
call petriFire t1 00670001
fx = fx + 1 00680000
end 00690000
end 00700000
return fx 00710000
endProcedure petriFireEE 00720000
00730001
petriEnabled: procedure expose m. 00740000
parse arg tx 00750000
plcs = m.petri.trans.tx.in 00760001
do px=1 by 1 00770001
p = word(plcs, px) 00780001
if p = '' then 00790001
return 1 00800001
if symbol("c.p") = 'VAR' then 00810001
c.p = c.p - 1 00820001
else 00830001
c.p = m.petri.place.p - 1 00840001
if c.p < 0 then 00850001
return 0 00860001
end 00870000
endProcedure petriEnabled 00880000
00890000
petriFire: procedure expose m. 00900000
parse arg tx 00910000
say '*** firing trans' tx 00920001
if m.petri.trans.tx.fire <> '' then 00930001
interpret m.petri.trans.tx.fire 00940001
plcs = m.petri.trans.tx.in 00950000
do px=1 by 1 00960000
p = word(plcs, px) 00970000
if p = '' then 00980000
leave 00990000
if m.petri.place.p < 1 then 01000000
call err 'fire' tx 'underflow place' p m.petri.place.p 01010000
m.petri.place.p = m.petri.place.p - 1 01020000
end 01030000
plcs = m.petri.trans.tx.out 01040000
do px=1 by 1 01050000
p = word(plcs, px) 01060000
if p = '' then 01070000
leave 01080000
m.petri.place.p = m.petri.place.p + 1 01090000
end 01100000
return 01110000
endProcedure petriEnabled 01120000
}¢--- A540769.WK.REXX.O08(PLOAD) cre=2006-08-28 mod=2008-12-16-17.22.56 F540769 ---
/* rexx ****************************************************************
synopsis: pLoad ¢d! ¢?! ¢idNr!
d: mit Debug output
?: diese Hilfe
id: numerischer Teil einer existierenden id
keine id: neue id erstellen
Funktion:
Defaults (global und user) laden
Optionen für id editieren
und dann Job für copy/unload/load erstellen und editieren
logfile schreiben in DSN.pLoad.INFO(LOG)
Konfiguration (global, user (DSN.pLoad.INFO(userId())) und id):
rexx code, der folgende Variabeln setzen soll
m.auftrag Auftraggeber etc
m.punchList = list of punchfiles to analyze (fully qualified)
m.volume = '' input punch and load are catalogued
else reside on this volume
m.resume = '' use resume clause from punch
= 'NO' use log no resume no replace
= 'YES' use log yes resume yes
m.owner = '' deduce owner from db2SubSys and catalog
else use the given owner
m.load = '' use load DSN from punch
else use the given DSN (fully qualified) as loadfile
(with variables &PA. &TS. &DB.)
m.db2SubSys db2 subsystem for load
m.mgmtClas sms class for generated datasets
m.jobcard.* stem for jobcards
m.orderTS = 0 first all copies unloads, afterwards all loads
(usefull with constraints, because of checkPen)
else utility task grouped together for each TS
************************************************************************
08.08.2008 W. Keller: orderTS Option eingefügt
************** end help ***********************************************/
/************* rest of history *****************************************
toDo: enforce no einfügen (und check anhängen?)
copy load stirbt mit b37 ==> manuell space Angaben einfügen
load überschreiben ohne inDDN erlauben|
copy nach load resume anfügen
2 Phasen trennen: datasets reinkopieren (kumulieren)
: copy/load durchführe (+restore, +log?|)
==> genpügt: noCopy und noUtil Options
(2. Phase ab 1. benutzen)
scan stirbt bei einer template mit space (..) cyl am schluss
Funktion für unloads im RZ1 bzw. RR2, auf entsprechende Shares
und Vorbereitung einer id
16.05.2008 W. Keller: Warnung bei TS mit mehreren Tables
12.01.2007 W. Keller: support partitions
01.12.2006 W. Keller: fix volume and m.load
22.11.2006 W. Keller: neu erstellt
***********************************************************************/
parse upper arg args
m.testFast = 0 /* args = '' & userId() = 'A540769' */
if m.testFast then
args = 108
m.mainLib = 'DSN.pLoad.INFO' /* read configs from here| */
m.debug = 0
idN = '' /* parse arguments */
do wx = 1 to words(args)
w = word(args, wx)
if w = '?' then
call help
else if w = 'D' then
m.debug = 1
else if verify(w, '0123456789') = 0 then
idN = w
else
call errHelp 'bad argument "'w'" in' args
end
/* interpret main/userOption */
call interDsn m.mainLib'(mainOpt)'
userOpt = m.mainLib"("userId()")"
if sysDsn("'"userOpt"'") = 'OK' then
call interDsn userOpt
if idN = '' then /* check/create id options */
idN = log('nextId')
call genId idN
if ^ m.testFast then
call adrIsp "edit dataset('"m.optDsn"')", 4
call interDsn m.optDsn
if m.punchList = '' then
call errHelp 'no punch files specified in m.punchList'
call init
m.volume = strip(m.volume)
vol = ''
if m.volume <> '' then
vol = 'volume('m.volume')'
m.orderTS = m.orderTS <> 0
do wx=1 to words(m.punchList) /* analyze all punchfiles */
w = word(m.punchList, wx)
call debug 'analyzing punchfile' w vol
call analyzePunch w vol, m.treeLd, m.treePn
end
call checkOverride m.treeLd /* massage the analyzed input */
call createTables m.treeLd, m.treeTb
if m.debug then
call mShow m.treeRoot
/* generate jcl */
call jclGenStart m.treePn, m.treeTb
call jclGenCopyInput m.treePn, m.treeTb
punDsn = genSrcDsn('PUNCH')
call jclGenPunch m.treeTb, punDsn
call jclGenUtil punDsn, m.db2SubSys
jclDsn = genSrcDsn('JCL')
call writeJcl jclDsn
call log 'load' /* write the log */
call adrIsp "edit dataset('"jclDsn"')", 4
call finish
exit
/*---tree structure-----------------------------------------------------
tree
punch
punchfiles*
templates* template in this punchfile
load
load* each load statement in a punchfile
into* each into clause in the load
table
table* each db2 table
----------------------------------------------------------------------*/
/*--- initialisation -------------------------------------------------*/
init: procedure expose m.
call ooIni
m.treeRoot = mRoot("root", "root")
m.treePn = mAddK1(m.treeRoot, 'punch')
m.treeLd = mAddK1(m.treeRoot, 'load')
m.treeTb = mAddK1(m.treeRoot, 'table')
call adrSqlConnect m.db2SubSys
return
endProcedure init
/*--- cleanup at end of program --------------------------------------*/
finish: procedure expose m.
call adrSqlDisconnect
return
endProcedure finish
/*--- debug output if m.debug is set ---------------------------------*/
debug: procedure expose m.
if m.debug then
say 'debug' arg(1)
return
endProcedure debug
/*--- error message an suicide ---------------------------------------*/
err:
parse arg ggMsg
call errA ggMsg, 1
endSubroutine err
/*--- generate an id -------------------------------------------------*/
genId: procedure expose m.
parse arg iNum
m.id = 'N'right(iNum, 4, 0)
/* if punch is present, warn the user
because db2 utility probably was started already */
puDsn = genSrcDsn("PUNCH")
puSta = sysDsn(jcl2dsn(puDsn))
if puSta = 'OK' then do
say 'Job wurde bereits gestartet, und hat Daten erstellt'
say 'Weiterarbeit kann diese Daten überschreiben'
say 'enter WEITER, falls Sie das wollen'
if m.testFast then do
say 'weiter wegen m.testFast'
end
else do
parse upper pull ans
if ans ^== 'WEITER' then
call err 'Weiterarbeit abgebrochen'
end
end
else if puSta ^= 'DATASET NOT FOUND' & puSta ^= 'MEMBER NOT FOUND',
then do
call err 'bad sysDsn result' puSta 'for' puDsn
end
/* create the src dataset for this id, if it does not exist */
lib = genSrcDsn()
m.optDsn = genSrcDsn('OPTIONS')
libSta = sysdsn(jcl2dsn(m.optDsn))
if libSta = 'DATASET NOT FOUND' then do
if m.mgmtClas <> '' then
mgCl = 'MGMTCLAS('m.mgmtClas')'
call adrTso 'alloc dd(ddCrea) new catalog dsn('jcl2Dsn(lib)')',
'dsntype(library) dsorg(po) recfm(f b) lrecl(80)' ,
'space(1, 10)' mgCl
call adrTso 'free dd(ddCrea)'
end
else if libSta ^= 'MEMBER NOT FOUND' & libSta ^= 'OK' then do
call err 'not supported sysdsn = ' libSta 'for scrLib' m.optDsn
end
/* create the options mbr for this id if it does not exist */
if libSta ^= 'OK' then
call writeOptions
return
endProcedure genId
/*--- write the options member: contents of variables and help -------*/
writeOptions: procedure expose m.
m.op.0 = 0
m.generated = date('s') time() 'by' userId()
vars = 'generated auftrag punchList volume' ,
'resume owner load db2SubSys orderTS'
wp = words(m.punchList)
do vx=1 to words(vars)
v = word(vars, vx)
if v <> 'punchList' | wp <= 1 then do
call mAdd op, left('m.'v, 14)'=' quote(value('m.'v), "'")
end
else do
li = left('m.punchList', 14)'='
do wx=1 to wp
call stAdd op, left(li, 15) ,
quote(word(m.punchList, wx),"'"), left(',', wx < wp)
li = ''
end
end
end
/* help is the leading commentblock */
call mAdd op
do lx=1 by 1
li = strip(sourceLine(lx), 't')
call mAdd op, li
if pos('*/', li) > 0 then
leave
end
call writeDsn m.optDsn, m.op.
m.srcOpt = 1
return
endProcedure writeOptions
/*--- interpret the given dsn ----------------------------------------*/
interDsn: procedure expose m.
parse arg dsn
call debug 'interpreting' dsn
call readDsn dsn, x.
/* concat all the lines */
s = ''
do x=1 to x.0
l = strip(x.x)
if right(l, 1) == ',' then /* rexx continuation */
s = s left(l, length(l) - 1)
else
s = s l';' /* separate statements */
end
interpret s
call debug 'interpreted' dsn
return
endProcedure interDsn
/*--- handle the log file --------------------------------------------*/
log: procedure expose m.
parse arg fun
dsn = m.mainLib'(LOG)'
call readDsn dsn, l.
zx = l.0
cId = m.id
if fun = 'nextId' then do /* reserve the next id */
id = strip(left(l.zx, 8))
if left(id, 1) ^== 'N',
| verify(substr(id, 2), '0123456789') > 0 then
call err 'illegal id "'id'" in line' zx 'of' dsn
cId = 'N'right(1 + substr(id, 2), 4, '0')
zx = zx + 1
l.zx = left(cId, 8) date('s') left(time(), 5) 'newId'
end
else if fun = 'load' then do /* log the current id */
/* find the current id in the log */
do ax = 1 by 1 to zx while strip(left(l.ax, 8)) < cId
end
do bx = ax by 1 to zx while strip(left(l.bx, 8)) = cId
end
le = left(cId, 8) date('s') left(time(), 5) left(m.auftrag, 20),
left(sysVar(sysNode) m.db2SubSys, 8)
/* shift the remaining entries */
tbRoot = m.treeTb
tSize = mSize(tbRoot)
sx = tSize-bx+ax
if sx > 0 then do
do qx=zx by -1 to bx /* shift right */
rx = qx+sx
l.rx = l.qx
end
end
else if sx < 0 then do /* shift left */
do qx=bx by 1 to zx
rx = qx+sx
l.rx = l.qx
end
end
zx = zx + sx
/* one log line for each table */
do tx=1 to tSize
tn = mAtSq(tbRoot, tx)
in = word(mVaAtK1(tn, 'intos'), 1)
owTb = mVaAtK1(tn, 'ow')'.'mVaAtK1(tn, 'tb')
if length(owTb) < 19 then
owTb = left(owTb, 19)
dbTs = mVaAtK1(tn, 'db')'.'mVaAtK1(tn, 'ts')
if length(dbTs) < 19 then
dbTS = left(dbTS, 19)
rx = ax + tx - 1
l.rx = le ,
left(mFirst('RESUME', '???', in, mPar(in)), 3) ,
owTb dbTs mVaAtK1(tn, 'parts')
end
end
else do
call err 'bad log fun' fun
end
call writeDsn dsn, l., zx
return substr(cId, 2)
endProcedure log
/*--- analyze a punchfile ----------------------------------------------
puDsn: spec for input dsn to analyze
ldRoot: parentNode of node for each load
puRoot: parent node for each punchFile ---------------------*//
analyzePunch: procedure expose m.
parse arg puDsn, ldRoot, puRoot
pu = readDsnOpen(ooNew(), puDsn)
co = treeCopyOpen(ooNew(), pu, '??', 0)
sc = scanUtilReader(ooNew(), co)
tmpl = mAddKy(puRoot, 'punch', puDsn)
do forever
if utilNext == 'TEMPLATE' then do
utilNext = analyzeTemplate(sc, tmpl)
end
else if utilNext == 'LOAD' then do
ch = mAddKy(ldRoot, 'load', tmpl)
utilNext = analyzeLoad(sc, co, ch, tmpl)
end
else do
u = scanUtil(sc)
if u == 'u' then
utilNext = m.val
else if u == '' then
leave
end
end
call ooReadClose pu
return
endProcedure analyzePunch
/*--- analyze template -----------------------------------------------*/
analyzeTemplate: procedure expose m.
parse arg sc, nd
if 'u' = scanUtil(sc) then
return m.val
else if m.utilType ^= 'n' then
call scanErr sc, 'template name expected'
na = m.tok
ch = mAddK1(nd, na, 'template')
do forever
if 'u' == scanUtil(sc) | m.utilType = '' then do
return m.val
end
else if m.utilType == 'n' & m.scan.sc.utilBrackets = 0 then do
parm = m.val
if wordPos(parm, 'DSN VOLUME') > 0 then
call mAddK1 ch, parm, scanUtilValue(sc)
else if parm = 'VOLUMES' then
call mAddK1 ch, 'VOLUME', scanUtilValue(sc)
else
call debug 'ignoring' parm scanUtilValue(sc)
end
else do
call debug 'template chunck' m.utilType m.tok
end
end
endProcedure analyzeTemplate
/*--- analyze load ---------------------------------------------------*/
analyzeLoad: procedure expose m.
parse arg sc, cc, ldNd, tmplNd
if scanUtil(sc) ^== 'n' & m.val ^== 'DATA' then
call scanErr sc, 'load data expected'
nd = ldNd
/* the load into syntax is too complex to analyze completly
instead, we use treeCopy to copy all unAnalyzed text */
call treeCopyDest cc, nd
call treeCopyOn cc, m.scan.sc.pos
do while 'u' ^== scanUtil(sc) & m.utilType ^== ''
if m.utilType ^= 'n' | m.scan.sc.utilBrackets ^= 0 then
iterate
opt = m.val
if wordPos(m.val, 'INDDN RESUME SHRLEVEL REPLACE COPYDDN' ,
'LOG INTO PART') < 1 then
iterate
call treeCopyOff cc, m.scan.sc.pos - length(m.tok)
if opt == 'INTO' then do
if scanUtil(sc) ^== 'n' | m.val ^== 'TABLE' then
call scanErr sc, 'into table expected'
if scanUtil(sc) ^== 'n' & m.utilType ^== '"' then
call scanErr sc, 'table name expected'
nd = mAddKy(ldNd, opt, '')
call mAddK1 nd, 'ow', strip(m.val)
if scanUtil(sc) ^== '.' then
call scanErr sc, '.table expected'
if scanUtil(sc)^=='n' & m.utilType^=='"' then
call scanErr sc, 'table name expected'
call mAddK1 nd, 'tb', strip(m.val)
call treeCopyDest cc, nd
end
else if opt == 'INDDN' then do
dd = scanUtilValue(sc)
ddNd = mAtK1(tmplNd, dd)
if ddNd = '' & m.load = '' then
call err 'template not found for inDDn' dd
call mAddK1 nd, 'INDDN', ddNd
end
else if opt == 'REPLACE' then do
call mAddK1 nd, opt, 1
end
else do
call mAddK1 nd, opt, scanUtilValue(sc)
end
call treeCopyOn cc, m.scan.sc.pos
end
call treeCopyOff cc, m.scan.sc.pos - length(m.tok)
return m.val
endProcedure analyzeLoad
/*--- check loads and override values --------------------------------*/
checkOverride: procedure expose m.
parse arg ldRoot
rs = translate(m.resume)
do lx=1 to mSize(ldRoot) /* for each load */
ld = mAtSq(ldRoot, lx)
loDdn = overrideLoad(mAtK1(ld, 'INDDN'))
if rs <> '' then
call mPut ld, 'RESUME', rs
do ix=1 to mSize(ld) /* for each into */
in = mAtSq(ld, ix)
if mKy(in) <> 'INTO' then
iterate
nd = mAtK1(in, 'PART')
if nd = '' then
nd = mAddK1(in, 'PART', '*')
part = m.nd
info = mVaAtK1(in, 'ow')'.'mVaAtK1(in, 'tb') 'part' part
if part == '*' then
nop
else if ^ datatype(part, 'n') | length(part) > 5 then
call scanErr sc, 'bad partition' part 'for' info
else
part = right(part, 5, 0)
m.nd = part
inDdn = overrideLoad(mAtK1(in, 'INDDN'))
if inDDn = '' then do
if loDDn = '' then
call err 'no inDDN for' info
DDn = loDDn
end
else do
if loDDn <> '' then
call err 'inDDn twice specified for' info
ddn = inDDn
end
if m.volume <> '' & mAtK1(ddn, 'VOLUME') = '' then
call mAddK1 in, 'VOLUME', m.volume
if rs <> '' then
call mPut in, 'RESUME', rs
end /* for each into */
end /* for each load */
return
endProcedure checkOverride
/*--- override or modify the load pointed to by nd -------------------*/
overrideLoad: procedure expose m.
parse arg nd
if nd == '' then
return nd
if m.load <> '' then do
if symbol('m.loadNd') <> 'VAR' then do
m.loadNd = mAddK1(m.treeRoot, 'overLoad')
call ds2Tree m.load, m.loadNd
end
m.nd = m.loadNd
end
if m.volume <> '' then
call mPut m.nd, 'VOLUME', m.volume
return nd
endProcedure overrideLoad
/*--- create tables: find destination creator and ts in catalogue
create tree for destination table and
link it to all into nodes -----------------------*/
createTables: procedure expose m.
parse arg ldRoot, tbRoot
do lx=1 to mSize(ldRoot)
ld = mAtSq(ldRoot, lx)
do ix=1 to mSize(ld)
in = mAtSq(ld, ix)
if mKy(in) <> 'INTO' then
iterate
oOw = mVaAtK1(in, 'ow')
oTb = mVaAtK1(in, 'tb')
if symbol('old.oOw.oTb') = 'VAR' then do
nd = old.oOw.oTb
call debug 'found' nd 'for old table' oOw'.'oTb
end
else do /* search table in db2 catalog */
parse value queryTable(oOw, oTb) ,
with nOw'.'nTb':'db'.'ts
nd = mAtK1(tbRoot, nOw'.'nTb)
if nd <> '' then do
call debug 'found' nd 'for new table' nOw'.'nTb
end
else do /* create node for table */
nd = mAddK1(tbRoot, nOw'.'nTb)
call mAddK1 nd, 'ow', nOw
call mAddK1 nd, 'tb', nTb
call mAddK1 nd, 'db', db
call mAddK1 nd, 'ts', ts
call mAddK1 nd, 'parts'
call debug 'created' nd 'for new table' nOw'.'nTb
end
old.oOw.oTb = nd
call debug 'map old tb' oOw'.'oTb 'to' nOw'.'nTb 'nd' nd
end
m.in = nd
pp = mVaAtK1(in, 'PART')
op = mVaAtK1(nd, 'parts')
if op = '' then do
np = pp
ni = in
if pp = '*' then
call mAddK1 nd, 'tsPa', 'TS'
else
call mAddK1 nd, 'tsPa', 'PA'
end
else if pp = '*' | op = '*' then
call err 'part * not alone in tb' nOw'.'nTb
else if wordPos(pp, op) > 0 then
call err 'part' pp 'duplicate n tb' nOw'.'nTb
else do /* add new partition into sorted list */
do wx=1 to words(op) while pp > word(op, wx)
end
np = subword(op, 1, wx-1) pp subword(op, wx)
oi = mVaAtK1(nd, 'intos')
ni = subword(oi, 1, wx-1) in subword(oi, wx)
end
call mPut nd, 'parts', np
call mPut nd, 'intos', ni
end
end
return
endProcedure createTables
/*--- query the db2 catalog for creator, db, ts etc.
of the tables to load --------------------------------------*/
queryTable: procedure expose m.
parse upper arg ow, tb
sql = "select t.name, t.creator, tsName, t.dbname, s.nTables" ,
"from sysibm.systables t, sysibm.systablespace s" ,
"where t.type = 'T'" ,
"and s.dbName = t.dbName and s.name = t.tsName" ,
"and t.name = '"strip(tb)"' and t.creator"
if m.owner <> '' then do /* override owner */
sql = sql "= '"strip(m.owner)"'"
end
else if left(ow, 3) == 'OA1' then do /* translate OA1* owners */
o = substr(strip(m.db2SubSys), 3, 1)
if o = 'O' | sysvar(sysnode) <> 'RZ1' then
o = 'P'
nn = overlay(o, ow, 4)
if nn = 'OA1P' then
sql = sql "in ('OA1P', 'ODV', 'IMF')"
else
sql = sql "= '"strip(nn)"'"
end
else do /* user owner as is */
sql = sql "= '"strip(ow)"'"
end
/* execute sql and fetch row */
call adrSql 'prepare s1 from :sql'
call adrSql "declare c1 cursor for s1"
call adrSql 'open c1'
cnt = 0
do forever
call adrSql 'fetch c1 into :tb, :cr, :ts, :db, :tbCnt'
if sqlCode = 100 then
leave
cnt = cnt + 1
if cnt > 1 then
call err 'fetched more than 1 row for table' ow'.'tb ':'sql
end
if cnt = 0 then
call err 'table' ow'.'tb 'not found in catalog:' sql
else if tbCnt <> 1 then do
say 'ts' db'.'ts 'hat' tbCnt 'Tabellen'
say 'pLoad kann mit RESUME=NO Daten ueberschreiben'
say 'trotzdem weitermache (w=weiter)?'
parse upper pull a
if ^ abbrev(a, 'W') then
call err 'nicht weiter'
end
call adrSql 'close c1'
return strip(cr)'.'strip(tb)':'strip(db)'.'strip(ts)
endProcedure queryTable
/*--- write the generated jcl ----------------------------------------*/
writeJcl: procedure expose m.
parse arg dsn
x = dsnAlloc(dsn, 'SHR', jclGen)
dd = word(x, 1)
call writeDDBegin dd
call writeDD dd, 'M.JOBCARD.'
do j = 1 to m.jclCard.0
call debug 'jclCard j' M.JCLCARD.j.0
call writeDD dd, 'M.JCLCARD.'j'.'
end
call writeDDEnd dd
interpret subword(x, 2)
return
endProcedure writeJCL
/*--- generate the JCL -----------------------------------------------*/
jclGenStart: procedure expose m.
parse arg pnRoot, tbRoot
call jclIni
/* show our infos in comment */
call jcl '10'copies('*', 69)
parse source . . ggS3 .
call jcl '10* load job generated by' ggS3 ,
'in' sysvar(sysnode) 'for' m.db2SubSys 'by' userid()
call jcl '10* id' m.id 'at' date('s') time()
do px=1 to mSize(pnRoot) /* show input punch */
pn = mAtSq(pnRoot, px)
call jcl '1* punch ' m.pn
end
do tx=1 to mSize(tbRoot) /* show output tables */
tn = mAtSq(tbRoot, tx)
call jcl '1* load ' ,
mVaAtK1(tn, 'ow')'.'mVaAtK1(tn, 'tb') ,
'in' mVaAtK1(tn, 'db')'.'mVaAtK1(tn, 'ts')
p = mVaAtK1(tn, 'parts')
if p <> '*' then
call jcl '1* ' words(p) 'partitions between' word(p, 1),
'and' word(p, words(p))
intos = mVaAtK1(tn, 'intos')
do ix=1 to words(intos) /* show input tables and dsns */
in = word(intos, ix)
owTb = mVaAtK1(in, 'ow')'.'mVaAtK1(in, 'tb')
if i.owTb == 1 then
iterate
i.owTb = 1
if length(owTb) < 16 then
owTb = left(owTb, 16)
tmpl = mFirst('INDDN', , in, mPar(in))
call jcl '1* from' owTb mVaAtK1(tmpl, 'DSN')
end
drop i.
end
call jcl '10'copies('*', 69) /* end of info comment */
call jcl '1* alle Dataset löschen, die wir nachher neu erstellen'
call jcl '1'jclExec() 'PGM=IEFBR14'
return
endProcedure jclGenStart
/*--- copy all input dsns to our Prefix ------------------------------*/
jclGenCopyInput: procedure expose m.
parse arg puRoot, tbRoot
do px=1 to mSize(puRoot) /* punch files */
pn = mAtSq(puRoot, px)
call jcl '2* Originales Punchfile Kopieren'
call jclCopy ds2Tree(m.pn, m.jclNdFr) ,
, ds2Tree(genSrcDsn('OPUNCH', px), m.jclNdTo)
end
/* load input dsns */
m.dsnLoadTS = genDsn('&DB..&TS.', 'LOAD')
m.dsnLoadPA = genDsn('&DB..&TS..P&PA.', 'LOAD')
do tx=1 to mSize(tbRoot)
tn = mAtSq(tbRoot, tx)
intos = mVaAtK1(tn, 'intos')
do ix=1 to words(intos)
in = word(intos, ix)
ln = mPar(in)
if mAtK1(in, 'INDDN') <> '' then
dn = mVaAtK1(in, 'INDDN')
else
dn = mVaAtK1(ln, 'INDDN')
dnDsn = mVaAtK1(dn, 'DSN')
chDsn = expDsn(in, dnDsn)
if dnDsn <> chDsn then do
dn = mAddTree(mRemCh(m.jclNdFr), dn)
call mPut dn, 'DSN', chDsn
end
vv = 'DSNLOAD'mVaAtK1(tn, 'tsPa')
newLo = expDsn(in, m.vv)
call jcl '2* Originales Loadfile Kopieren'
call jclCopy dn, dsNew2Tree(newLo, m.jclNdTo)
end
end
return
endProcedure jclGenCopyInput
/*--- generate the db2 utility statements for copy & unload ----------*/
jclGenPunch: procedure expose m.
parse arg tbRoot, puDsn
if m.mgmtClas == '' then
m.mgmtClasCl = ''
else
m.mgmtClasCl = 'MGMTCLAS('m.mgmtClas')'
call jcl '2* Neues Punchfile Kopieren'
call jcl '2'jclExec() 'PGM=IEBGENER'
call jcl '20SYSPRINT DD SYSOUT=*'
call jcldd 2, 's', 'SYSUT2', ds2Tree(puDsn, m.jclNdTo)
call jcl '20SYSUT1 DD *'
/* add a second copy template,
to avoid duplicate on the copy before/after */
call jcl '2 TEMPLATE TCOPYQ'
call jcl '2 ' ,
"DSN('&SSID..&DB..&SN..Q&PART(2)..D&DATE(3)..T&TIME.')"
call jcl '2 DATACLAS (NULL12) MGMTCLAS(COM#A011)'
call jcl '2 SPACE (10,250) CYL'
call jcl '2 TEMPLATE TMLOADTS'
call jcl "2 DSN('"m.dsnLoadTS"')"
call jcl "2 DISP(SHR,KEEP,KEEP)"
call jcl '2 TEMPLATE TMLOADPA'
call jcl "2 DSN('"m.dsnLoadPA"')"
call jcl "2 DISP(SHR,KEEP,KEEP)"
xx = overlay(".UNLO", m.dsnLoadTS, lastPos(".", m.dsnLoadTS))
call jcl '2 TEMPLATE TMULTS'
call jcl "2 DSN('"xx"')"
call jcl '2 DATACLAS (NULL12) MGMTCLAS(COM#A011)'
call jcl '2 SPACE (10,250) CYL'
xx = overlay(".UNLO", m.dsnLoadPA, lastPos(".", m.dsnLoadPA))
call jcl '2 TEMPLATE TMULPA'
call jcl "2 DSN('"xx"')"
call jcl '2 DATACLAS (NULL12) MGMTCLAS(COM#A011)'
call jcl '2 SPACE (10,250) CYL'
xx = overlay(".UNPU", m.dsnLoadTS, lastPos(".", m.dsnLoadTS))
call jcl '2 TEMPLATE TMULPUN'
call jcl "2 DSN('"xx"')"
call jcl '2 DATACLAS (NULL12) MGMTCLAS(COM#A011)'
call jcl '2 SPACE (1,10) CYL'
do tx=1 to mSize(tbRoot)
tn = mAtSq(tbRoot, tx)
intos = mVaAtK1(tn, 'intos')
call jclGenPunchCopyUnload tn, tx
call jclGenPunchInto word(intos, 1), 0, tn
do ix=1 to words(intos)
in = word(intos, ix)
call jclGenPunchInto in, ix, tn
end
end
return
endProcedure jclGenPunch
/*--- generate utility copy and unload statement for table tn --------*/
jclGenPunchCopyUnload: procedure expose m.
parse arg tn, tx
parts = mVaAtK1(tn, 'parts')
paMin = word(parts, 1)
paMax = word(parts, words(parts))
dbTs = mVaAtK1(tn, 'db')'.'mVaAtK1(tn, 'ts')
if parts == '*' then do
call jcl '2 COPY TABLESPACE' dbTS 'FULL YES'
end
else do
call jcl '2 LISTDEF COLI'tx
call jcl '2 INCLUDE TABLESPACE' dbTs 'PARTLEVEL'
call jcl '2 COPY LIST COLI'tx 'FULL YES PARALLEL'
end
call jcl '2 COPYDDN (TCOPYQ) SHRLEVEL REFERENCE'
/* unload before */
call jcl '2 UNLOAD TABLESPACE' dbTS
if parts = '*' then
nop
else if paMin == paMax then
call jcl '2 PART' paMin
else
call jcl '2 PART' paMin ':' paMax
call jcl '2 FROM TABLE' mVaAtK1(tn, 'ow') ,
|| '.'mVaAtK1(tn, 'tb')
call jcl '2 PUNCHDDN TMULPUN UNLDDN TMUL'mVaAtK1(tn,'tsPa')
call jcl '2 SHRLEVEL REFERENCE'
return
endProcedure jclGenPunchCopyUnload
/*--- generate the db2 utility statements for 1 load or into ---------*/
jclGenPunchInto: procedure expose m.
parse arg in, ix, tn
pa = mVaAtK1(in, 'PART')
ln = mPar(in)
rs = mFirst('RESUME', 'NO', in, ln)
if rs = 'NO' then do
rsSp = 'RESUME NO REPLACE COPYDDN TCOPYD'
end
else do
rsSp = 'RESUME YES'
sh = mFirst('SHRLEVEL', '', in, ln)
if sh <> '' then
rsSp = rsSp 'SHRLEVEL' sh
end
if ix == 0 then do
if pa == '*' then do
call jcl '3 LOAD DATA INDDN TMLOADTS'
call jcl '3 ' rsSp 'LOG' rs
if rs == 'NO' then
call jcl '3 STATISTICS TABLE(ALL)' ,
'INDEX(ALL) UPDATE ALL'
end
else do
call jcl '3 LOAD DATA LOG' rs
end
jn = mPar(in)
end
else do
call jcl '3 INTO TABLE' mVaAtK1(tn,'ow')'.'mVaAtK1(tn,'tb')
if pa <> '*' then do
call jcl '3 PART' pa
call jcl '3 ' rsSp
call jcl '3 INDDN TMLOADPA'
end
jn = in
end
do cx=1 to mSize(jn)
cn = mAtSq(jn, cx)
key = mKy(cn)
if key = '' then
call jcl '3 'm.cn
end
return
endProcedure jclGenPunchInto
/*--- jcl to run the db2 utility -------------------------------------*/
jclGenUtil: procedure expose m.
parse arg pun, dbSys
call jcl '4* db2 utility macht die Arbeit'
call jcl '42IF RC=0 THEN'
call jcl '4'jclExec() "PGM=DSNUTILB,PARM='"dbSys","userid()".UN.LO'"
call jcl '40SYSMAP DD DISP=(,PASS),UNIT=SYSDA'
call jcl '40SYSUT1 DD DISP=(,PASS),UNIT=SYSDA'
call jcl '40SORTOUT DD DISP=(,PASS),UNIT=SYSDA'
call jcl '40SYSERR DD SYSOUT=*'
call jcl '40SYSPRINT DD SYSOUT=*'
call jcl '40UTPRINT DD SYSOUT=*'
call jcl '40SYSTEMPL DD DISP=SHR,DSN='dbSys'.DBAA.LISTDEF(TEMPL)'
call jcl '40SYSIN DD DISP=SHR,DSN='pun
call jcl '42ENDIF'
return
endProcedure jclGenUtil
/*--- generate DSN for this id, with the given llq and index ---------*/
genDSN: procedure expose m.
parse arg dbTs, leLlq, lx
llq = leLLq || lx
if length(llq) > 8 then
llq = left(leLlq, 8 - length(lx)) || lx
if dbTs = '' then
return m.dsnPref || '.'m.id'.'llq
else
return m.dsnPref || '.'m.id'.'dbTs'.'llq
endProcedure genDSN
/*--- generate DSN for the src DS of the id, with member and index ---*/
genSrcDsn: procedure expose m.
parse arg mbr, lx
dsn = m.dsnPref'.'m.id'.SRC'
if mbr = '' then
return dsn
m = mbr || lx
if length(m) > 8 then
m = left(mbr, 8 - length(lx)) || lx
return dsn'('m')'
endProcedure genSrcDsn
/*--- expand variables in dsn from the into node in ------------------*/
expDsn: procedure expose m.
parse arg in, dsn
do forever
px = pos('&', dsn)
if px = 0 then
return dsn
dx = pos('.', dsn, px+1)
if dx <= px then
call err 'no . after & in' dsn
k = translate(substr(dsn, px+1, dx-px-1))
if k = 'DB' then
v = mVaAtK1(m.in, 'db')
else if k = 'PART' | k = 'PA' then
v = mVaAtK1(in, 'PART')
else if k = 'TS' | k = 'SN' then
v = mVaAtK1(m.in, 'ts')
else
call err 'bad variable' k 'in' dsn
dsn = left(dsn, px-1) || v || substr(dsn,dx+1)
end
endProcedure expDsn
/*--- transform the dataset spec into a tree at node nd --------------*/
ds2tree: procedure expose m.
parse arg spec, nd
call mRemCh nd
upper spec
dsn = ''
do ix=1 by 1
w = word(spec, ix)
if w = '' then
leave
if abbrev(w, 'DSN(') then
dsn = substr(w, 5, length(w) - 5)
else if abbrev(w, 'VOLUME(') then
call mAddK1 nd, 'VOLUME', substr(w, 8, length(w) - 8)
else if dsn == '' then
dsn = w
end
if dsn ^= '' then
call mAddK1 nd, 'DSN', dsn
return nd
endProcedure ds2Tree
/*--- transform the spec for a new DS into a tree at node nd ---------*/
dsNew2tree: procedure expose m.
parse arg spec, nd
x = ds2Tree(spec, nd)
if m.mgmtClas <> '' then
call mPut x, 'MGMTCLAS', m.mgmtClas
return x
endProcedure dsNew2tree
/*--- jcl to copy a sequential DS ------------------------------------*/
jclCopy: procedure expose m.
parse arg fr, to
call jcl '2'jclExec() 'PGM=IEBGENER'
call jcl '20SYSPRINT DD SYSOUT=*'
call jcldd 2, 'o', 'SYSUT1', fr
if pos('(', mVaAtK1(to, 'DSN')) > 0 then
call jcldd 2, 's', 'SYSUT2', to
else
call jcldd 2,'nr', 'SYSUT2', to, fr
return
endProcedure jclCopy
/*--- generate a jcl dd statement
opt: n=new, s=shr, r=remove in first step
dd: ddname
nd: tree representation dataset spec
like: tree representation of like dataset ----------------------*/
jclDD: procedure expose m.
parse arg j, opt, dd, nd, like
new = pos('n', opt) > 0
li=left('0'dd, 12)'DD'
if new then
li = li 'DISP=(NEW,CATLG,DELETE)'
else if pos('s', opt) > 0 then
li = li 'DISP=SHR'
else
li = li 'DISP=OLD'
do cx=1 by 1 to m.nd.0
ch = nd'.'cx
va = m.ch
ky = mKy(ch)
if wordPos(ky, 'DSN MGMTCLAS') > 0 then
li = jclDDClause(j, li, ky'='va)
else if ky == 'VOLUME' then
li = jclDDClause(j, li, 'VOL=SER=('va'),UNIT=DISK')
else
call err 'bad dd attribute' ky'='va
end
if like == '' then do
end
else if like == 'fb80' then do
li = jclDDClause(j, li, 'RECFM=FB,LRECL=80')
end
else do
if '' == mAtK1(like, 'VOLUME') then do
li = jclDDClause(j, li, 'LIKE='mVaAtK1(like, 'DSN'))
end
else do
aa = jcl2dsn(mVaAtK1(like, 'DSN')) ,
'VOLUME('mVaAtK1(like, 'VOLUME')')'
lRc = listDsi(aa)
if lRc <> 0 then
call err 'rc' lRc from 'listDsi' aa
if sysUnits = 'CYLINDER' then
u = 'CYL'
else if sysUnits = 'TRACK' | sysUnits = 'BLOCK' then
u = left(sysUnits, 2) || 'K'
else
call err 'bad sysunits from listDsi:' sysUnits
li = jclDDClause(j, li, 'SPACE=('u',('sysPrimary',' ,
|| sysSeconds'))')
li = jclDDClause(j, li, 'RECFM='sysRecFm)
end
end
call jcl j || li
if new & pos('r', opt) > 0 then
call jclRemove nd
return
endProcedure jclDD
/*--- add a DS to the remove step ------------------------------------*/
jclRemove: procedure expose m.
parse arg nd
m.jclRemove = m.jclRemove + 1
li = left('0RM'm.jclRemove, 12)'DD DISP=(MOD,DELETE,DELETE)'
li = jclDDClause(1, li, 'DSN='mVaAtK1(nd, 'DSN'))
call jcl '1'li
return
endProcedure jclRemove
/*--- add one clause to a jcl dd statement
if the line overflows write it out
return rest of line ---------------------------------------*/
jclDDClause: procedure expose m.
parse arg j, li, cl
if left(li, 1) = '6' then
a = 15
else
a = 1
if a + length(li) + length(cl) < 70 then
return li','cl
call jcl j || li','
return '6'cl
endProcedure jclDDClause
/*--- generate an exec statement -------------------------------------*/
jclExec: procedure expose m.
m.jclStep = m.jclStep + 1
return left('0S'm.jclStep, 10)'EXEC'
endProcedure jclExec
/*--- initialize jcl generator ---------------------------------------*/
jclIni: procedure expose m.
m.jclCard.0 = 9
do x=1 to m.jclCard.0
m.jclCard.x.0 = 0
end
m.jclRemove=0
m.jclStep = 0
m.jclPref.0 = '//'
m.jclPref.2 = left('//', 11)
m.jclPref.4 = left('//', 13)
m.jclPref.6 = left('//', 15)
xx = ' '
m.jclPref.xx = ''
xx = '*'
m.jclPref.xx = '//*'
m.jclNdFr = mRoot()
m.jclNdTo = mRoot()
return
endProcedure jclIni
/*--- output one jcl line:
j (char 1): which stem
t (char 2): prefix
m (char 3 to end): message ----------------------------------*/
jcl: procedure expose m.
parse arg j 2 t 3 m
if m.orderTS & j > 2 then
j = 2
x = m.jclCard.j.0 + 1
m.jclCard.j.0 = x
if m.debug then
if symbol('m.jclPref.t') <> 'VAR' then
call err undefined jclPref for t 'in' j || t || m
m.jclCard.j.x = m.jclPref.t || strip(m, 't')
if m.debug then
say 'jcl'j m.jclCard.j.x
return
endProcedure jcl
/*--- add one line text to the stem m.st -----------------------------*/
/*--- copy a DS in tso -----------------------------------------------*/
copyDS: procedure
parse arg fj fa, tj ta
say 'copyDs from' fj fa 'to' tj ta
call adrTso 'free dd(sysut1)', '*'
call adrTso 'alloc dd(sysut1) shr dsn('jcl2dsn(fj)')' fa
call adrTso 'free dd(sysut2)', '*'
call adrTso 'delete' jcl2dsn(tj), '*'
call adrTso 'alloc dd(sysut2) new catalog refdd(sysut1)' ,
'dsn('jcl2dsn(tj)')' ta
call adrTso 'alloc dd(sysin) dummy reuse'
call adrTso 'alloc dd(sysprint) sysout(T) reuse'
/* call iebGener */
CALL ADRTSO 'CALL *(IEBGENER)', '*'
say 'iebGener rc' rc 'result' result
call adrTso 'free dd(sysin sysprint sysut1 sysut2)'
return
endProcedure copyDS
/* treeCopy : make a copy of a reader to a tree ***********************/
treeCopyLine: procedure expose m.
parse arg m, nx
if ^m.treeCopy.m.read then
return
if nx > length(m.treeCopy.m.line) then
qx = length(m.treeCopy.m.line)
else
qx = nx - 1
if m.treeCopy.m.on then do
le = left(m.treeCopy.m.line, qx)
if le <> '' then
call mAddKy m.treeCopy.m.dest, , le
end
m.treeCopy.m.line = overlay('', m.treeCopy.m.line, 1, qx)
return
endProcedure treeCopyLine
treeCopyDest: procedure expose m.
parse arg m, m.treeCopy.m.dest
return
endProcedure treeCopyDest
/*--- start copying at character nx of current line ------------------*/
treeCopyOn: procedure expose m.
parse arg m, nx
if m.treeCopy.m.on then
return
call treeCopyLine m, nx
m.treeCopy.m.on = 1
return
endProcedure treeCopyOn
/*--- stop copying at character nx of current line -------------------*/
treeCopyOff: procedure expose m.
parse arg m, nx
if ^ m.treeCopy.m.on then
return
call treeCopyLine m, nx
m.treeCopy.m.on = 0
return
endProcedure treeCopyOff
treeCopyRead: procedure expose m.
parse arg m, rdr, var
call treeCopyLine m, 1 + length(m.treeCopy.m.line)
m.treeCopy.m.read = ooRead(rdr, var)
m.treeCopy.m.line = m.var
return m.treeCopy.m.read
endProcedure treeCopyRead
treeCopyOpen: procedure expose m.
parse arg m, rdr, m.treeCopy.m.dest, isOn
call ooDefRead m, 'res = treeCopyRead("'m'", "'rdr'", var);'
m.treeCopy.m.read = 0
m.treeCopy.m.on = isOn = 1
return m
endProcedure treeCopyOpen
/* copy scanUtil begin *************************************************
scan db2 utility input statements using scan and a reader
**********************************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanUtilReader: procedure expose m.
parse arg m, inRdr
call scanReader m, inRdr
call scanOptions sc, , , '--'
m.scan.m.utilBrackets = 0
return m
endProcedure scanUtilReader
/*--- scan next token and put its type in m.utilType:
'u' a utility name
'n' a name
'"' a quoted name
"'" an apostroph'd string
'.' a .
',' a ,
'v' a value
'' at end
---------------------------------------------------------------*/
scanUtil: procedure expose m.
parse arg sc
call scanSpaceNl sc
ty = '?'
if scanLit(sc, '(') then do
m.scan.sc.utilBrackets = m.scan.sc.utilBrackets + 1
end
else if scanLIT(sc, ')') then do
m.scan.sc.utilBrackets = m.scan.sc.utilBrackets - 1
if m.scan.sc.utilBrackets < 0 then
call scanErr sc, 'unmatched closing bracket )'
end
else if scanLit(sc, ',') then do
end
else if scanLit(sc, '.') then do
end
else if scanString(sc, "'") then do
end
else if scanString(sc, '"') then do
end
else if scanName(sc) then do
m.val = translate(m.tok)
if m.scan.sc.utilBrackets > 0 then
ty = 'n'
else if 0 < wordPos(m.val, 'BACKUP CATENFM CATMAINT CHECK' ,
'COPY COPYTOCOPY DIAGNOSE EXEC LISTDEF LOAD' ,
'MERGECOPY MODIFY OPTIONS QUIESCE REBUILD' ,
'RECOVER REORG REPAIR REPORT RESTORE' ,
'RUNSTATS STOSPACE TEMPLATE UNLOAD') then
ty = 'u'
else
ty = 'n'
end
else if scanVerify(sc, ' (),''"', 'm') then do
ty = 'v'
m.val = translate(m.tok)
end
else if ^scanAtEnd(sc) then do
call scanErr sc, 'scanUtil stopped before end'
end
else do
/* say 'scanUtil return atEnd' */
ty = ''
m.val = ''
end
if ty == '?' then
m.utilType = left(m.tok, 1)
else
m.utilType = ty
return m.utilType
endProcedure scanUtil
/*--- scan a value or a bracketed list of values ---------------------*/
scanUtilValue: procedure expose m.
parse arg sc
if '(' ^== scanUtil(sc) then
return scanUtilValueOne(sc)
v = ''
brx = m.scan.sc.utilBrackets
do forever
call scanUtil sc
one = scanUtilValueOne(sc)
if one == '' then
call scanErr sc, 'eof in brackets'
else if brx > m.scan.sc.utilBrackets then
return v
v = v || one
end
endProcedure scanUtilValue
scanUtilValueOne: procedure expose m.
parse arg sc
if utilType == '' then
return ''
else if m.utilType == 'u' then
call scanErr sc, 'util in scanUtilValueOne'
else if pos(m.utilType, 'nv''"') > 0 then
return m.val
else
return m.tok
endProcedure scanUtilValueOne
/* copy scanUtil end **************************************************/
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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 adrSql begin *************************************************/
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then do
return 0
end
else if rc < 0 then do
if ggRet == '*' then nop
else if wordPos(sqlCode, ggRet) > 0 then nop
else
call err "sql rc" rc sqlmsg() ggNo
end
else if sqlWarn.0 ^== ' ' then do
say 'warning' sqlMsg() ggNo
end
return sqlCode
endSubroutine adrSql
adrSqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call adrSql "connect" ggSys, ggRetCon ,1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
parse arg ggRet
call adrSql "disconnect ", ggRet, 1
return
endProcedure adrSqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggW = ''
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggw = ggw ggx'='sqlWarn.ggx
end
ggXX = pos(':', ggSqlStmt)
ggVV = ''
if ggXX > 0 then do
ggVV = word(substr(ggSqlStmt, ggXX + 1), 1)
ggXX = verify(ggVV, ' ,:+-*/&%?|', 'm')
if ggXX > 0 then
ggVV = left(ggVV, ggXX-1)
ggVV = 'with' ggVV '=' value(ggVV)
end
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x)) ,
'stmt = ' ggSqlStmt ggVV
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/* copy adrSql end *************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line
scanStem(m,ln) : begin scanning all lines in a stem
scanAtEOL(m) : returns whether we reached end of line
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
scanNum(m) : scan integer (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
call scanStart m
return
endProcedure scanLine
/*--- begin scanning the lines of a stem -----------------------------*/
scanReader: procedure expose m.
parse arg m, inRdr
call scanStart m, inRdr
m.scan.m.src = ''
m.scan.m.atEnd = ^ scanNL(m, 1)
return m
endProcedure scanReader
/*--- switch to next line if atEOF or argument unCond=1 --------------*/
scanNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then
m.scan.m.pos = 1 + length(m.scan.m.src)
else if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 0
else if ^ ooRead(m.scan.m.reader, 'SCAN.'m'.SRC') then do
m.scan.m.atEnd = 1
return 0
end
m.scan.m.pos = 1
m.scan.m.tok = ''
return 1
endProcedure scanNL
/*--- initialize scanner for m --------------------------------------*/
scanStart: procedure expose m.
parse arg m, m.scan.m.reader
m.scan.m.pos = 1
m.tok = ''
m.val = ''
m.key = ''
if symbol('m.scan.m.Name') ^== 'VAR' then do
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
end
return
endProcedure scanStart
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanStart
if nameOne ^== '' then
m.scan.m.Name1 = nameOne
if nameOne ^= '' | namePlus ^== '' then
m.scan.m.name = m.scan.m.name1 || namePlus
m.scan.m.comment = comm
return
endProcedure scanBegin
/*--- return true/false whether we are at the end of the line --------*/
scanAtEOL: procedure expose m.
parse arg m
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEOL
/*--- return true/false whether we are at the end of the input -------*/
scanAtEnd: procedure expose m.
parse arg m
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 1
else
return m.scan.m.atEnd
endProcedure scanAtEnd
/*--- scan len characters --------------------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
m.tok = substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
if nx = m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a number --------------------------------------------------*/
scanNum: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure scanNum
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into *.key and word into val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(scanSkip(m)) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok
say ' charPos' m.scan.m.Pos':',
strip(substr(m.scan.m.src, m.scan.m.Pos), 't')
say ' in line:' strip(m.scan.m.src, 't')
call err 'scanErr' txt
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
res = 0
cc = m.scan.m.comment
do forever
if scanVerify(m, ' ') then nop
else if scanNL(m) then nop
else if cc == '' then leave
else if ^ scanLit(m, cc) then leave
else if ^scanNL(m, 1) then leave
res = 1
end
m.tok = lastTok
return res
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/* copy scan end ****************************************************/
/* copy ooDiv begin ****************************************************
***********************************************************************/
readDsnOpen: procedure expose m.
parse arg oid, spec
x = dsnAlloc(spec, 'SHR', 'RE'oid)
dd = word(x, 1)
call readDDBegin dd
return ooDefReadStem(oid, 'res = readDD('dd', "M."stem".")',
, 'call readDDEnd' dd';' subword(x, 2))
endProcedure readDsnOpen
readCatOpen: procedure expose m.
parse arg oid, src
if symbol("m.oo.oid.readCatOid") ^= 'VAR' then
m.oo.oid.readCatOid = ooNew()
catOid = m.oo.oid.readCatOid
ox = 0
do ix=2 to arg()
s = arg(ix)
do while s <> ''
ex = pos('$', s)
if ex > 0 then do
w = strip(left(s, ex-1))
s = substr(s, ex+1)
end
else do
w = strip(s)
s = ''
end
if w ^= '' then do
ox = ox + 1
m.oo.oid.readCat.ox = w
end
end
end
m.oo.oid.readCat.0 = ox
m.oo.oid.readCatIx = 0
call ooDefRead catOid, 'res=0'
return ooDefRead(oid, 'res = readCat("'oid'", var);',
, 'call readCatClose "'oid'";')
endProcedure readCatOpen
readCat: procedure expose m.
parse arg oid, var
catOid = m.oo.oid.readCatOid
do forever
if ooRead(catOid, var) then
return 1
catIx = m.oo.oid.readCatIx + 1
if catIx > 1 then
call ooReadClose catOid
if catIx > m.oo.oid.readCat.0 then
return 0
m.oo.oid.readCatIx = catIx
src = m.oo.oid.readCat.catIx
if left(src, 1) = '&' then
call ooReadStemOpen catOid, strip(substr(src, 2))
else
call readDsnOpen catOid, src
end
endProcedure readCat
readCatClose: procedure expose m.
parse arg oid
if m.oo.oid.readCatIx > 0 then
call ooReadClose m.oo.oid.readCatOid
return
endProcedure readCatClose
/* copy ooDiv end ***************************************************/
/* copy oo begin ******************************************************/
call ooIni
/* ri = readDsnOpen(ooNew(), 'wk.text(testin)') */
call ooArgs2Stem aaa, 1, 'aaa.1 eins', 'aaa.2 zwei', 'aaa.3 drei'
ri = readCatOpen(ooNew(), "&AAA $ wk.text(testin) ",,'&' aaa,
, 'wk.text(msk1) $ &AAA')
do i=1 by 1 while ooRead(ri, line)
say 'line' i strip(m.line, 't')
end
call ooReadClose ri
exit
ooIni: procedure expose m.
m.oo.lastId = 1
return
endProcedure ooIni
ooNew: procedure expose m.
m.oo.lastId = m.oo.lastId + 1
return m.oo.lastId
endProcedure newoo
ooFree: procedure expose m.
parse arg id
return
endProcedure ooFree
ooRead: procedure expose m.
parse arg oid, var
res = '?'
interpret m.oo.oid.read
return res
endProcedure ooRead
ooReadClose: procedure expose m.
parse arg oid
stem = ''
interpret m.oo.oid.readClose
m.oo.oid.read = 'res=0'
m.oo.oid.readClose = ''
return
endProcedure ooReadClose
ooDefRead: procedure expose m.
parse arg oid, m.oo.oid.read, m.oo.oid.readClose
return oid
endProcedure ooDefRead
ooDefReadStem: procedure expose m.
parse arg oid, m.oo.oid.readStem, close
m.oo.oid.0 = 0
m.oo.oid.readStemCx = 0
return ooDefRead(oid, 'res = ooReadStem2Ln("'oid'", var);', close)
endProcedure ooDefReadStem
ooReadStem2Ln: procedure expose m.
parse arg oid, v
cx = m.oo.oid.readStemCx
if cx >= m.oo.oid.0 then do
res = '?'
stem = 'OO.'oid
m.stem.0 = 0
m.oo.oid.stCx = 0
interpret m.oo.oid.readStem
if ^ res then
return 0
else if m.stem.0 < 1 then
call err 'stem.0='m.stem.0 'after 1 from' m.oo.oid.readStem
cx = 0
end
cx = cx + 1
m.v = m.oo.oid.cx
m.oo.oid.readStemCx = cx
return 1
endProcedure ooReadStem2Ln
ooReadStemOpen: procedure expose m.
parse arg oid, stem
call ooDefReadStem oid, 'res = 0;'
do ix=0 by 1 to m.stem.0
m.oo.oid.ix = m.stem.ix
end
m.oo.oid.0 = m.stem.0
return oid
endProcedure ooReadStemOpen
ooReadArgsOpen: procedure expose m.
parse arg oid, ox
call ooDefReadStem oid, 'res = 0;'
if ox = '' then
ox = m.oo.oid.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.oo.oud.ox = arg(ax)
end
m.oo.oid.0 = ox
return oid
endProcedure ooReadArgsOpen
ooArgs2Stem: procedure expose m.
parse arg stem, ox
if ox = '' then
ox = m.stem.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.stem.ox = arg(ax)
end
m.stem.0 = ox
return stem
endProcedure ooArgs2Stem
/* copy oo 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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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
m.dsnAlloc.dsn = ''
if left(spec, 1) = '=' then
return strip(substr(spec, 1))
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 to 3
w = word(spec, wx)
if w = '' then
leave
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if m.dsnAlloc.dsn = '' then
m.dsnAlloc.dsn = dsn2jcl(w, addPref)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if m.dsnAlloc.dsn <> '' then
disp = disp "dsn('"m.dsnAlloc.dsn"')"
call adrTso 'alloc dd('dd')' disp subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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 m begin ********************************************************
stem and tree handling
***********************************************************************/
/*--- increase m.m and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg m, delta
if delta = '' then
m.m = m.m + 1
else
m.m = m.m + delta
return m.m
endProcedure mInc
/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
parse arg m, delta
if symbol('m.m') <> 'VAR' then
m.m = 0
return mInc(m)
endProcedure mIncD
/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
parse arg m
return m.mKey.m
endProcedure mKy
/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
parse arg m
if symbol('m.m.0') == 'VAR' then
return m.m.0
else
return 0
endProcedure mSize
/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg m
dx = lastPos('.', m)
if dx <= 1 then
return ''
else
return left(m, dx - 1)
endProcedure mPar
/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg m, Ky, val
if m == '' then
m = 'mRoot.' || mIncD('mRoot.0')
m.m = val
m.mKey.m = Ky
m.m.0 = 0
return m
endProcedure mRoot
/*--- add one or several values to stem m.m --------------------------*/
mAdd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
end
m.m.0 = ix
return m'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSeq: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
dx = mSize(dst)
do sx = begX to endX
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return dst
endProcedure mAddSeq
/*--- add one value to the stem m.m ----------------------------------*/
mAddNd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
m.m.ix.0 = 0
end
m.m.0 = ix
return m'.'ix
endProcedure mAddNd
/*--- add one Ky value pair to stem m.m -----------------------------*/
mAddKy: procedure expose m.
parse arg m, Ky, val
nn = mAddNd(m, val)
m.mKey.nn = Ky
return nn
endProcedure mAddKy
/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
parse arg m, ky, val
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
call err 'duplicate Ky' ky 'for node' m
nn = mAddNd(m, val)
m.mKey.nn = ky
m.mIndex.m.mKey.ky = nn
return nn
endProcedure mAddK1
/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg m, Ky, val
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
m.ch = val
return ch
end
else do
return mAddK1(m, Ky, val)
end
return
endProcedure mPut
/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg m, ky
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
return m.mIndex.m.mKey.ky
else
return ''
endProcedure mAtK1
/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg m, Ky
if symbol('m.mIndex.m.mKey.Ky') ^== 'VAR' then
call err 'no Ky' Ky 'at node' m
ch = m.mIndex.m.mKey.Ky
return m.ch
endProcedure mVaAtK1
/*--- return the value of the first defined ky in the list of nodes
def if ky isn't defined ---------------------------------------*/
mFirst: procedure expose m.
parse arg Ky, def
do ax=3 to arg()
m = arg(ax)
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
return m.ch
end
end
return def
endProcedure mFirst
/*--- return the child at sequenceNo seq of node m -------------------*/
mAtSq: procedure expose m.
parse arg m, seq
if symbol('m.m.seq') ^== 'VAR' then
return ''
else
return m'.'seq
endProcedure mAtSq
/*--- remove all or all after nwSz children --------------------------*/
mRemCh: procedure expose m.
parse arg pa, nwSz
if nwSz = '' then
nwSz = 0
do cx=nwSz+1 to mSize(pa)
ch = pa'.'cx
call mRemCh ch
ky = m.mKey.ch
drop m.mIndex.pa.mKey.ky m.mKey.ch m.ch m.ch.0
end
m.pa.0 = nwSz
return pa
endProcedure mRemCh
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mAddTree: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
do sx=begX to endX
sCh = src'.'sx
if symbol('m.mKey.sCh') ^= 'VAR' then do
dCh = mAddNd(dst, m.sCh)
end
else do
ky = m.mKey.sCh
if symbol('m.mIndex.src.mKey.ky') ^= 'VAR' then
dCh = mAddKy(dst, ky, m.sCh)
else
dCh = mAddK1(dst, ky, m.sCh)
end
call mAddTree dCh, sCh
end
return dst
endProcedure mAddTree
/*--- show from one node everything that is defined ------------------*/
mShowNd: procedure expose m.
parse arg m
pa = mPar(m)
t = 'node' m 'pa='pa
if symbol('m.m') == 'VAR' then
t = t 'va='m.m
if symbol('m.m.0') == 'VAR' then
t = t 'size='m.m.0
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
t = t 'ky='ky
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t = t 'index='m.mIndex.pa.mKey.ky
end
say t
return
endProcedure mShowNd
/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg m, lv
if lv = '' then
lv = 0
t = left('', lv)m
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
pa = mPar(m)
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t= t ky '>'
else
t= t ky '='
end
say t strip(m.m, 't')
do cx=1 to mSize(m)
call mShow mAtSq(m, cx), lv+1
end
return
endProcedure treeShow
/* copy m end *********************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(REBIND) cre=2008-11-24 mod=2008-11-24-15.31.56 F540769 ---
/*--- all rebinds ----------------------------------------------------*/
rebindStmts: procedure expose m.
parse arg o, cr, tb
sel = bQualifier '=' quote(cr, "'") and bName = quote(tb, "'")
call dbg 'sel =' sel
p = ':m.pk.sx.'
call sqlPreOpen 8,
, "select distinct dCollid, dName, dContoken, version, p.type,",
"p.bindTime, p.valid, p.operative",
"from sysibm.sysPackDep d, sysibm.sysPackage p" ,
"where bType in ('P', 'R')" ,
"and d.dLocation = p.location" ,
"and d.dCollid = p.collid" ,
"and d.dName = p.name" ,
"and d.dConToken = p.conToken" ,
"and ("sel")" ,
"order by 2, 4, 1"
do sx=1 while sqlFetchInto(8, ':col, :nam, :cTo, :ver, :typ,' ,
':bTi, :val, :ope')
call dbg sx col nam c2x(cTo) ver typ bTi 'vo' val ope
st = 'PACKAGE('strip(col)'.'strip(nam)
if typ = 'T' then
st = 'REBIND TRIGGER' st')'
else
st = 'REBIND' st'.('strip(ver)'))'
call mAdd o, st '-'
call mAdd o, ' /* valid='val', op='ope', lastBind='bTi '*/'
end
call sqlClose 8
return sx-1
endProcedure rebindStmts
}¢--- A540769.WK.REXX.O08(REIST) cre=2006-10-23 mod=2006-11-03-12.09.58 F540769 ---
/* rexx ****************************************************************
synopsis: sql timer
version vom 3.11.2006
lässt mehrere Sqls in verschiedenen Varianten mehrmals laufen
und misst CPU und Elapsed timee
Varianten:
static: ? (Parametermarker) erhalten Werte aus Hostvariabeln
stat-%: Prädikate mit ? deren Variabeln nur % enthalten werden
entfernt
dynamic: Werte der Hostvariabeln werden als Konstanten ins
SQL eingebaut
************************************************************************
01.11.2006 erstellt
***********************************************************************/
say 'begin' time('E')
m.tstFrom = '2009-11-29-12.39.13.817263'
m.out.0 = 0
m.reps = 5
m.queryNo = 100
nd = sysvar('sysnode')
if nd = 'RZ2' | nd = 'RR2' then do
m.subsys = 'DBOF'
m.qual = 'OA1P'
end
else if 0 then do
m.subsys = 'DBTF'
m.qual = 'OA1T'
end
else if 1 then do
m.subsys = 'DBAF'
m.qual = 'OA1A'
end
call out 'test' m.subsys',' m.reps 'repetitions at' time() date('e')
m.sqlGen.crsr = 0
m.sqlGen.run = 0
m.sqlGen.chunk = 35
sq = "SELECT FI.FI_ID,",
"FI.FI_Status,",
"PI.Auftrags_Nummer,",
"FI.TimerTyp,",
"FI.Ausloese_Zeitpunkt,",
"MP.ED_Kurzname,",
"FA.FD_Name,",
"PM.PM_Name",
"FROM" m.qual".vpw311A1V FI,",
m.qual".vpw310A1V PI,",
m.qual".vpw301A1V PM,",
m.qual".vpw302A1V FA,",
m.qual".vpw318A1V MP",
"WHERE" ,
/* 1 5 10 5 20 5 30 5 */ ,
" FI.Laufzeit = 0",
"AND FI.TimerTyp like ?",
"AND FI.Ausloese_Zeitpunkt >= ?",
"AND FI.Ausloese_Zeitpunkt <= ?",
"AND FI.FI_STATUS like ?",
"AND PI.Auftrags_Nummer like ?",
"AND PI.PI_Status <> 'B'",
"AND PM.PM_Name like ?",
"AND PI.PI_ID = FI.PI_ID",
"AND PI.PM_ID = PM.PM_ID",
"AND PM.EntryType = 'R ' ",
"AND FI.MP_ID = MP.MP_ID",
"AND FI.FA_ID = FA.FA_ID",
"AND FA.EntryType = 'R ' ",
"ORDER BY FI.Ausloese_Zeitpunkt ASC with ur"
say 'connecting to' m.subsys
call adrSqlConnect m.subsys
call prepareFor 'leer', sq,
, '%%%%' ,
, m.tstFrom ,
, '9999-12-31-23.59.59.999999' ,
, '%' ,
, '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ,
, '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'
call prepareFor 'TiTy', sq,
, 'ARCH' ,
, m.tstFrom ,
, '9999-12-31-23.59.59.999999' ,
, '%' ,
, '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ,
, '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'
call prepareFor 'PrMo', sq,
, '%%%%' ,
, m.tstFrom ,
, '9999-12-31-23.59.59.999999' ,
, '%' ,
, '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ,
, 'WB Boerse Zuteilung bis Infra%%%%%%%%%%%%%%%%%%'
call prepareFor 'AuNr', sq,
, '%%%%' ,
, m.tstFrom ,
, '9999-12-31-23.59.59.999999' ,
, '%' ,
, 'F%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' ,
, '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'
call addStats ,,'running'
do rr=1 to m.reps
say '... repetition' rr 'of' m.reps 'at' time()
do rx=1 to m.sqlGen.run
do sx=1 to m.sqlGen.rx.step
call run rx, sx
end
end
end
call adrSqlDisconnect
call printStats
call writeDsn 'wk.text(Reis' || m.subsys || ')', m.out., ,1
exit
out: procedure expose m.
parse arg li
say li
x = m.out.0 + 1
m.out.0 = x
m.out.x = li
return
endProcedure out
prepareFor: procedure expose m.
parse arg inf, sq
rx = m.sqlgen.run + 1
m.sqlGen.run = rx
m.sqlGen.rx.info = inf
m.sqlGen.rx.sql = sq
vx = 0
do vx=1 to arg()-2
m.sqlGen.rx.vx = arg(vx+2)
end
m.sqlGen.rx.0 = vx-1
sx = 1
vrs = ''
do vx=1 to m.sqlGen.rx.0
if vrs <> '' then
vrs = vrs', '
vrs = vrs':m.sqlGen.'rx'.'vx
end
call addCursor rx, sx, sq, vrs, 'static'
sx = sx + 1
vrs = ''
txt = ''
nx = 1
do vx = 1 to m.sqlGen.rx.0
cx = pos('?', sq, nx)
if verify(m.sqlGen.rx.vx, '%') > 0 then do
if vrs <> '' then
vrs = vrs', '
vrs = vrs':m.sqlGen.'rx'.'vx
txt = txt || substr(sq, nx, 1+cx-nx)
end
else do
txt = txt || substr(sq, nx, 1+cx-nx-m.sqlGen.chunk)
end
nx = cx + 1
end
txt = txt || substr(sq, nx)
call addCursor rx, sx, txt, vrs, 'static-%'
sx = sx + 1
vrs = ''
txt = ''
nx = 1
do vx = 1 to m.sqlGen.rx.0
cx = pos('?', sq, nx)
if datatype(m.sqlGen.rx.vx, 'n') then
txt = txt || substr(sq, nx, cx-nx) m.sqlGen.rx.vx
else
txt = txt || substr(sq, nx, cx-nx) "'"m.sqlGen.rx.vx"'"
nx = cx + 1
end
txt = txt || substr(sq, nx)
call addCursor rx, sx, txt, vrs, 'dynamic'
m.sqlGen.rx.step = sx
return
endProcedure prepareFor
addCursor: procedure expose m.
parse arg rx, sx, sql, vars, tit
rxsx = rx'.'sx
m.sqlGen.rxsx.title = m.sqlGen.rx.info '-' tit
cx = m.sqlGen.crsr + 1
qno = m.queryNo * 10000 + 100 * rx + sx
call adrSql 'explain plan set queryno = ' qNo 'for' sql
/* say 'explain queryNo' qno 'for' tit
say '--- addCursor' rxsx m.sqlGen.rxsx.title
say substr(sql, pos('WHERE', sql))
say 'crsr' cx rxsx 'vrs' vars
*/ m.sqlGen.crsr = cx
call adrSql 'prepare s'cx 'from :sql'
call adrSql 'declare c'cx 'cursor for s'cx
m.sqlGen.rxsx.crsr = cx
if vars <> '' then
vars = 'using' vars
m.sqlGen.rxsx.open = 'open c'cx vars
m.sqlGen.rxsx.sqlSrc = sql
m.sqlGen.rxsx.queryNo = qNo
return cx
endProcedure addCursor
run: procedure expose m.
parse arg rx, sx
cx = m.sqlGen.rx.sx.crsr
call adrSql m.sqlGen.rx.sx.open
ausMin = '99999999z'
ausMax = '00000000a'
do fx=1 by 1
if adrSql('fetch c'cx 'into :id, :sta, :auft, :tity, :aus,' ,
':kurz, :fd, :pm', 100) ^= 0 then
leave
/* say 'fetch' fx id sta auft tity aus kurz fd pm */
if aus < ausMin then
ausMin = aus
if aus > ausMax then
ausMax = aus
end
call adrSql 'close c'cx
fe = fx - 1
say 'ausloesezeitpunkt' ausMin ausMax
call addStats rx, sx, fe, m.sqlGen.rx.sx.title
return
endProcedure run
addStats: procedure expose m.
parse arg rx, sx, fe, text
key = rx'.'sx
e = time('E')
c = sysvar('sysCPU')
if symbol('m.stats.ela') <> 'VAR' then do
m.stats.ela = e
m.stats.cpu = c
m.stats.keys = ''
end
say 'addStats' key (c-m.stats.cpu) (e-m.stats.ela) 'fetched' fe,
'at' time() text
if rx ^= '' then do
if symbol('m.stats.key.0') == 'VAR' then do
x = m.stats.key.0 + 1
end
else do
x = 1
m.stats.keys = m.stats.keys key
end
m.stats.key.0 = x
m.stats.key.x.ela = e - m.stats.ela
m.stats.key.x.cpu = c - m.stats.cpu
m.stats.key.x.fetch = fe
if symbol('m.stats.rx.fetch') == 'VAR' ,
& m.stats.rx.fetch ^= fe then
say '*********fetch mismatch new' fe 'old' m.stats.rx.fetch
m.stats.rx.fetch = fe
end
m.stats.ela = e
m.stats.cpu = c
return
endProcedure addStats
printStats: procedure expose m.
call out ' cpu mean ela mean fetch cpu max queryNo title'
do wx=1 to words(m.stats.keys)
key = word(m.stats.keys, wx)
y = m.stats.key.0
if y ^= m.reps then
call err 'repetitions mismatch'
c = 0
e = 0
f = 0
cMax = -99
do x=1 to y
c = c + m.stats.key.x.cpu
e = e + m.stats.key.x.ela
f = f + m.stats.key.x.fetch
if m.stats.key.x.cpu > cMax then do
cMax = m.stats.key.x.cpu
end
end
call out format(c/y, 4, 4) format(e/y, 4, 4) ,
format(f/y, 9, 0) format(cMax, 4, 4) ,
format(m.sqlGen.key.queryNo, 9, 0) m.sqlGen.key.title
end
return
endProcedure printStats
err:
call errA arg(1), 1
endSubroutine err
/* copy adrSql begin *************************************************/
/**********************************************************************
adrSql: execute sql thru the dsnRexx interface
***********************************************************************/
adrSql: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then do
return 0
end
else if rc < 0 then do
if ggRet == '*' then nop
else if wordPos(sqlCode, ggRet) > 0 then nop
else
call err "sql rc" rc sqlmsg() ggNo
end
else if sqlWarn.0 ^== ' ' then do
say 'warning' sqlMsg() ggNo
end
return sqlCode
endSubroutine adrSql
adrSqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call adrSql "connect" ggSys, ggRetCon ,1
return
endProcedure adrSqlConnect
adrSqlDisconnect: procedure
parse arg ggRet
call adrSql "disconnect ", ggRet, 1
return
endProcedure adrSqlDisconnect
sqlMsg: /* no procedure, to keep variables sql... */
ggW = ''
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggw = ggw ggx'='sqlWarn.ggx
end
ggXX = pos(':', ggSqlStmt)
ggVV = ''
if ggXX > 0 then do
ggVV = word(substr(ggSqlStmt, ggXX + 1), 1)
ggXX = verify(ggVV, ' ,:+-*/&%?|', 'm')
if ggXX > 0 then
ggVV = left(ggVV, ggXX-1)
ggVV = 'with' ggVV '=' value(ggVV)
end
return 'sqlCode' sqlCode 'state' sqlState 'warn' ggW ,
'errMc' strip(translate(sqlerrmc, ',', 'FF'x)) ,
'stmt = ' ggSqlStmt ggVV
endSubroutine sqlMsg
/**********************************************************************
adrDsn: send a command to db2 with the TSO dsn command
***********************************************************************/
adrDsn: procedure
parse arg sys, cmd, rcOk
call adrTso 'alloc dd(sysprint) new reuse'
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
say 'rc' rr 'adrTso DSN SYSTEM('sys') cmd' cmd
if wordPos(rr, rcOk) < 1 then do
say 'error rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
call adrTso 'execio * diskr sysprint (finis stem pr.)'
say 'sysprint' pr.0 'lines'
do x=1 to pr.0
say strip(pr.x, 't')
end
call adrTso 'free dd(sysprint) '
call err 'rc' rr 'in adrTso DSN SYSTEM('sys') cmd' cmd
end
call adrTso 'free dd(sysprint)'
return rr
endProcedure adr Dsn
/* copy adrSql end *************************************************/
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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 .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'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
dsn = strip(dsn)
if right(dsn, 1) = "'" then
dsn = strip(left(dsn, length(dsn) - 1))
bx = pos('(', dsn)
if bx > 0 then
dsn = strip(left(dsn, bx-1))
if mbr <> '' then
dsn = dsn'('strip(mbr)')'
if left(dsn, 1) = "'" then
dsn = dsn"'"
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), 't', "'")
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
if left(spec, 1) = '=' then
return strip(substr(spec, 1))
dsn = ''
do wx=1 to 3
w = word(spec, wx)
if w = '' then
leave
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if dsn = '' | left(w, 1) = "'" then
dsn = 'dsn('w')'
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
call adrTso 'alloc dd('dd')' disp dsn subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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 then
say ggCnt 'records written to' ggDsnSpec
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy oo begin ******************************************************/
call ooIni
/* ri = readDsnOpen(ooNew(), 'wk.text(testin)') */
call ooArgs2Stem aaa, 1, 'aaa.1 eins', 'aaa.2 zwei', 'aaa.3 drei'
ri = readCatOpen(ooNew(), "&AAA $ wk.text(testin) ",,'&' aaa,
, 'wk.text(msk1) $ &AAA')
do i=1 by 1 while ooRead(ri, line)
say 'line' i strip(m.line, 't')
end
call ooReadClose ri
exit
ooIni: procedure expose m.
m.oo.lastId = 1
return
endProcedure ooIni
ooNew: procedure expose m.
m.oo.lastId = m.oo.lastId + 1
return m.oo.lastId
endProcedure newoo
ooFree: procedure expose m.
parse arg id
return
endProcedure ooFree
ooRead: procedure expose m.
parse arg oid, var
res = '?'
interpret m.oo.oid.read
return res
endProcedure ooRead
ooReadClose: procedure expose m.
parse arg oid
stem = ''
interpret m.oo.oid.readClose
m.oo.oid.read = 'res=0'
m.oo.oid.readClose = ''
return
endProcedure ooReadClose
ooDefRead: procedure expose m.
parse arg oid, m.oo.oid.read, m.oo.oid.readClose
return oid
endProcedure ooDefRead
ooDefReadStem: procedure expose m.
parse arg oid, m.oo.oid.readStem, close
m.oo.oid.0 = 0
m.oo.oid.readStemCx = 0
return ooDefRead(oid, 'res = ooReadStem2Ln("'oid'", var);', close)
endProcedure ooDefReadStem
ooReadStem2Ln: procedure expose m.
parse arg oid, v
cx = m.oo.oid.readStemCx
if cx >= m.oo.oid.0 then do
res = '?'
stem = 'OO.'oid
m.stem.0 = 0
m.oo.oid.stCx = 0
interpret m.oo.oid.readStem
if ^ res then
return 0
else if m.stem.0 < 1 then
call err 'stem.0='m.stem.0 'after 1 from' m.oo.oid.readStem
cx = 0
end
cx = cx + 1
m.v = m.oo.oid.cx
m.oo.oid.readStemCx = cx
return 1
endProcedure ooReadStem2Ln
ooReadStemOpen: procedure expose m.
parse arg oid, stem
call ooDefReadStem oid, 'res = 0;'
do ix=0 by 1 to m.stem.0
m.oo.oid.ix = m.stem.ix
end
m.oo.oid.0 = m.stem.0
return oid
endProcedure ooReadStemOpen
ooReadArgsOpen: procedure expose m.
parse arg oid, ox
call ooDefReadStem oid, 'res = 0;'
if ox = '' then
ox = m.oo.oid.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.oo.oud.ox = arg(ax)
end
m.oo.oid.0 = ox
return oid
endProcedure ooReadArgsOpen
ooArgs2Stem: procedure expose m.
parse arg stem, ox
if ox = '' then
ox = m.stem.0
else
ox = ox - 1
do ax=3 by 1 to arg()
ox = ox + 1
m.stem.ox = arg(ax)
end
m.stem.0 = ox
return stem
endProcedure ooArgs2Stem
/* copy oo end ********************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(REPA) cre=2007-10-19 mod=2008-12-16-17.23.24 F540769 ---
/***********************************************************************
synopsis: repa optDsn? fun opts
optDsn gibt den DSN der Optionen an, als Editmacro ist das nicht
nötig, da wird der aktuelle editierte DSN genommen
fun n neue Optionen(vorlage) erstellen. Membername max 4 Zeichen.
Table(spaces), DSN's usw. in Variabeln fuellen.
Die Optionen werden als Rexx interpretiert.
m Map Member erstellen zur Zuordnung der alten zu neuen
Partitionen.
Optionen: pN? pO? O
falls pN und pA fehlen wird map aus old und new DDL
abgeleitet. Sie enthält als Info alle Keys.
pN Anzahl neue partitionen
pO Anzahl alte partitionen, Default pN
pN und pO repartitieren linear
O die Option 'O' erzeugt eine Map mit Overlaps,
wenn ein neuer Key = einem alten ist
0 unload limit 0 Job erzeugen. Sie submitten ihn, um das
Punchfile zu erzeugen
j restliche Jobs erstellen
unlo unload alte table
unl2 zweiter Unload als KatastrophenSicherung
load load neue table
reRu Runstats und Rebuild Index (parallel)
rebi Rebind
cnt Count alte Table
Ablauf Repartitionierung:
-sta ro sub unlo, back und cnt (parallel|) entladen, backup, count
drop und create TS ohne Indexe, Primary Key usw.
-sta ut sub load neuen TS laden
-sta rw create Indexe (mit DEFER), primary Key usw.
-sta ut sub reRu : Runstats TS und parallel Rebuild Indexe
Count neu (Runstats TB) mit alt (job ....Cnt) vergleichen
sub rebi: Rebind Packages
-sta rw
**** history ***********************************************************
01.12.2008 W. Keller fix map new old
******************** end of help */ /***********************************
27.11.2008 W. Keller rewrite
***********************************************************************/
parse arg args
m.debug = 0
call errReset 'h'
em = args = ''
if em then
em = adrEdit('macro (args)', '*') = 0
if args = '' | pos('?', args) > 0 then
exit help()
if length(word(args, 1)) = 1 then do
optDsn = ''
funOpts = args
if ^em then
exit errHelp('either use REPA as editMacro or optDsn argument')
end
else do
parse upper var args optDsn funOpts
em = 0
end
/* now, do the work */
call mapIni
call mapReset v
if em then
call doInEditMacro funOpts
else
call doInTso dsn2Jcl(optDsn), funOpts
exit
/*--- do the work in an editMacro ------------------------------------*/
doInEditMacro: procedure expose m.
parse upper arg fun opts
call adrEdit '(zl) = lineNum .zl', 4
call adrEdit '(lib) = dataset'
call adrEdit '(mbr) = member'
if mbr ^== '' then
optDsn = lib'('mbr')'
if fun = 'N' then do
if zl <> 0 then
call err 'fun n only in empty edit'
call adrEdit 'caps off'
m.opt.0 = 0
end
else do
do lx = 1 to zl
call adrEdit '(line) = line' lx
m.opt.lx = strip(line, 't')
end
m.opt.0 = zl
end
call doWork optDsn, fun, opts
if m.opt.0 <> zl then do
do lx= zl+1 to m.opt.0
line = m.opt.lx
if lx = 1 then
call adrEdit 'line_after .zf = (line)'
else
call adrEdit 'line_after .zl = (line)'
end
end
return
endProcedur doInEditMacro
/*--- do the work in tso ---------------------------------------------*/
doInTso: procedure expose m.
parse upper arg optDsn, fun opts
if fun = 'N' then
m.opt.0 = 0
else
call readDsn optDsn, 'M.OPT.'
zl = m.opt.0
call doWork optDsn, fun, opts
if zl ^== m.opt.0 then
call writeDsn optDsn, 'M.OPT.'
return
endProcedure doInTso
/*--- interpret the opts member and do the work ----------------------*/
doWork: procedure expose m.
parse arg optDsn, fun, opts
call setDefaults optDsn
if fun = 'N' then do
if dsnGetMbr(optDsn) = '' then
call err 'edit rsp. optionDsn must be a',
'library member not' optDsn
call newOpt optDsn
return
end
call interStem opt /* interpret options */
m.jobPref = left(space(m.jobPref, 0)'REPA', 4)
call mapPut v, 'pref', m.dsnPref /* prefix for gen. datasets */
if fun = 'M' then do
parse var opts nPa oPa over /* analyse map options */
if nPa = '' then do
end
else if ^datatype(nPa, n) then do
over = nPa
nPa = ''
end
else if ^datatype(oPa, n) then do
over = oPa
oPa = nPa
end
m.prt.0 = 0
if nPa = '' then do /* analyse ddl and merge keys */
m.partKeyType = ''
call partKey m.old.ddl, ok
call partKey m.new.ddl, nk
call merge prt, nk, ok, over
end
else do /* linear map */
call makeParts prt, nPa, oPa, over
end
call writeEdit m.partMap, prt
end
else if fun = 0 then do
call uLi0Job mCut(u0, 0), old
call writeEdit m.uli0Job, u0
end
else if fun = 'J' then do
/* punch file from unload limit 0 job */
call anaPunch pu, new, m.dsnPref'.'m.old.ts'.PUNLIM0'
call readMap mCut(paMa, 0), m.partMap
call unloJob m.unloJob, old, m.paMa.oldFi, m.paMa.oldLa, 'UNLOA'
call mapPut v, 'pref', m.old.sub'.REPABACK'
call unloJob m.backJob, old, m.paMa.oldFi, m.paMa.oldLa, 'BACKU'
call mapPut v, 'pref', m.dsnPref
call loadJob m.loadJob, new, old, pu, paMa
call reRuJob m.reRuJob, new
call rebiJob m.rebiJob, new
call cntJob m.cntJob, old
end
else do
call err 'fun' fun 'not implemented'
end
return
endProcedure doWork
/*--- write dsn from stem st and, if we are in foreground edit it ----*/
writeEdit: procedure expose m.
parse arg dsn, st
doEd = sysVar('sysEnv') == 'FORE' & sysVar('sysIspf') == 'ACTIVE'
if st ^== '' then do
call mStrip st, 't'
call writeDsn dsn, 'M.'st'.', , ^ doEd
end
if doEd then
call adrIsp "Edit dataset('"dsn"')", 4
return
endProcedure writeEdit
/*--- set the defaults value for optDsn ------------------------------*/
setDefaults: procedure expose m.
parse arg optDsn
pref = dsnSetMbr(optDsn)'('strip(left(dsnGetMbr(optDsn), 4))
m.new.sub = 'DB??' /* db2 subsys for new */
m.new.tb = 'OA1?.????' /* new creator.table */
m.new.ts = '????A1?.A???A' /* new db.tablespace */
m.old.sub = m.new.sub /* db2 subsys for old */
m.old.tb = m.new.tb /* old creator.table */
m.old.ts = m.new.ts /* old db.ts */
m.new.ddl = pref'DNEW)' /*ddl new partition keys*/
m.old.ddl = pref'DOLD)' /*ddl old partition keys*/
m.partMap = pref'MAP)' /* load new */
m.uli0Job = pref'ULI0)' /* unload lim0 old */
m.unloJob = pref'UNLO)' /* unload old */
m.backJob = pref'BACK)' /* unload old */
m.loadJob = pref'LOAD)' /* load new */
m.reRuJob = pref'ReRu)' /* rebuild runstats */
m.rebiJob = pref'Rebi)' /* rebind job */
m.cntJob = pref'Cnt)' /* Count job */
m.jobPref = 'YRPA'
m.jobs = 32
m.skels = 'ORG.U0009.B0106.KIUT23.SKELS' /* skeleton library */
m.dsnPref = 'DSN.REPA'
return
endProcedure setDefaults
/*--- write a new opt dsn --------------------------------------------*/
newOpt: procedure expose m.
parse arg optDsn
call mAdd opt,
, right('/* option member for REPA repartitionierung */', 72),
, right('/* use REPA ? for help */', 72),''
call setDefaults optDsn
call newOpt1 new.sub, 'db2 subsystem for new table'
call newOpt1 new.tb, 'new creator.table'
call newOpt1 new.ts, 'new db.tablespace'
call newOpt1 old.sub 'M.NEW.SUB', 'db2 subsystem for old table'
call newOpt1 old.tb 'M.NEW.TB' , 'old creator.table'
call newOpt1 old.ts 'M.NEW.TS' , 'old db.tablespace'
call newOpt1 new.ddl, 'ddl for new partition keys'
call newOpt1 old.ddl, 'ddl for old partition keys'
call mAdd opt, ''
call newOpt1 partMap, 'map old partitions to new'
call mAdd opt, ''
call newOpt1 uli0Job, 'jobName unload limit 0 old'
call newOpt1 unloJob, 'jobName unloads old'
call newOpt1 backJob, 'jobName backup unloads old'
call newOpt1 cntJob, 'jobName count old table'
call newOpt1 loadJob, 'jobName loads new'
call newOpt1 reRuJob, 'jobName rebuild runStats'
call newOpt1 rebiJob, 'jobName rebind packages'
call mAdd opt, ''
call newOpt1 jobPref, 'jobprefix, max 4 characters'
call newOpt1 jobs , 'number of jobs'
return
endProcedure newOpt
/*--- write one opt line for variable name
with value val rsp. m.name and comment com -----------------*/
newOpt1: procedure expose m.
parse arg name val, com
cx = 40
le = 72
li = left('M.'name, 10) '='
if val <> '' then do
li = li val
end
else do
val = m.name
if datatype(val, n) then
li = li val
else
li = li quote(val, "'")
end
if com <> '' then do
com = '/*' com '*/'
if length(li) < cx & length(com) + cx - 1 <= le then
li = left(li, cx-1)com
else if length(li) + length(com) < le then
li = li com
else if length(li) + length(com) <= le then
li = li || com
else if length(com) + cx - 1 <= le then
call mAdd opt, left('', cx-1)com
else
call mAdd opt, right(com, le)
end
call mAdd opt, li
return
endProcedure newOpt1
/*--- create a map for linear repartition ----------------------------*/
makeParts: procedure expose m.
parse arg o, newP, oldP, over
msg = 'linear repartition into' newP 'new from' oldP 'old parts'
if over = 'O' then
msg = msg 'with overlap'
else if over <> '' then
call err 'bad makeParts overlap' over
say msg
call mAdd o, '*' msg
oldX = 1
do newX=1 to newP
li = newX ':' min(oldX, oldP)
do while newX*oldP > oldX*newP
oldX = oldX + 1
end
equal = newX*oldP = oldX*newP
call mAdd o, li '-' min(oldX+(equal & over = 'O'), oldP)
oldX = oldX + (equal & over = '')
end
return
endProcedure makeParts
/*--- interpret the given dsn as rexx --------------------------------*/
interDsn: procedure expose m.
parse arg dsn
call debug 'interpreting' dsn
call readDsn dsn, m.interDsn.
call interStem interDsn
call debug 'interpreted' dsn
return
endProcedure interDsn
/*--- interpret the lines of stem st as rexx -------------------------*/
interStem: procedure expose m.
parse arg st
s = ''
do x=1 to m.st.0
l = strip(m.st.x)
if right(l, 1) == ',' then /* rexx continuation */
s = s left(l, length(l) - 1)
else
s = s l';' /* separate statements */
end
interpret 'drop st s x l;' s
return
endProcedure interStem
/*--- extract partition keys from ddl to stem o ----------------------*/
partKey: procedure expose m.
parse arg ddl, o
call readDsn ddl, ii.
nrLast = 0
do l=1 to ii.0
line = translate(ii.l)
pc = wordPos('PART', line)
if pc < 1 then
pc = wordPos(',PART', line)
if pc < 1 then
pc = wordPos('(PART', line)
if pc < 1 then
iterate
nrAct = word(line, pc+1)
val = word(ii.l, pc+2)
if translate(val) = 'USING' then
iterate
if nrAct <> nrLast + 1 then
call err 'partition' (nrLast + 1) 'expected not:' line
if left(val, 7) <> "VALUES(" then
call err "VALUES(' expected not:" left(val,20) 'in line' line
val = strip(substr(val, 8))
do while pos(right(val, 1), ",)") > 0
val = strip(left(val, length(val)-1))
end
/* we only handle first key | */
ty = left(val, 1)
if datatype(ty, 'n') then
ty = 9
if ty == "'" & substr(val, 12, 1) == "'" ,
& substr(val, 4, 1) == "." ,
& substr(val, 7, 1) == "." ,
& verify(substr(val,2,2)substr(val,5,2)substr(val,8,4),
, '0123456789') == 0 then do
ty = 'd'
val = substr(val,8,4)'-'substr(val,5,2)'-'substr(val,2,2),
|| substr(val, 13)
end
if m.partKeyType == '' then do
m.partKeyType = ty
if ty = 9 then
say 'Achtung numerische Limitkeys funktionieren nur' ,
'wenn alle dieselbe Stellenzahl haben' ,
copies('|', 160)
end
else if m.partKeyType ^== ty then
call err 'partKey start changed from' m.o.nrLast 'to' val
if nrLast > 0 then
if val <<= m.o.nrLast then
call err 'limit key' nrAct val,
'not greater than' m.o.nrLast
m.o.nrAct = val
nrLast = nrAct
end
m.o.0 = nrLast
say m.o.0 'keys in ddl' ddl
if 0 then
do x=1 to m.o.0
say right(x,4) m.o.x
end
return
endProcedure partKey
/*--- merge two set of keys,
show all keys (new and old) as comment --------------------*/
merge: procedure expose m.
parse arg out, n, o, over
msg = 'Repa merge Repartionierung'
o1 = over == 'O'
if o1 then
msg = msg 'with overlap'
else if over ^== '' then
call err 'bad merge overlap' over
say msg
call mAdd out, '* ' msg,
, '* new old',
, '* ' right(m.n.0, 5)right(m.o.0,5) 'number of parts',
, '***'
ox = 1
nx = 1
fBeg = 1
do forever
if nx > m.n.0 then do
if ox > m.o.0 then
leave
call mAdd out, '* ' right('', 5)right(ox, 5) m.o.ox
ox = ox + 1
end
else if ox > m.o.0 | m.o.ox >> m.n.nx then do
call mAdd out, '* ' right(nx, 5)right('', 5) m.n.nx
if nx < m.n.0 then do
call mAdd out, right(nx, 8) ':' fBeg '-' min(ox, m.o.0)
fBeg = min(ox, m.o.0)
end
nx = nx + 1
end
else if m.o.ox == m.n.nx then do
call mAdd out, '* ' right(nx, 5)right(ox, 5) m.n.nx
if nx < m.n.0 then do
call mAdd out,right(nx,8) ':' fBeg '-' min(ox+o1,m.o.0)
fBeg = min(ox+1-o1, m.o.0)
end
nx = nx + 1
ox = ox + 1
end
else do
call mAdd out, '* ' right('', 5)right(ox, 5) m.o.ox
ox = ox + 1
end
end
call mAdd out, right(m.n.0, 8) ':' fBeg '-' m.o.0
return
endProcedure merge
/*--- read the map in dsn and write it to stem o
for each new partition one entry x
m.o.x : m.o.x.beg m.o.x.end ----------------------------*/
readMap: procedure expose m.
parse arg o, dsn
call readDsn dsn, i.
ox = m.o.0
fi = 999999
la = -1
do ix=1 to i.0
parse var i.ix an ':' vo '-' bi
if bi = '' | abbrev(strip(an), '*') then
iterate
ox = ox + 1
m.o.ox = an + 0
m.o.ox.beg = vo + 0
m.o.ox.end = bi + 0
fi = min(fi, vo, bi)
la = max(la, vo, bi)
end
m.o.0 = ox
m.o.oldFi = fi
m.o.oldLa = la
return
endProcedure readMap
/*--- analyze a punch file generate by unload ------------------------*/
anaPunch: procedure expose m.
parse arg lod, nk, punch
call readDsn punch, pun.
m.lod.1 = 'LOAD DATA LOG NO EBCDIC CCSID(00500,00000,00000)'
m.lod.1 = ' ----------------- part --------------------' /* ??? */
do px=1 by 1 to pun.0 while left(pun.px, 12) ^== ' INTO TABLE '
end
if px > pun.0 | left(pun.px, 12) ^== ' INTO TABLE ' then
call err 'into table not found in punch' punch
m.lod.2 = ' INTO TABLE' m.nk.tb 'PART '
m.lod.3 = ' RESUME NO REPLACE COPYDDN(TCOPYS) INDDN REC'
do px=px by 1 to pun.0 while left(pun.px, 6) ^== ' WHEN('
end
if px > pun.0 then
call err 'when not found in punch' punch
do lx = 4 by 1 while px <= pun.0
m.lod.lx = strip(pun.px, 't')
if pun.px = ' )' then
leave
px = px + 1
end
m.lod.0 = lx
if px > pun.0 then
call err ') ending ) not found in punch' punch
return
endProcedure anaPunch
/*--- generate the unload limit 0 job --------------------------------*/
uli0Job: procedure expose m.
parse arg o, ok
call mapPut v, 'dbSub', m.ok.sub /* db2 subSystem */
call mapPut v, 'tb', m.ok.tb
call mapPut v, 'ts', m.ok.ts
call jobCards mCut(o, 0), 'ULI0'
call expSkel rePaUli0, o
return
endProcedure uli0Job
/*--- generate jobCards and put var jobName --------------------------*/
jobCards: procedure expose m.
parse arg o, jobSuf
call mapPut v, 'jobName', m.jobPref || jobSuf
call expSkel rePaJC, o
return
endProcedure jobCards
/*--- generate unloads -----------------------------------------------*/
unloJob: procedure expose m.
parse arg unloJob, ok, fi, la, jobMid
call mapPut v, 'dbSub', m.ok.sub
call mapPut v, 'tb', m.ok.tb
call mapPut v, 'ts', m.ok.ts
call mCut o, 0
jMax = min(la+1-fi, m.jobs)
pLast = fi-1
do jx=1 to jMax
px = pLast + 1
pLast = trunc(0.5 + (la+1-fi) * jx / jMax)
partNo = right(px, 3, '0')
if px = pLast then
partLast = ''
else
partLast = ':'right(pLast, 3, '0')
/* call mapPut v, 'jobNo', right(jx, 3, '0') */
call mapPut v, 'partNo', partNo
call mapPut v, 'partLast', partLast
call jobCards o, left(jobMid, 1)right(jx, 3, '0')
call expSkel rePaUnlo, o
end /* each job */
call mStrip o, 't'
call writeDsn unloJob, m.o., ,1
return
endProcedure unloJob
/*--- generate loads -------------------------------------------------*/
loadJob: procedure expose m.
parse arg loadJob, new, old, pun, paMa
call mapPut v, 'dbSub', m.new.sub
call mapPut v, 'oldTs', m.old.ts
call mapPut v, 'newTb', m.new.ts
call mCut o, 0
jMax = min(m.paMa.0, m.jobs)
pLast = 0
do jx=1 to jMax
pFirst = pLast + 1
pLast = trunc(0.5 + m.paMa.0*jx/jMax)
call jobCards o, 'L'right(jx, 3, '0')
call expSkel rePaLoJo, o
do px=pFirst to pLast /* for each partition of job */
partNo = right(m.paMa.px, 3, '0')
li = '//REC'partNo
do qx=m.paMa.px.beg to m.paMa.px.end
call mAdd o, left(li,14)'DD DISP=SHR,',
|| 'DSN=&OLDPREF.'right(qx,3,0)'&OLDSUF'
li = '//'
end /* each old partition */
end /* for each partition of job */
call expSkel rePaLoPu, o
do px=pFirst to pLast /* for each partition of job */
partNo = right(m.paMa.px, 3, '0')
qq = m.o.0 + 2
call mAddSt o, pun
m.o.qq = m.o.qq || partNo
qq=qq+1
m.o.qq = m.o.qq || partNo
end /* for each partition of job */
end /* each job */
call mStrip o, 't'
call writeDsn loadJob, m.o., ,1
return
endProcedure loadJob
/*--- generate rebuild and runstats ----------------------------------*/
reRuJob: procedure expose m.
parse arg reRuJob, nd
call mapPut v, 'dbSub', m.new.sub
call mapPut v, 'ts', m.nd.ts
call jobCards mCut(o, 0), 'REBU'
call expSkel rePaRebu, o
call jobCards o, 'RUNS'
call expSkel rePaRuns, o
call mStrip o, 't'
call writeDsn reRuJob, m.o., ,1
return
endProcedure loadJob
/*--- generate rebinds -----------------------------------------------*/
rebiJob: procedure expose m.
parse arg rebiJob, nd
call mapPut v, 'dbSub', m.nd.sub
call jobCards mCut(o, 0), 'REBI'
call expSkel repaRebi, o
parse var m.nd.tb cr '.' nm
call sqlConnect m.nd.sub
call rebindStmts o, strip(cr), strip(nm)
call sqlDisconnect
call mStrip o, 't'
call writeDsn rebiJob, m.o., ,1
return
endProcedure loadJob
/*--- generate count job ---------------------------------------------*/
cntJob: procedure expose m.
parse arg cntJob, nd
call mapPut v, 'dbSub', m.nd.sub
call mapPut v, 'tb', m.nd.tb
call jobCards mCut(o, 0), 'CNT'
call expSkel repaCnt, o
call mStrip o, 't'
call writeDsn cntJob, m.o., ,1
return
endProcedure loadJob
/*--- expand the variables in one skeleton, result to stem o --------*/
expSkel: procedure expose m.
parse arg skl, o
upper skl
if symbol('m.expSkel.skl') <> 'VAR' then
call readDsn m.skels'('skl')', 'M.EXPSKEL.'skl'.'
call mapExpAll v, o, expSkel.skl
return
endProcedure expSkel
/*--- all rebinds ----------------------------------------------------*/
rebindStmts: procedure expose m.
parse arg o, cr, tb
sel = bQualifier '=' quote(cr, "'") and bName '=' quote(tb, "'")
call debug 'sel =' sel
p = ':m.pk.sx.'
call sqlPreOpen 8,
, "select distinct dCollid, dName, dContoken, version, p.type,",
"p.bindTime, p.valid, p.operative",
"from sysibm.sysPackDep d, sysibm.sysPackage p" ,
"where bType in ('T')" ,
"and d.dLocation = p.location" ,
"and d.dCollid = p.collid" ,
"and d.dName = p.name" ,
"and d.dConToken = p.conToken" ,
"and ("sel")" ,
"order by 2, 4, 1"
do sx=1 while sqlFetchInto(8, ':col, :nam, :cTo, :ver, :typ,' ,
':bTi, :val, :ope')
call debug sx col nam c2x(cTo) ver typ bTi 'vo' val ope
st = 'PACKAGE('strip(col)'.'strip(nam)
if typ = 'T' then
st = 'REBIND TRIGGER' st')'
else
st = 'REBIND' st'.('strip(ver)'))'
call mAdd o, st '-'
call mAdd o, ' /* valid='val', op='ope', lastBind='bTi '*/'
end
call sqlClose 8
return sx-1
endProcedure rebindStmts
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm:
parse arg ggSrc, ggRet
return sqlExec('execute immediate :ggSrc', ggRet)
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure expose m.
parse arg ggSys, ggRetCon
call sqlIni
address tso "SUBCOM DSNREXX"
if rc <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
if ggSys = '-' then
return 0
return sqlExec("connect" ggSys, ggRetCon ,1)
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure expose m.
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
call address tso 'DSN SYSTEM('sys')'
rr = rc
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql end **************************************************/
/* copy mapExp begin **************************************************/
mapVia: procedure expose m.
parse arg a, ky
sx = pos('*', ky)
if sx < 1 then
return mapGet(a, ky)
via = mapGet(a, left(ky, sx-1))
do while sx <= length(ky)
fx = sx+1
sx = pos('*', ky, fx)
if sx < 1 then
sx = length(ky) + 1
if sx = fx then do
if symbol('m.via') ^== 'VAR' then
call err 'missing m.'via 'at' sx 'in mapVia('a',' ky')'
via = m.via
end
else do
f = substr(ky, fx, sx - fx)
if symbol('m.via.f') ^== 'VAR' then
call err 'missing m.'via'.'f ,
'at' sx 'in mapVia('a',' ky')'
via = m.via.f
end
end
return via
endProcedure mapVia
mapExpAt: procedure expose m.
parse arg a, src, sx
m.map.ExpAt = 0
cx = pos('$', src, sx)
if cx < 1 then
return substr(src, sx)
res = substr(src, sx, cx-sx)
do forever
if substr(src, cx+1, 1) = '{' then do
ex = pos('}', src, cx+2)
if ex < 1 then
call err 'missing } after' substr(src, cx) 'in' src
res = res || mapVia(a, strip(substr(src, cx+2, ex-cx-2)))
ex = ex + 1
end
else do
ex = verify(src, m.mAlfDot, 'n', cx+1)
if ex < 1 then
return res || mapVia(a, substr(src, cx+1))
if ex = cx+1 then do
m.map.ExpAt = cx
return res
end
res = res || mapVia(a, substr(src, cx+1, ex-cx-1))
end
cx = pos('$', src, ex)
if cx < 1 then
return res || substr(src, ex)
res = res || substr(src, ex, cx-ex)
end
endProcedure mapExpAt
mapExp: procedure expose m.
parse arg a, src
res = mapExpAt(a, src, 1)
if m.map.ExpAt ^== 0 then
call err 'mapExp stopped at' substr(src, map.ExpAt) 'in' src
return res
endProcedure mapExp
mapExpAllAt: procedure expose m.
parse arg a, dst, src, sx, cx
do while sx <= m.src.0
li = mapExpAt(a, m.src.sx, cx)
dx = m.map.ExpAt
if (cx=1 & dx = 0) | li ^= '' then
call mAdd dst, li
if dx = 0 then do
cx = 1
sx = sx+1
end
else do
return sx dx
end
end
return ''
endProcedure mapExpAllAt
mapExpAll: procedure expose m.
parse arg a, dst, src
sto = mapExpAllAt(a, dst, src, 1, 1)
if sto == '' then
return
lx = word(sto, 1)
call err 'mapExpAll stopped at' sto':' m.src.lx
endProcedure mapExpAll
/* copy mapExp end ****************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, if opt <> '' maintain stem of keys
('K' in map.keys, '=' in a else in opt) --------------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = opt
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'a')
m.vv = val
return val
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'p')
m.vv = val
return val
endProcedure mapPut
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a if it exists,
else if called with a third argument return third argument
else issue an error ----------------------------------------*/
mapGet: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv ^== '' then
return m.vv
else if arg() >= 3 then
return arg(3)
else
call err 'missing key in mapGet('a',' ky')'
endProcedure mapGet
/*--- return a stem of all keys --------------------------------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if m.map.keys ^== '' then
call err 'not implemented mapRemove('a',' ky')'
val = m.a.vv
drop m.a.ky
return val
endProcedure mapRemove
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
if length(k) > 200 then do
k = left(k, 201)
if symbol('m.a.k') == 'VAR' then/* ist noch hier */
call mapClear m.a.k
end
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
/*--- return the value pointer for a key, '' if non existing
with fun = 'a' add a key, with 'p' put a key ------------*/
mapValAdr: procedure expose m.
parse arg pA, pKy, fun
a = pA
ky = pKy
do forever
if length(ky) <= 200 then do
if symbol('m.a.ky') ^== 'VAR' then
leave
if fun == 'a' then
call err 'duplicate key' pKy 'in map' pA
return a'.'ky
end
k1 = left(ky, 201)
if symbol('m.a.k1') ^== 'VAR' then
leave
a = m.a.k1
ky = substr(ky, 202)
end
if fun == '' then
return ''
opt = left('K', m.map.keys.pA ^== '')
if opt == 'K' then
call mAdd m.map.Keys.pA, pKy
do while length(ky) > 200
k1 = left(ky, 201)
n = mapNew(opt)
m.a.k1 = n
if a ^== pA & opt == 'K' then
call mAdd m.map.keys.a, ky
a = n
ky = substr(ky, 202)
end
return a'.'ky
endProcedure mapValAdr
/* copy map end *******************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m end *********************************************************/
/* 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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
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 expose m.
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 by 1
alRc = adrTso(c rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for' c rest
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
endProcedure tsoAlloc
dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
bl = 32760
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
recfm='f b'
bl = bl - (bl // rl)
end
else do
if rl = '' then
rl = bl-4
recfm = substr(atts, 2, 1) 'B'
end
end
if pos('(', dsn) > 0 then
po = 'dsntype(library) dsorg(po)'
else
po = ''
dsn = dsnSetMbr(dsn)
if forCsm == 1 then
return "dataset('"dsn"')" po,
"recfm("space(recfm, 0)") lrecl("rl") blkSize("bl")" ,
"mgmtclas(s005y000) space(10, 1000) cylinder"
else
return "dsn('"dsn"')" po,
"recfm("recfm") lrecl("rl") block("bl")" ,
"mgmtclas(s005y000) 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
copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
call readDDBegin word(frDD, 1)
call writeDDBegin word(toDD, 1)
cnt = 0
do while readDD(word(frDD, 1), r.)
call writeDD word(toDD, 1), r.
cnt = cnt + r.0
end
call readDDEnd word(frDD, 1)
call writeDDEnd word(toDD, 1)
interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
if ggSay == 1 | m.debug == 1 then
say cnt 'records copied from' frSpec 'to' to toSpec
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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(RLRSN) cre=2007-10-26 mod=2007-11-05-13.00.08 F540769 ---
/*rexx*/
/******************************************************************/
/* LRSN */
/* */
/* 1 FUNCTION Translate Timestamp <-> LRSN (Todclock) */
/* */
/* 2 SUMMARY */
/* TYPE Rexx TSO/ISPF */
/* HISTORY: */
/* 09.11.2006 V1.0 base version (M.Streit,KITD2) */
/* 01.11.2007 V1.1 added uniq (W.Keller,KIUT23) */
/* */
/* Call: tso lrsn (TSO.RZ1.P0.USER.EXEC) */
/* */
/* 3 USAGE rexx lrsn start-procedure */
/* rexx rlrsn programm */
/* panel plrsn Mainpanel */
/* table tlrsn ISPF table */
/* */
/******************************************************************/
debug = 0 /* 0 oder 1 */
numeric digits 32
/* Check if LogMode 4 used */
lines=SYSVAR(SYSLTERM)
cols =SYSVAR(SYSWTERM)
if lines < 43
then do;
address ISPEXEC;
zmsg000l = "LM4 with 43x80 Chars required"
"setmsg msg(ispz000)"
exit(8);
end ;
/* Create ISPF table if necessary */
address ispexec
"control errors return" /* ISPF Error -> control back to pgm */
"tbopen tlrsn write" /* try to open table */
NAMES ="(CLRSN CTS CTSUTC CUNIQ JULIAN GMTTIME)"
if RC = 0 then do
address ispexec "tbQuery tlrsn names(tnm)"
if tnm <> names then do
say 'old table tLrsn has bad filed names' tnm
say 'drop and recreate table tLrsn' names
address ispexec 'tbEnd tLrsn'
address ispexec 'tberase tLrsn'
rc = 8
end
end
if rc = 8 then do /* if table not found...*/
address ispexec
"tbcreate tlrsn", /* table create */
"names"names "write replace"
if rc > 4 then do
say "Table create error with RC "rc
exit
end
"tbopen tlrsn write" /* table open */
end
if rc = 12 then do
"tbclose tlrsn "
"tbopen tlrsn write" /* try to open table */
if rc > 0 then do
say "Table open error with RC "rc
end
end
"tbtop tlrsn" /* jump to first row */
/* Display panel until PF3 is pressed */
selrows = "ALL" /* Angaben für Panel */
num1 = 1 /* Linien-Pointer */
c = ''
zc = 'CSR'
sdata = 'N'
ptimest = ''
plrsn = ''
do forever /* solange nicht PF3 */
call read_cvt
"tbtop tlrsn" /* jump to first row */
"tbdispl tlrsn panel(plrsn)" /* Panel anzeigen bis */
if rc > 4 then leave /* PF3 gedrückt? */
do while rc < 8
if c = 'D' then do
call del_row /* Zeilen löschen */
end
else if c <> ' ' then do
zmsg000s = "Command unknown"
zmsg000l = "Command unknown, only Delete(D) allowed"
"setmsg msg(ispz000)" /* Meldung ausgeben */
leave
end
if ztdSels <= 1 then
leave
"tbdispl tlrsn" /* get next selection */
end
c = ''
if plrsn <> '' then call calcFromLrsn pLrsn
if ptimest <> '' then call calcFromTst pTimeSt
if pUniq <> '' then call calcFromUniq pUniq
end
if sdata='Y' then
"tbclose tlrsn "
else
"tbend tlrsn"
exit
/* expand timestamp and validate it ***********************************/
checkTst: procedure
parse arg pTimeSt
/* ptimest = Timestamp format yyyy-mm-dd-hh.mm.ss.ffffff */
rTimeSt =overlay(ptimest, '1972-01-01-00.00.00.000000')
call parseTimestamp rTimest
/* check if values in range */
if (yyyy<1972) | (yyyy>2141) then do
zmsg000s = ""
zmsg000l = "year range: 1972-2041"
address ispExec " setmsg msg(ispz000)" /* Meldung ausgeben */
return ''
end
if (mo<1) | (mo>12) then do
zmsg000s = ""
zmsg000l = "month range 1-12"
address ispExec "setmsg msg(ispz000)" /* Meldung ausgeben */
return ''
end
if (dd<1) | (dd>31) then do
zmsg000s = ""
zmsg000l = "day range 1-31"
address ispexec "setmsg msg(ispz000)" /* Meldung ausgeben */
return ''
end
return rTimest
endProckedure checkTst
parseTimestamp:
parse arg yyyy'-'mo'-'dd'-'hh'.'mm'.'ss'.'ffffff
return
return mo'/'dd'/'yyyy' 'hh':'mm':'ss'.'ffffff
/* delete current row ***********************************************/
del_row:
address ispexec
rowid_nr=0
"tbget tdbnr rowid(rowid_nr)" /* Curor-Position lesen */
"tbskip tdbnr row("rowid_nr")" /* Cursor auf Row setzen */
"tbdelete tlrsn" /* Zeile löschen */
c = ''
return
/* read timeZoneOffset and leapSeconds registers
and set variables for uniq ***********************************/
read_cvt:
/* offsets documented in z/OS Data Areas Vol.1 */
cvt_off ='00000010' /* (offset = X'10') */
cvtext2_off='00000560'
cvtldto_off='00000038'
cvtlso_off ='00000050'
/* get CVT control block adress */
cvt_adr =C2X(STORAGE(cvt_off,4))
/* get address of extention2 */
cvtext2_adr =D2X(X2D(cvt_adr) + X2D(cvtext2_off))
/* get address of cvtldto timezone value */
cvtldto_adr =D2X(X2D(cvtext2_adr) + X2D(cvtldto_off))
/* get value */
cvtldto =C2X(STORAGE(cvtldto_adr,8))
/* get address of cvtlso leap seconds value */
cvtlso_adr =D2X(X2D(cvtext2_adr) + X2D(cvtlso_off))
/* get value */
cvtlso =C2X(STORAGE(cvtlso_adr,8))
cTZ = x2d(cvtLdto) * 1e-6 / 256 / 16 / 3600
cLS = trunc(x2d(cvtLso) * 1e-6 / 256 / 16)
uniqDigits = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ012345678'
/* find lrsn of day 0 */
uniqZero = left(conv2tod('2004-12-31-00.00.22.000000'), 12)
/* 0 out last 6 bits */
uniqZero = b2x(overlay('000000', x2b(uniqZero), 43))
if debug then do
say "cvt_adr = "cvt_adr
say "cvtext2_adr = "cvtext2_adr
say "cvtldto_adr = "cvtldto_adr
say "cvtldto (TOD-fmt) = "cvtldto,
'=' (x2d(cvtldto) * 16e-6 / 256 / 256) 'secs timezone'
say "cvtldto_adr = "cvtlso_adr
say "cvtlso (TOD-fmt) = "cvtlso ,
'=' (x2d(left(cvtlso, 13)) * 1e-6 ) 'leap secs'
say 'uniqZero' uniqZero ,
'base' length(uniqDigits) 'digits' uniqDigits
end
return
endSubroutin read_cvt
/* calculate all values from timestamp and add row ********************/
calcFromTst:
parse arg pTst
/* Timestamp format: yyyy-mm-dd-hh.mm.ss.ffffff */
rTimeSt = checkTst(pTst)
if rTimeSt = '' then
return
lrsn_cet= CONV2TOD(rTimeSt)
lrsn_cet=LEFT(STRIP(lrsn_cet),16,'0')
if debug then say "LRSN (CET) ="lrsn_cet
cLrsn = D2X(X2D(lrsn_cet) - X2D(CVTLDTO) + X2D(CVTLSO))
if debug then say "LRSN (UTC) ="clrsn
cts = rtimest /*ptimest with overlay */
ctsutc = CONV2TS(clrsn)
gmtTime = substr(ctsutc, 12, 8)
cUniq = lrsn2uniq(cLrsn)
julian = tst2jul(cts)
ptimest = ''
"tbadd tlrsn"
return
endProcedure calcFromTst
/* from lrsn calculate all values add it to our table *****************/
calcFromLrsn:
parse arg lrsn
LRSN=LEFT(STRIP(LRSN),16,'0')
if debug then say "LRSN (UTC) ="LRSN
LRSN_TZ=D2X(X2D(LRSN) + X2D(CVTLDTO))
if debug then say "LRSN timezone corrected ="LRSN_TZ
LRSN_CET=D2X(X2D(LRSN_TZ) - X2D(CVTLSO))
if debug then say "LRSN timezone and leap seconds corrected ="LRSN_CET
if debug then say ""
if debug then say ""
if debug then say ""
/*********
LEAPSEC = 23
XSEC = X2D('0000000F4240000');
1 2 3 4 5 6 7
CORR = LEAPSEC * XSEC
**********/
if debug then say =CONV2TS(LRSN) "(UTC)"
clrsn = lrsn
cts = CONV2TS(LRSN_CET)
ctsutc = CONV2TS(LRSN)
gmtTime = substr(ctsutc, 12, 8)
cUniq = lrsn2uniq(cLrsn)
julian = tst2jul(cts)
"tbadd tlrsn"
if debug then say "RC="rc
plrsn = ''
return
endProcedure calcFromLrsn
/* from uniq calculate all values and add them to our table ***********/
calcFromUniq:
parse arg uniq
if verify(uniq, uniqDigits) > 0 then do
zmsg000s = "bad uniq"
zmsg000s = ""
zmsg000l = "Uniq allows only characters A-Z and 0-8"
"setmsg msg(ispz000)" /* Meldung ausgeben */
return
end
call calcFromLrsn uniq2Lrsn(uniq)
pUniq = ''
return
calcFromUniq
/* timestamp to julian ************************************************/
tst2jul: procedure
parse arg yyyy '-' mm '-' dd '-'
/* date function cannot convert to julian, only from julian
==> guess a julian <= the correct and
try the next values
*/
j = trunc((mm-1) * 29.5) + dd
yy = right(yyyy, 2)
do j=j by 1
j = right(j, 3, 0)
d = date('s', yy || j, 'j')
if substr(d, 3) = yy || mm || dd then
return yy || j
end
return
/* convert a lrsn to the uniq variable ********************************/
lrsn2uniq: procedure expose uniqZero uniqDigits debug
parse arg lrsn
/* unique are bits 0:41 of the TodClock value
minus 31.12.2004 represented
by base 35 by 'ABC...YZ01..8'
*/
lrsn = left(lrsn, 12)
diff = x2d(lrsn) - x2d(uniqZero)
if diff < 0 then
return '<2005|'
diff = right(d2x(diff), 12, 0)
if debug then say ' lrsn ' lrsn
if debug then say '- zero ' uniqZero
if debug then say '= ' diff
d42 = b2x(left(right(x2b(diff), 48, 0), 42))
if debug then say 'd42 ' d42
uni = right(i2bd(x2d(d42), uniqDigits), 8, 'A')
if debug then say 'uni ' uni
return uni
endProcedure lrsn2uniq
/* convert a uniq variable to lrsn ************************************/
uniq2lrsn: procedure expose uniqZero uniqDigits
parse arg uniq
uniq = left(uniq, 8, 'A')
d42 = d2x(bd2i(uniq, uniqDigits))
d48 = b2x('00'x2b(d42)'000000')
lrsn = right(d2x(x2d(d48) + x2d(uniqZero)), 12, 0)
return lrsn
endProcedure uniq2lrsn
/* conversion from Timestamp to TOD Clock Value ***********************/
CONV2TOD: PROCEDURE
/* timestamp yyyy-mm.... -> tod value: - leapseconds
BLSUXTID is described in z/OS V1R7.0 MVS IPCS Customization
BLSUXTID format : mo/dd/yyyy hh:mm:ss.ffffff
*/
parse arg tst
call parseTimestamp tst
tDate = mo'/'dd'/'yyyy' 'hh':'mm':'ss'.'ffffff
ACC=copies('0',8)
ADDRESS LINKPGM "BLSUXTID TDATE ACC"
RETURN LEFT(c2x(ACC),16,'0')
endProcedure conv2tod
/* conversion from TOD Clock Value to Timestamp */
/* BLSUXTOD is described in z/OS V1R7.0 MVS IPCS Customization */
/* input -> + leapseconds -> output */
CONV2TS: PROCEDURE
ACC=ARG(1)
ACC=X2C(ACC)
TDATE = COPIES('0' , 26)
ADDRESS LINKPGM "BLSUXTOD ACC TDATE"
/* return format : mo/dd/yyyy hh:mm:ss.ffffff */
/* Timestamp format: yyyy-mm-dd-hh.mm.ss.ffffff */
parse var TDATE mo '/' dd '/' yyyy hh ':' mm ':' ss '.' ffffff
TDATE = yyyy'-'mo'-'dd'-'hh'.'mm'.'ss'.'ffffff
RETURN TDATE
bd2i: procedure expose m.
parse arg v, digits
b = length(digits)
i = 0
do x = 1 to length(v)
q = substr(v, x, 1)
r = pos(q, digits)
if r < 1 then
call err 'bad digit' q 'in' v 'valid digits' digits
i = i * b + r - 1
end
return i
i2bd: procedure expose m.
parse arg i, digits
if i = 0 then
return left(digits, 1)
b = length(digits)
v = ''
do while i > 0
v = substr(digits, 1 + (i // b), 1) || v
i = i % b
end
return v
}¢--- A540769.WK.REXX.O08(RW) cre=2007-01-11 mod=2007-01-12-14.10.07 F540769 ---
/* copy rw begin ******************************************************
read and write interface
***********************************************************************/
s = rwBuf()
call rwWrite s, 'line eins'
call rwWrite s, 'line zwei'
call rwWrite s, 'line drei'
call rwOpen s, '-r'
do while ^m.rw.s.eof
say 'read' rwRead(s) ':'m.rw.s.bufIx 'of' m.rw.s.buf.0
end
say 'read after eof'
call rwOpen s, '-a'
call rwWrite s, 'line vier nach open append'
call rwWrite s, 'line fuenf'
call rwClose s
say 'write nach append'
do while ^m.rw.s.eof
say 'read' rwRead(s)
end
call rwClose s
call rwWrite s, 'line sechs nach close'
call rwClose s
say 'write nach close'
do while ^m.rw.s.eof
say 'read' rwRead(s)
end
d = rwDS( , dsn2jcl('wk.text(msk1)'))
do rx=1 while ^m.rw.d.eof
say 'msk1' rx strip(rwRead(d), 't')
end
call rwOpen d, dsn2jcl('wk.text(msk1)')';'dsn2jcl('wk.text(testIn)'),
';; ; ; ' dsn2jcl('wk.text(msk1)') ';;'
do rx=1 while ^m.rw.d.eof
say 'tsIn' rx strip(rwRead(d), 't')
end
call rwClose d
exit
test: procedure
call mCopyArgs a, 0, 'eins ...', 'zwei ...', 'drei ... schluss'
call mIni
r = mNew()
s = mNew()
call mDefReadFromStem r, a
say 0 mReadLn(r,x) "'"m.x"'"
call mDefReadFromStem s, a
do i=1 to 5
say i mReadLn(r,x) "'"m.x"' read s" mReadLn(s, y) m.y
end
exit
endProcedure
/*--- initialize m ---------------------------------------------------*/
rwDefine: procedure expose m.
parse arg m, op, cl, re, wr
if m = '' then
m = mIncD(rw.instances)
m.rw.m.eof = 0
m.rw.m.open = op
m.rw.m.close = cl
call rwDefineRW m, re, wr
return m
endProcedure rwDefine
rwDefineRW: procedure expose m.
parse arg m, re, wr
if re = '' then
re = "call rwOpen m, '-r'; return rwRead(m)"
else if left(re, 2) = '-e' then
re = "call err 'rwRead' m 'definedError'" substr(re, 3)
m.rw.m.read = re
if wr = '' then
wr = "call rwOpen m, '-w'; call rwWrite m, line"
else if left(wr, 2) = '-e' then
wr = "call err 'rwWrite ' m 'definedError'" substr(wr, 3)
m.rw.m.write = wr
return m
endProcedure rwDefine
rwOpen: procedure expose m.
parse arg m, arg1, arg2, arg3
m.rw.m.eof = 0
interpret m.rw.m.open
return
endProcedure mRead
rwClose: procedure expose m.
parse arg m, arg1, arg2, arg3
interpret m.rw.m.close
return
endProcedure mRead
rwRead: procedure expose m.
parse arg m
interpret m.rw.m.read
return res
endProcedure mRead
rwWrite: procedure expose m.
parse arg m, line
interpret m.rw.m.write
return
endProcedure mRead
/*--- buffer read write-----------------------------------------------*/
rwBuf: procedure expose m.
parse arg m
m = rwDefine(m, "call rwBufOpen m, arg1, arg2, arg3",
, "call rwBufOpen m, '-c'")
m.rw.m.buf.0 = 0
m.rw.m.bufIx = 'closed'
return m
endProcedure rwBuf
rwBufOpen: procedure expose m.
parse arg m, opt
if pos('r', opt) > 0 then do
m.rw.m.bufIx = 0
call rwDefineRW m, 'res = rwBufRead(m)', '-e'
end
else if pos('w', opt) > 0 | pos('a', opt) > 0 then do
m.rw.m.bufIx = 'write'
call rwDefineRW m, '-e"read in writeState"',
, "call mAdd '"rw.m.buf"', line"
if pos('w', opt) > 0 then
m.rw.m.buf.0 = 0
end
else do
m.rw.m.bufIx = 'closed'
call rwDefineRW m
end
m.rw.m.eof = 0
return
endProcedure rwBufOpen
rwBufRead: procedure expose m.
parse arg m
ix = m.rw.m.bufIx + 1
m.rw.m.bufIx = ix
if ix <= m.rw.m.buf.0 then
return m.rw.m.buf.ix
m.rw.m.eof = 1
return ''
endProcedure rwBufRead
/*--- datasetSpec read write -----------------------------------------*/
rwDS: procedure expose m.
parse arg m, spec
m = rwDefine(m, "call rwDSOpen m, arg1, arg2, arg3",
, "call rwDSClose m")
m.rw.m.dsSpec = spec
m.rw.m.dsDD = ''
m.rw.m.dsState = ''
return m
endProcedure rwDS
rwDSOpen: procedure expose m.
parse arg m, args
call rwDSClose m
opt = ''
if left(word(args , 1), 1) = '-' then do
opt = substr(word(args, 1), 2)
args = subWord(args, 2)
end
if args <> '' then
m.rw.m.dsSpec = args
if pos('r', opt) > 0 then do
m.rw.m.dsSpecSX = 0
m.rw.m.dsState = 'r'
call rwDSNextReader m
end
else if pos('w', opt) > 0 | pos('a', opt) > 0 then do
call err 'not implemented yet'
end
return
endProcedure rwDSOpen
rwDSClose: procedure expose m.
parse arg m
if m.rw.m.dsDD ^= '' then do
if m.rw.m.dsState = 'r' then
call readDDend m.rw.m.dsDD
else
call writeDDend m.rw.m.dsDD
interpret m.rw.m.dsFree
m.rw.m.dsDD = ''
end
m.rw.m.dsState = ''
m.rw.m.eof = 0
call rwDefineRW m
return
endProcedure rwDSClose
rwDSNextReader: procedure expose m.
parse arg m
if m.rw.m.dsDD <> '' then do
call readDDend m.rw.m.dsDD
interpret m.rw.m.dsFree
m.rw.m.dsDD = ''
end
bx = m.rw.m.dsSpecSX
do until spec <> ''
if bx >= length(m.rw.m.dsSpec) then do
m.rw.m.dsSpecSX = ex
m.rw.m.eof = 1
return 0
end
ex = pos(';', m.rw.m.dsSpec, 1+bx)
if ex = 0 then
ex = 1 + length(m.rw.m.dsSpec)
spec = strip(substr(m.rw.m.dsSpec, 1+bx, ex-bx-1))
bx = ex
end
m.rw.m.dsSpecSX = ex
al = dsnAlloc(spec, 'SHR')
m.rw.m.dsFree = subword(al, 2)
m.rw.m.dsDD = word(al, 1)
call readDDBegin m.rw.m.dsDD
call rwDefineRW m, 'res = rwDSRead(m)', '-e'
m.rw.m.dsBuf.0 = 0
m.rw.m.dsIx = 0
return 1
endProcedure rwDSNextReader
rwDSRead: procedure expose m.
parse arg m
ix = m.rw.m.dsIx + 1
m.rw.m.dsIx = ix
if ix <= m.rw.m.dsBuf.0 then
return m.rw.m.dsBuf.ix
if readDD(m.rw.m.dsDD, 'M.RW.'m'.DSBUF.') then do
m.rw.m.dsIx = 0
return rwDSRead(m)
end
if rwDSNextReader(m) then
return rwDSRead(m)
m.rw.m.eof = 1
return ''
endProcedure rwBufRead
/*--- put next line into m.line, return false at eof -----------------*/
mReadLn: procedure expose m.
parse arg m, line
if m.mrw.m.readLnIx == '' ,
| m.mrw.m.readLnIx >= m.mrw.m.readLnStem.0 then do
if ^ mRead(m, 'MRW.'m'.READLNSTEM') then do
m.line = ''
return 0
end
lx = 1
end
else do
lx = 1 + m.mrw.m.readLnIx
end
m.mrw.m.readLnIx = lx
m.line = m.mrw.m.readLnStem.lx
return 1
endProcedure readLn
mDefReadFromStem: procedure expose m.
parse arg m, stem
m.mrw.m.readFromStem = stem
call mDefRead m, 'if m.mrw.m.readFromStem == "" then return 0;' ,
'call mCopyStem stem, 0, m.mrw.m.readFromStem;' ,
'm.mrw.m.readFromStem = "";',
'return 1;'
return
endProcedure mDefReadStem
mReadFromStem: procedure expose m.
parse arg m, stem
si = m.mrw.m.readStem
ix = m.mrw.m.readStemIx + 1
m.mrw.m.readStemIx = ix
if ix <= m.si.0 then do
m.stem = m.si.ix
return 1
end
else do
m.stem = ''
return 0
end
endProcedure mReadFromStem
/**** simple convience function for stems *****************************/
/*--- fill stem st from index dx with lines from stem src ------------*/
mCopyStem: procedure expose m.
parse arg dst, dx, src
if dx == '' then
dx = m.dst.0
do ix = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.ix
end
m.dst.0 = dx
return dst
endProcedure mCopyStmm
/*--- fill stem dst from index dx with arguments ---------------------*/
mCopyArgs: procedure expose m.
parse arg dst, dx
if dx == '' then
dx = m.dst.0
do ix = 3 to arg()
dx = dx + 1
m.dst.dx = arg(ix)
end
m.dst.0 = dx
return dst
endProcedure mCopyArgs
mSay: procedure expose m.
parse arg stem, msg
l = length(m.stem.0)
if l < 3 then
l = 3
say left('', l, '-') msg 'mSay begin stem' stem m.stem.0
do ix = 1 to m.stem.0
say right(ix, l) strip(m.stem.ix, 't')
end
say left('', l, '-') msg 'mSay end stem' stem m.stem.0
return
endProcedure mSayem
/* copy rw end ****************************************************/
/* copy m begin ********************************************************
stem and tree handling
***********************************************************************/
/*--- increase m.m and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg m, delta
if delta = '' then
m.m = m.m + 1
else
m.m = m.m + delta
return m.m
endProcedure mInc
/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
parse arg m, delta
if symbol('m.m') <> 'VAR' then
m.m = 0
return mInc(m)
endProcedure mIncD
/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
parse arg m
return m.mKey.m
endProcedure mKy
/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
parse arg m
if symbol('m.m.0') == 'VAR' then
return m.m.0
else
return 0
endProcedure mSize
/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg m
dx = lastPos('.', m)
if dx <= 1 then
return ''
else
return left(m, dx - 1)
endProcedure mPar
/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg m, Ky, val
if m == '' then
m = 'mRoot.' || mIncD('mRoot.0')
m.m = val
m.mKey.m = Ky
m.m.0 = 0
return m
endProcedure mRoot
/*--- add one or several values to stem m.m --------------------------*/
mAdd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
end
m.m.0 = ix
return m'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSeq: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
dx = mSize(dst)
do sx = begX to endX
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return dst
endProcedure mAddSeq
/*--- add one value to the stem m.m ----------------------------------*/
mAddNd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
m.m.ix.0 = 0
end
m.m.0 = ix
return m'.'ix
endProcedure mAddNd
/*--- add one Ky value pair to stem m.m -----------------------------*/
mAddKy: procedure expose m.
parse arg m, Ky, val
nn = mAddNd(m, val)
m.mKey.nn = Ky
return nn
endProcedure mAddKy
/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
parse arg m, ky, val
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
call err 'duplicate Ky' ky 'for node' m
nn = mAddNd(m, val)
m.mKey.nn = ky
m.mIndex.m.mKey.ky = nn
return nn
endProcedure mAddK1
/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg m, Ky, val
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
m.ch = val
return ch
end
else do
return mAddK1(m, Ky, val)
end
return
endProcedure mPut
/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg m, ky
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
return m.mIndex.m.mKey.ky
else
return ''
endProcedure mAtK1
/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg m, Ky
if symbol('m.mIndex.m.mKey.Ky') ^== 'VAR' then
call err 'no Ky' Ky 'at node' m
ch = m.mIndex.m.mKey.Ky
return m.ch
endProcedure mVaAtK1
/*--- return the value of the first defined ky in the list of nodes
def if ky isn't defined ---------------------------------------*/
mFirst: procedure expose m.
parse arg Ky, def
do ax=3 to arg()
m = arg(ax)
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
return m.ch
end
end
return def
endProcedure mFirst
/*--- return the child at sequenceNo seq of node m -------------------*/
mAtSq: procedure expose m.
parse arg m, seq
if symbol('m.m.seq') ^== 'VAR' then
return ''
else
return m'.'seq
endProcedure mAtSq
/*--- remove all or all after nwSz children --------------------------*/
mRemCh: procedure expose m.
parse arg pa, nwSz
if nwSz = '' then
nwSz = 0
do cx=nwSz+1 to mSize(pa)
ch = pa'.'cx
call mRemCh ch
ky = m.mKey.ch
drop m.mIndex.pa.mKey.ky m.mKey.ch m.ch m.ch.0
end
m.pa.0 = nwSz
return pa
endProcedure mRemCh
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mAddTree: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
do sx=begX to endX
sCh = src'.'sx
if symbol('m.mKey.sCh') ^= 'VAR' then do
dCh = mAddNd(dst, m.sCh)
end
else do
ky = m.mKey.sCh
if symbol('m.mIndex.src.mKey.ky') ^= 'VAR' then
dCh = mAddKy(dst, ky, m.sCh)
else
dCh = mAddK1(dst, ky, m.sCh)
end
call mAddTree dCh, sCh
end
return dst
endProcedure mAddTree
/*--- show from one node everything that is defined) -----------------*/
mShowNd: procedure expose m.
parse arg m
pa = mPar(m)
t = 'node' m 'pa='pa
if symbol('m.m') == 'VAR' then
t = t 'va='m.m
if symbol('m.m.0') == 'VAR' then
t = t 'size='m.m.0
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
t = t 'ky='ky
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t = t 'index='m.mIndex.pa.mKey.ky
end
say t
return
endProcedure mShowNd
/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg m, lv
if lv = '' then
lv = 0
t = left('', lv)m
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
pa = mPar(m)
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t= t ky '>'
else
t= t ky '='
end
say t strip(m.m, 't')
do cx=1 to mSize(m)
call mShow mAtSq(m, cx), lv+1
end
return
endProcedure treeShow
/* copy m end *********************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
err:
call errA arg(1), 1
endSubroutine err
end call should define err
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
/* 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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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
m.dsnAlloc.dsn = ''
if left(spec, 1) = '=' then
return strip(substr(spec, 1))
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 to 3
w = word(spec, wx)
if w = '' then
leave
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if m.dsnAlloc.dsn = '' then
m.dsnAlloc.dsn = dsn2jcl(w, addPref)
else
leave
end
if dd = '' then
dd = 'DD' || mIncD(ADRTSO.ddCnt)
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if m.dsnAlloc.dsn <> '' then
disp = disp "dsn('"m.dsnAlloc.dsn"')"
call adrTso 'alloc dd('dd')' disp subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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 ****************************************************/
}¢--- A540769.WK.REXX.O08(SAY) cre=2008-04-14 mod=2008-04-14-15.16.11 F540769 ---
say 'hier say'
}¢--- A540769.WK.REXX.O08(SCAN) cre=2007-03-26 mod=2008-10-28-11.30.08 F540769 ---
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanRead??(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.m.tok ==> last token
m.m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.m.pos ==> scan position
m.m.src ==> scan source
***********************************************************************/
scanIni: procedure expose m.
if m.scan.ini == 1 then
return
m.scan.ini = 1
m.scan.alfLC = 'abcdefghijklmnopqrstuvwxyz'
m.scan.alfUC = translate(m.scan.alfLC)
m.scan.alfa = m.scan.alfLC || m.scan.alfUC
m.scan.alfNum = m.scan.alfa || '0123456789'
return
endProcedure scanIni
scanReset: procedure expose m.
parse arg m, n1, np, co
m.m.tok = ''
m.m.val = ''
m.m.key = ''
m.m.read = ''
return scanOpts(m, n1, np, co)
endProcedure scanReset
scanOpts: procedure expose m.
parse arg m, m.m.scanName1, namePlus, m.m.scanComment
call scanIni
if m.m.scanName1 == '' then
m.m.scanName1 = m.scan.alfa
if namePlus == '' then
m.m.scanNameR = m.m.scanName1 || '0123456789'
else
m.m.scanNameR = m.m.scanName1 || namePlus
return m
endProcedure scanReset
/*--- begin scanning a single line -----------------------------------*/
scanSrc: procedure expose m.
parse arg m, m.m.src
m.m.atEnd = 1
m.m.pos = 1
return m
endProcedure scanSrc
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
if len == '' then
return substr(m.m.src, m.m.pos)
else
return substr(m.m.src, m.m.pos,
, min(len, 1 + length(m.m.src) - m.m.pos))
endProcedure scanLook
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m
do ax=2 to arg()
if abbrev(substr(m.m.src, m.m.pos), arg(ax)) then do
m.m.tok = arg(ax)
m.m.pos = m.m.pos + length(arg(ax))
return 1
end
end
m.m.tok = ''
return 0
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.m.src)
if len ^= '' then
nx = min(m.m.pos + len, nx)
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanChar
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, prefs
m.m.tok = ''
bx = m.m.pos
if prefs = '' then do
qu = substr(m.m.src, bx, 1)
if pos(qu, "'""") < 1 then
return 0
ax = bx + 1
end
else do
do px=1 until abbrev(substr(m.m.src, bx), p1)
p1 = word(prefs, px)
if p1 = '' then
return 0
end
qu = right(p1, 1)
ax = bx + length(p1)
end
m.m.val = ''
do forever
qx = pos(qu, m.m.src, ax)
if qx < 1 then
return scanErr(m, 'ending Apostroph('qu') missing')
m.m.val = m.m.val || substr(m.m.src, ax, qx-ax)
if qx >= length(m.m.src) then
leave
else if substr(m.m.src, qx+1, 1) <> qu then
leave
ax = qx+2
m.m.val = m.m.val || qu
end
m.m.tok = substr(m.m.src, bx, qx+1-bx)
m.m.pos = qx+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.scanName1, rest in *.scanNameR ----*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.m.src, m.m.pos, 1),
, m.m.scanName1) <= 0 then do
m.m.tok = ''
return 0
end
return scanVerify(m, m.m.scanNameR)
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.m.src, alpha, , m.m.pos)
else
nx = verify(m.m.src, alpha, vOpt, m.m.pos)
if nx = 0 then
nx = length(m.m.src) + 1
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
scanNat: procedure expose m.
parse arg m, chEn
if ^ scanVerify(m, '0123456789') then
return 0
if chEn^==0 & pos(substr(m.m.src, m.m.pos,1), m.m.scanNameR)>0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
scanInt: procedure expose m.
parse arg m, chEn
if scanNat(m, chEn) then
return 1
ox = m.scan.m.pos
if pos(substr(m.scan.m.src, ox, 1) , '+-') < 1 then
return 0
m.scan.m.pos = ox + 1
if | scanNat(m) then do
m.scan.m.pos = ox
return 0
end
m.tok =substr(m.scan.m.src, ox, 1)|| m.tok
return 1
endProcedure scanInt
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m) then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.m.val = m.m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.m.pos - length(tok)
if substr(m.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.m.key = m.m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.m.val = def
m.m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.m.key '=')
return 1
endProcedure scanKeyValue
scanAtEnd: procedure expose m.
parse arg m
return m.m.atEnd & m.m.pos > length(m.m.src)
endProcedure scanAtEnd
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.m.tok
if m.m.read ^== '' then
interpret 'res = ' oObjMethod(m, 'scanSpaceNl')
else
res = scanSpaceCom(m)
m.m.tok = lastTok
return res
endProcedure scanSpaceNL
scanSpaceCom: procedure expose m.
parse arg m
res = scanVerify(m, ' ')
if m.m.scanComment ^== '' then
if abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
m.m.pos = 1 + length(m.m.src)
return 1
end
return res
endProcedure scanSpaceCom
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
m.m.err.0 = 0
call err 'scanErr' txt'\n'scanInfo(m, m'.ERR')
return 0
endProcedure scanErr
scanPos: procedure expose m.
parse arg m
if m.m.read ^== '' then
interpret 'return' oObjMethod(m, 'scanPos')
else if scanAtEnd(m) then
return E
else
return 1 m.m.pos
endProcedure scanPos
scanInfo: procedure expose m.
parse arg m
msg = 'last token' m.m.tok 'scanPosition' ,
strip(left(substr(m.m.src, m.m.pos), 40), 't')
if m.m.read == '' then
return msg'\npos' m.m.Pos 'in string' strip(m.m.src, 't')
else
interpret 'return msg"\n" ||' oObjMethod(m, 'scanInfo')
endProcedure scanInfo
/* copy scan end ****************************************************/
}¢--- A540769.WK.REXX.O08(SCANOLD) cre=2007-07-06 mod=2007-07-06-19.12.25 F540769 ---
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanReader(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
m.scan.m.pos = 1
call scanInit m
return m
endProcedure scanLine
/*--- switch to next line if atEnd of line or unCond=1 ---------------*/
scanNL: procedure expose m.
parse arg m, unCond
if m.scan.m.reading then do
interpret m.scan.m.scanNl
end
else do
np = 1 + length(m.scan.m.src)
if np <= m.scan.m.pos then
return 0
if unCond == 1 then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' ,
& abbrev(m.scan.m.src, m.scan.m.comment) then nop
else
return 0
m.scan.m.pos = np
return 1
end
endProcedure scanNL
scanAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.reading then
interpret m.scan.m.scanAtEnd
else
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEnd
/*--- initialize scanner for m --------------------------------------*/
scanInit: procedure expose m.
parse arg m, rdng
m.scan.m.reading = rdng == 1
m.tok = ''
m.val = ''
m.key = ''
if symbol('m.scan.m.name') ^== 'VAR' then do
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
end
return
endProcedure scanInit
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
call scanInit m
m.scan.m.comment = comm
if nameOne ^== '' then do
m.scan.m.Name1 = nameOne
m.scan.m.name = m.scan.m.name1 || '0123456789'
end
if namePlus ^== '' then
m.scan.m.name = m.scan.m.name1 || namePlus
return
endProcedure scanOptions
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
return substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
m.tok = scanLook(m, len)
m.scan.m.pos = m.scan.m.pos + length(m.tok)
return length(m.tok) > 0
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
ScanNat: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
scanLinePos: procedure expose m.
parse arg m
interpret 'return' m.scan.m.scanLinePos
endProcedure scanLinePos
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok 'scanPosition' ,
strip(left(substr(m.scan.m.src, m.scan.m.pos), 40), 't')
if m.scan.m.reading then
say scanLinePos(m)
else
say ' pos' m.scan.m.Pos 'in string' strip(m.scan.m.src, 't')
call err 'scanErr' txt
return
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
res = 0
do forever
if scanVerify(m, ' ') then nop
else if ^ scanNL(m) then leave
res = 1
end
m.tok = lastTok
return res
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- begin scanning the lines of a reader ---------------------------*/
scanReader: procedure expose m.
parse arg m, m.scan.m.rdr
call scanInit m, 1
m.scan.m.atEnd = 0
m.scan.m.lineX = 0
m.scan.m.scanNl = 'return scanReaderNl(m, unCond)'
m.scan.m.scanAtEnd = 'return scanReaderAtEnd(m, what)'
m.scan.m.scanLinePos = "scanReaderLinePos(m)"
call scanReaderNl m, 1
return m
endProcedure scanReader
/*--- return true/false whether we are at the end of line / reader ---*/
scanReaderAtEnd: procedure expose m.
parse arg m, what
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if what == 'l' then
return 1
return m.scan.m.atEnd
endProcedure scanReaderAtEnd
scanReaderNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then nop
else if unCond ^= 2 & m.scan.m.pos > length(m.scan.m.src) then nop
else if unCond ^= 0 & m.scan.m.comment ^== '' & abbrev(substr( ,
m.scan.m.src, m.scan.m.pos), m.scan.m.comment) then nop
else
return 0
if m.scan.m.atEnd then
return 0
m.scan.m.atEnd = ^ jRead(m.scan.m.rdr, 'SCAN.'m'.SRC')
if m.scan.m.atEnd then do
m.scan.m.pos = 1 + length(m.scan.m.src)
end
else do
m.scan.m.pos = 1
m.scan.m.lineX = m.scan.m.lineX + 1
end
return ^ m.scan.m.atEnd
endProcedure scanReaderNL
scanReaderLinePos: procedure expose m.
parse arg m
if m.scan.m.atEnd then
qq = 'atEnd after'
else
qq = 'pos' m.scan.m.pos 'in'
return qq 'line' m.scan.m.lineX':' strip(m.scan.m.src, 't')
endProcedure scanReaderLinePos
/* copy scan end ****************************************************/
}¢--- A540769.WK.REXX.O08(SCANREAD) cre=2008-02-21 mod=2008-06-16-16.54.39 F540769 ---
/* copy scanRead begin ************************************************/
scanReadIni: procedure expose m.
if m.scanRead.ini = 1 then
return
m.scanRead.ini = 1 then
call scanIni
call jIni
call oDecMethods oNewClass('ScanRead'),
, 'scanReadNl return scanReadNlImpl(m, unCond)',
, 'scanSpaceNl scanReadSpaceNl(m)',
, 'scanClose call scanReadClose m ',
, 'scanInfo scanReadInfo(m)',
, 'scanPos scanReadPos(m)'
return
endProcedure scanReadIni
/*--- begin scanning the lines of a reader ---------------------------*/
scanRead: procedure expose m.
parse arg rdr, n1, np, co
return scanReadReset(oNew('ScanRead'), rdr , n1, np, co)
scanReadReset: procedure expose m.
parse arg m, rdr, n1, np, co
call scanReset m, n1, np, co
m.m.atEnd = 0
m.m.lineX = 0
m.m.read = rdr
call jOpen rdr, 'r'
call scanReadNl m, 1
return m
endProcedure scanRead
scanClose: procedure expose m.
parse arg m
interpret oObjMethod(m, 'scanClose')
return
scanReadClose: procedure expose m.
parse arg m
call jClose m.m.read
return
scanReadNl: procedure expose m.
parse arg m, unCond
interpret oObjMethod(m, 'scanReadNl')
endProcedure scanReadNl
/*--- return true/false whether we are at the end of line / reader ---*/
scanReadNLimpl: procedure expose m.
parse arg m, unCond
if unCond ^== 1 then
if m.m.pos <= length(m.m.src) then
return 0
if m.m.atEnd then
return 0
m.m.atEnd = ^ jRead(m.m.read, m'.SRC')
if m.m.atEnd then do
m.m.pos = 1 + length(m.m.src)
end
else do
m.m.pos = 1
m.m.lineX = m.m.lineX + 1
end
return ^ m.m.atEnd
endProcedure scanReadNLimpl
scanReadSpaceNl: procedure expose m.
parse arg m
fnd = 0
do forever
if scanSpaceCom(m) then
fnd = 1
if ^ scanReadNl(m) then
return fnd
fnd = 1
end
endProcedure scanReadSpaceNl
scanReadPos: procedure expose m.
parse arg m, msg
if scanAtEnd(m) then
return E
else
return m.m.lineX m.m.pos
endProcedure scanReadPos
scanReadInfo: procedure expose m.
parse arg m, msg
if scanAtEnd(m) then
msg = msg'\natEnd after'
else
msg = msg'\npos' m.m.pos 'in'
return msg 'line' m.m.lineX':' strip(m.m.src, 't')
endProcedure scanReadInfo
/* copy scanRead end **************************************************/
}¢--- A540769.WK.REXX.O08(SCANSQL) cre=2008-09-15 mod=2008-10-28-13.03.31 F540769 ---
/* copy scanSql begin *************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanSql: procedure expose m.
parse arg inRdr
return scanSqlReset(scanWin(inRdr), inRdr)
scanSqlReset: procedure expose m.
parse arg m, rdr, scanWin
if scanWin ^== 0 then
call scanWinReset m, rdr, 5, 2, 1, 72
else
m.m.read = rdr
return scanOpts(m, , '0123456789_' , '--')
scanSqlSeekId: procedure expose m.
parse arg m, lx, cmd, opts
if opts = '' then
opts = word
if adrEdit("cursor =" max(trunc(lx), 1), 12) = 12 then
return -1
do while adrEdit("seek" cmd opts, 4) = 0 /* find each command*/
call adrEdit "(fx) = cursor"
if m.debug then do
call adrEdit "(LI) = LINE" fx
call debug 'scanSqlSeekId after' lx 'found' cmd 'at' fx li
end
call editReadReset m.m.read, fx
call scanWinOpen es, fx
do while word(scanPos(m), 1) <= fx & scanSqlType(m)
if m.m.sqlType = 'i' & m.m.val == cmd then
return fx
end
end
return -1
endProcedure scanSqlSeekId
/*--- scan a sql token put type in m.sqltype:
'i': ordinary identifier e.g. Name
'd': delimited identifier e.g. "Delimited"
'q': qualified identifier e.g. abc."efg"
'u': integer units e.g. 8G
'n': number e.g. -234
's': string e.g. 'abc''ef'
'' : at end
: any other character e.g. ;
----------------------------------------------------------------*/
scanSqlType: procedure expose m.
parse arg m, retSpace
m.m.val = ''
if scanSpaceNl(m) & retSpace = 1 then do
m.m.sqlType = 'b'
return 1
end
c2 = scanLook(m ,2)
if scanString(m, "' x' X'") then do
m.m.sqlType = 's'
if ^abbrev(m.m.tok, "'") then
m.m.val = x2c(m.m.val)
end
else if scanSqlQuId(m) then do
if m.m.val.0 > 1 then
m.m.sqlType = 'q'
else if abbrev(m.m.tok, '"') then
m.m.sqlType = 'd'
else
m.m.sqlType = 'i'
end
else if scanSqlNum(m, 0, 1) then
m.m.sqlType = 'n'
else if scanChar(m, 1) then
m.m.sqlType = m.m.tok
else if scanAtEnd(m) then do
m.m.sqlType = ''
return 0
end
else
call scanErr m, 'cannot scan sql'
return 1
endProcedure scanSqlType
scanSqlSkipBrackets: procedure expose m.
parse arg m, br
if br ^== '' then
nop
else if scanLit(m, '(') then
br = 1
else
return 0
do while scanSqlType(m) & m.m.sqlType ^== ';'
if m.m.sqlType = '(' then br = br + 1
else if m.m.sqlType ^== ')' then iterate
else if br > 1 then br = br - 1
else return 1
end
call scanErr m, '; or eof, but' br 'closing ) expected'
endProcedure skipBrackets
/*--- scan an ordinary sql identifier e.g. abc, ef_12 ----------------*/
scanSqlId: procedure expose m.
parse arg m
if ^ scanName(m) then
return 0
m.m.val = translate(m.m.tok)
return 1
endProcedure scanSqlId
/*--- scan a delimited or ordinay sql identifier ---------------------*/
scanSqlDeId: procedure expose m.
parse arg m
if scanSqlId(m) then
return 1
if ^ scanString(m, '"') then
return 0
m.m.val = strip(m.m.val, 't')
return 1
endProcedure scanSqlDeId
/*--- scan a qualified sql identifier --------------------------------*/
scanSqlQuId: procedure expose m.
parse arg m
res = ''
rto = ''
do qx=1
if ^ scanSqlDeId(m) then do
if qx <> 1 then
call scanErr m, 'id expected after .'
return 0
end
m.m.val.qx = m.m.val
res = res'.'m.m.val
rto = rto'.'m.m.tok
if ^ scanLit(scanSkip(m), '.') then
leave
call scanSpaceNl m
end
m.m.val.0 = qx
m.m.val = substr(res, 2)
m.m.tok = substr(rto, 2)
return 1
endProcedure scanSqlQuId
/*--- scan a sql number ----------------------------------------------*/
scanSqlNum: procedure expose m.
parse arg m, checkEnd, noSp
n = ''
if scanLit(m, '+', '-') then do
n = m.m.tok
if noSp <> 1 then
call scanSpaceNl m
end
if scanLit(m, '.') then
n = n'.'
if scanVerify(m, '0123456789') then
n = n || m.m.tok
else if n == '' then
return 0
else if noSp = 1 then do
call scanBack m, n
return 0
end
else
call scanErr m, 'scanSqlNum bad number: no digits after' n
if pos('.', n) < 1 then
if scanLit(m, '.') then do
if scanVerify(m, '0123456789') then
n = n'.'m.m.tok
end
if scanLit(m, 'E', 'e') then do
n = n'E'
if scanLit(m, '+', '-') then
n = n || m.m.tok
if ^ scanVerify(m, '0123456789') then
call scanErr m, 'scanSqlNum bad number: no digits after' n
n = n || m.m.tok
end
if checkEnd ^= 0 then
if pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNum number' n 'bad end' ,
scanLook(m, 1)
m.m.val = n
return 1
endProcedure scanSqlNum
/*--- scan a sql number with a unit which may follow without space ---*/
scanSqlNumUnit: procedure expose m.
parse arg m, both, units
if ^ scanSqlNum(m, 0) then
return 0
nu = m.m.val
sp = scanSpaceNl(m)
if scanSqlId(m) then do
if units == '' | wordpos(m.m.val, units) > 0 then
nu = nu m.m.val
else if both | ^ sp then
call scanErr m, 'scanSqlNumUnit after' nu 'bad unit' m.m.val
else
call scanBack m, m.m.tok
end
else if both then
call scanErr m, 'scanSqlNumUnit no unit after' nu
else if ^sp & pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNumUnit bad number end after' nu
m.m.val = nu
return 1
endProcedure scanSqlNumUnit
/* copy scanSql end *************************************************/
}¢--- A540769.WK.REXX.O08(SCANUTIL) cre=2007-01-12 mod=2008-10-28-11.40.48 F540769 ---
/* copy scanUtil begin *************************************************
scan db2 utility input statements using scan and a reader
**********************************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanUtilReader: procedure expose m.
parse arg m, inRdr
call scanReader m, inRdr
call scanOptions sc, , , '--'
call scanUtilReset m
return m
endProcedure scanUtilReader
scanUtilSql: procedure expose m.
parse arg inRdr
m = scanSql(inRdr)
call scanUtilReset m
return m
endProcedure scanUtilReader
scanUtilReset: procedure expose m.
parse arg m
m.m.utilBrackets = 0
m.scanUtil = 'BACKUP CATENFM CATMAINT CHECK' ,
'COPY COPYTOCOPY DIAGNOSE EXEC LISTDEF LOAD' ,
'MERGECOPY MODIFY OPTIONS QUIESCE REBUILD' ,
'RECOVER REORG REPAIR REPORT RESTORE' ,
'RUNSTATS STOSPACE TEMPLATE UNLOAD'
return
endProcedure scanUtilReset
/*--- scan next token and put its type in m.sc.utilType:
'u' a utility name
'n' a name
'"' a quoted name
"'" an apostroph'd string
'.' a .
',' a ,
'v' a value
'' at end
---------------------------------------------------------------*/
scanUtil: procedure expose m.
parse arg sc
m.sc.utilSpace = scanSpaceNl(sc)
ty = '?'
if scanLit(sc, '(') then do
m.sc.utilBrackets = m.sc.utilBrackets + 1
end
else if scanLIT(sc, ')') then do
m.sc.utilBrackets = m.sc.utilBrackets - 1
if m.sc.utilBrackets < 0 then
call scanErr sc, 'unmatched closing bracket )'
end
else if scanLit(sc, ',') then do
end
else if scanLit(sc, '.') then do
end
else if scanString(sc, "'") then do
end
else if scanString(sc, '"') then do
end
else if scanName(sc) then do
m.sc.val = translate(m.sc.tok)
if m.sc.utilBrackets > 0 then
ty = 'n'
else if 0 < wordPos(m.sc.val, m.scanUtil) then
ty = 'u'
else
ty = 'n'
end
else if scanVerify(sc, ' (),''"', 'm') then do
ty = 'v'
m.sc.val = translate(m.sc.tok)
end
else if ^scanAtEnd(sc) then do
call scanErr sc, 'scanUtil stopped before end'
end
else do
/* say 'scanUtil return atEnd' */
ty = ''
m.sc.val = ''
end
if ty == '?' then
m.sc.utilType = left(m.sc.tok, 1)
else
m.sc.utilType = ty
return m.sc.utilType
endProcedure scanUtil
/*--- scan a value or a bracketed list of values ---------------------*/
scanUtilValue: procedure expose m.
parse arg sc, remApo, nl
if remApo = '' | rempApo = 0 then
remApo = "nv"
else if rempApo = 1 then
remApo = "nv'"
if '(' ^== scanUtil(sc) then
return scanUtilValueOne(sc, remApo)
v = ''
brx = m.sc.utilBrackets
oLine = word(scanPos(sc), 1)
do forever
call scanUtil sc
one = scanUtilValueOne(sc, remApo)
if one == '' then
call scanErr sc, 'eof in brackets'
else if brx > m.sc.utilBrackets then
return v
nLine = word(scanPos(sc), 1)
if ^ m.sc.utilSpace then
v = v || one
else if nl ^== '' & oLine <> nLine then
v = v || nl || one
else
v = v' 'one
oLine = nLine
end
endProcedure scanUtilValue
scanUtilValueOne: procedure expose m.
parse arg sc, valTy
if m.sc.utilType == '' then
return ''
else if m.sc.utilType == 'u' then
call scanErr sc, 'util in scanUtilValueOne'
if pos(m.sc.utilType, valTy) > 0 then
return m.sc.val
else
return m.sc.tok
endProcedure scanUtilValueOne
/* copy scanUtil end **************************************************/
}¢--- A540769.WK.REXX.O08(SCANWIN) cre=2008-09-15 mod=2008-10-28-13.05.32 F540769 ---
/* copy scanWin begin *************************************************
scan the the concatenation of the lines of a reader
any token my be split over several line
except the end-of-line-comment-token
***********************************************************************/
scanWinIni: procedure expose m.
if m.scanWin.ini = 1 then
return
m.scanWin.ini = 1
call scanIni
call jIni
call oDecMethods oNewClass('ScanWin'),
, 'scanReadNl return scanWinNl(m, unCond)',
, 'scanSpaceNl scanWinSpaceNl(m)',
, 'scanClose call scanWinClose m ',
, 'scanInfo scanWinInfo(m)',
, 'scanPos scanWinPos(m)'
return
endProcedure scanReadIni
/*--- instanciate a new window scanner, open rdr ---------------------*/
scanWin: procedure expose m.
parse arg rdr, wiSz, wiBa, cuPo, cuLe
return scanWinReset(oNew('ScanWin'), rdr, wiSz, wiBa, cuPo, cuLe)
/*--- set the attributes of window scanner m, open rdr and start read*/
scanWinReset: procedure expose m.
parse arg m, rdr, wiSz, wiGa, cuPo, cuLe
call scanReset m
m.m.read = rdr
m.m.atEnd = 'still closed'
return scanWinOpts(m, wiSz, wiGa, cuPo, cuLe)
endProcedure scanWinReset
scanWinOpts: procedure expose m.
parse arg m, wiSz, wiGa, cuPo, cuLe
wiSz = word(wiSz 5, 1)
wiGa = word(wiGa 1, 1)
m.m.cutPos = word(cuPo 1, 1)
m.m.cutLen = word(cuLe 72, 1)
m.m.winTot = (wiSz * 2 + wiGa) * m.m.cutLen
m.m.posLim = (wiSz + wiGa) * m.m.cutLen
m.m.posOff = wiGa * m.m.cutLen
return scanWinOpen(m)
endProcedure scanWinReset
scanWinOpen: procedure expose m.
parse arg m, lx
m.m.atEnd = 0
if lx = '' then
m.m.lineX = 1
else
m.m.lineX = lx
m.m.pos = 1
m.m.src = ''
call jOpen m.m.read, 'r'
call scanWinRead m
return m
endProcedure scanWinOpen
scanWinClose: procedure expose m.
m.m.atEnd = 'still closed'
call jClose m.m.read
return
endProcedure scanWinClose
/*--- move the source window: cut left side and append at right side
return number of characters cut at left ------------------------*/
scanWinRead: procedure expose m.
parse arg m
dlt = 0
if m.m.atEnd then
return 0
if m.m.pos >= m.m.posLim then do /* cut left side */
dlt = m.m.pos - (m.m.pos // m.m.cutLen + m.m.posOff)
m.m.src = substr(m.m.src, dlt+1)
m.m.pos = m.m.pos - dlt
m.m.lineX = m.m.lineX + dlt % m.m.cutLen
end
do while length(m.m.src) < m.m.winTot /* read and fill to len */
if ^ jRead(m.m.read, m'.'one) then do
m.m.atEnd = 1
return dlt
end
m.m.src = m.m.src || substr(m.m.one, m.m.cutPos, m.m.cutLen)
end
call assert 'length(m.m.src) = m.m.winTot'
return dlt
endProcedure scanWinRead
/*--- return position of next line start -----------------------------*/
scanWinNLPos: procedure expose m.
parse arg m
return m.m.pos + m.m.cutLen - ((m.m.pos - 1) // m.m.cutLen)
/*--- scan over spaces and comments ----------------------------------*/
scanWinSpaceNL: procedure expose m.
parse arg m
res = 0
do forever
r1 = 0
if scanVerify(m, ' ') then do
r1 = 1
end
else if m.m.scanComment ^== '' ,
& abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
np = scanWinNlPos(m)
r1 = length(m.m.scanComment) <= np - m.m.pos
if r1 then
m.m.pos = np
end
if r1 then
res = 1
else if scanWinRead(m) = 0 then
return res
end
endProcedure scanWinSpaceNl
/*--- return current position in input ------------------------------*/
scanWinPos: procedure expose m.
parse arg m
if scanAtEnd(m) then
return 'E'
else
ps = m.m.pos - 1
return (m.m.lineX + (ps % m.m.cutLen)) (ps // m.m.cutLen + 1)
endProcedure scanWinPos
/*--- return a description of the current scan position --------------*/
scanWinInfo: procedure expose m.
parse arg m
p = scanWinPos(m)
if p == 'E' then do
res = 'atEnd after'
p = m.m.lineX - 1 + length(m.m.src) % m.m.cutLen
end
else do
res = 'pos' word(p, 2) 'in'
p = word(p, 1)
end
return res 'line' p':' strip(substr(m.m.src,
, 1 + (p - m.m.lineX) * m.m.cutLen, m.m.cutLen), 't')
endProcedure scanWinInfo
/* copy scanWin end *************************************************/
}¢--- A540769.WK.REXX.O08(SCAN0) cre=2007-02-19 mod=2007-02-19-10.02.02 F540769 ---
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line
scanStem(m,ln) : begin scanning all lines in a stem
scanAtEOL(m) : returns whether we reached end of line
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
scanNat(m) : scan a natural (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
call scanStart m
return
endProcedure scanLine
/*--- begin scanning the lines of a stem -----------------------------*/
scanReader: procedure expose m.
parse arg m, inRdr
call scanStart m, inRdr
m.scan.m.src = ''
m.scan.m.atEnd = ^ scanNL(m, 1)
return m
endProcedure scanReader
/*--- switch to next line if atEOF or argument unCond=1 --------------*/
scanNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then
m.scan.m.pos = 1 + length(m.scan.m.src)
else if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 0
else if ^ jRead(m.scan.m.reader, 'SCAN.'m'.SRC') then do
m.scan.m.atEnd = 1
return 0
end
m.scan.m.pos = 1
m.scan.m.tok = ''
return 1
endProcedure scanNL
/*--- initialize scanner for m --------------------------------------*/
scanStart: procedure expose m.
parse arg m, m.scan.m.reader
m.scan.m.pos = 1
m.tok = ''
m.val = ''
m.key = ''
if symbol('m.scan.m.Name') ^== 'VAR' then do
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
end
return
endProcedure scanStart
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanStart m
if nameOne ^== '' then
m.scan.m.Name1 = nameOne
if nameOne ^= '' | namePlus ^== '' then
m.scan.m.name = m.scan.m.name1 || namePlus
m.scan.m.comment = comm
return
endProcedure scanBegin
/*--- return true/false whether we are at the end of the line --------*/
scanAtEOL: procedure expose m.
parse arg m
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEOL
/*--- return true/false whether we are at the end of the input -------*/
scanAtEnd: procedure expose m.
parse arg m
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 1
else
return m.scan.m.atEnd
endProcedure scanAtEnd
/*--- scan len characters --------------------------------------------*/
scanLook: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
return substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
endProcedure scanLit
scanChar: procedure expose m.
parse arg m, len
m.tok = scanLook(m, len)
m.scan.m.pos = m.scan.m.pos + length(m.tok)
return length(m.tok) > 0
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a number --------------------------------------------------*/
scanNat: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure scanNat
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into *.key and word into val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(scanSkip(m)) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok
say ' charPos' m.scan.m.Pos':',
strip(substr(m.scan.m.src, m.scan.m.Pos), 't')
say ' in line:' strip(m.scan.m.src, 't')
call err 'scanErr' txt
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
m.val = 0
cc = m.scan.m.comment
do forever
if scanVerify(m, ' ') then nop
else if scanNL(m) then nop
else if cc == '' then leave
else if ^ scanLit(m, cc) then leave
else if ^scanNL(m, 1) then leave
m.val = 1
end
m.tok = lastTok
return m
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/* copy scan end ****************************************************/
}¢--- A540769.WK.REXX.O08(SCAN1) cre=2006-09-28 mod=2006-09-28-15.25.01 F540769 ---
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line
scanStem(m,ln) : begin scanning all lines in a stem
scanAtEOL(m) : returns whether we reached end of line
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
scanNum(m) : scan integer (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.tok ==> last token
m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.scan.m.pos ==> scan position
m.scan.m.src ==> scan source
***********************************************************************/
/*--- begin scanning a single line -----------------------------------*/
scanLine: procedure expose m.
parse arg m, m.scan.m.src
call scanStart m
return
endProcedure scanLine
/*--- begin scanning the lines of a stem -----------------------------*/
scanReader: procedure expose m.
parse arg m, inRdr
call scanStart m, inRdr
m.scan.m.src = ''
m.scan.m.atEnd = ^ scanNL(m, 1)
return m
endProcedure scanReader
/*--- switch to next line if atEOF or argument unCond=1 --------------*/
scanNL: procedure expose m.
parse arg m, unCond
if unCond == 1 then
m.scan.m.pos = 1 + length(m.scan.m.src)
else if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 0
else if ^ ooRead(m.scan.m.reader, 'SCAN.'m'.SRC') then do
m.scan.m.atEnd = 1
return 0
end
m.scan.m.pos = 1
m.scan.m.tok = ''
return 1
endProcedure scanNL
/*--- initialize scanner for m --------------------------------------*/
scanStart: procedure expose m.
parse arg m, m.scan.m.reader
m.scan.m.pos = 1
m.tok = ''
m.val = ''
m.key = ''
if symbol('m.scan.m.Name') ^== 'VAR' then do
m.scan.LC = 'abcdefghijklmnopqurstuvwxyz'
m.scan.UC = 'ABCDEFGHIJKLMNOPQURSTUVWXYZ'
m.scan.Alpha = m.scan.LC || m.scan.UC
m.scan.AlNum = '0123456789' || m.scan.ALPHA
m.scan.m.Name1 = m.scan.ALPHA
m.scan.m.Name = m.scan.ALNUM
m.scan.m.comment = ''
end
return
endProcedure scanStart
/*--- set options name characters, comment characters ----------------*/
scanOptions: procedure expose m.
parse arg m, nameOne, namePlus, comm
if symbol('m.scan.m.Name') ^== 'VAR' then
call scanStart
if nameOne ^== '' then do
m.scan.m.Name1 = nameOne
if namePlus = '' then
namePlus = '0123456789'
m.scan.m.name = nameOne || namePlus
end
m.scan.m.comment = comm
return
endProcedure scanBegin
/*--- return true/false whether we are at the end of the line --------*/
scanAtEOL: procedure expose m.
parse arg m
return m.scan.m.pos > length(m.scan.m.src)
endProcedure scanAtEOL
/*--- return true/false whether we are at the end of the input -------*/
scanAtEnd: procedure expose m.
parse arg m
if m.scan.m.pos <= length(m.scan.m.src) then
return 0
if m.scan.m.reader = '' then
return 1
else
return m.scan.m.atEnd
endProcedure scanAtEnd
/*--- scan len characters --------------------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.scan.m.src)
if len ^== '' then
if nx > m.scan.m.pos + len then
nx = m.scan.m.pos + len
m.tok = substr(m.scan.m.src, m.scan.m.pos, nx - m.scan.m.pos)
if nx = m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanChar
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
if ^ abbrev(substr(m.scan.m.src, m.scan.m.pos), lit) then
return 0
m.scan.m.pos = m.scan.m.pos + length(lit)
m.tok = lit
return 1
endProcedure scanLit
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.val = ''
if qu = '' then
qu = "'"
if substr(m.scan.m.src, m.scan.m.pos, 1) ^== qu then
return 0
bx = m.scan.m.pos
qx = m.scan.m.pos + 1
do forever
px = pos(qu, m.scan.m.src, qx)
if px < 1 then
call scanErr m, 'ending Apostroph('qu') missing'
m.val = m.val || substr(m.scan.m.src, qx, px-qx)
if px >= length(m.scan.m.src) then
leave
else if substr(m.scan.m.src, px+1, 1) <> qu then
leave
qx = px+2
m.val = m.val || qu
end
m.tok = substr(m.scan.m.src, bx, px+1-bx)
m.scan.m.pos = px+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.name1, rest in *.name -------------*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.scan.m.src, m.scan.m.pos, 1),
, m.scan.m.Name1) <= 0 then
return 0
bx = m.scan.m.pos
m.scan.m.pos = bx + 1
call scanVerify m, m.scan.m.Name
m.tok = substr(m.scan.m.src, bx, m.scan.m.pos - bx)
return 1
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.scan.m.src, alpha, , m.scan.m.pos)
else
nx = verify(m.scan.m.src, alpha, vOpt, m.scan.m.pos)
if nx = 0 then
nx = length(m.scan.m.src) + 1
m.tok = substr(m.scan.m.src, m.scan.m.Pos, nx - m.scan.m.Pos)
if nx <= m.scan.m.pos then
return 0
m.scan.m.pos = nx
return 1
endProcedure scanVerify
/*--- scan a number --------------------------------------------------*/
scanNum: procedure expose m.
parse arg m
if ^ scanVerify(m, '0123456789') then
return 0
else if pos(substr(m.scan.m.src, m.scan.m.pos, 1), m.scan.m.name1) ,
> 0 then
call scanErr m, 'illegal number end'
return 1
endProcedure scanNum
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m, "'") then return 1
if scanString(m, """") then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.val = m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.scan.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.scan.m.pos - length(tok)
if substr(m.scan.m.src, ix, length(tok) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.scan.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into *.key and word into val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(scanSkip(m)) then
return 0
m.key = m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.val = def
m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.key '=')
return 1
endProcedure scanKeyValue
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
say 'scanErr' txt
say ' last token' m.tok
say ' charPos' m.scan.m.Pos':',
strip(substr(m.scan.m.src, m.scan.m.Pos), 't')
say ' in line:' strip(m.scan.m.src, 't')
call err 'scanErr' txt
endProcedure scanErr
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.tok
res = 0
cc = m.scan.m.comment
do forever
if scanVerify(m, ' ') then nop
else if scanNL(m) then nop
else if cc == '' then leave
else if ^ scanLit(m, cc) then leave
else if ^scanNL(m, 1) then leave
res = 1
end
m.tok = lastTok
return res
endProcedure scanSpaceNL
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/* copy scan end ****************************************************/
}¢--- A540769.WK.REXX.O08(SENDJOB) cre=2008-09-04 mod=2008-12-16-17.23.49 F540769 ---
/* rexx ****************************************************************
send files, job and receceive outputs with CSM
node destNode set destination node
send fn send fn (filename or -dd)
job fn opt? cf mark send job from fn (filename or -dd),
communication file cf and mark mark
opt: leer or
123 timout secs (default 3600) or
//?? replace leading ?? by // or
123//?? timeout and replace
mark cf mark res mark communicationfile cf with mark mark
and result res (ok or errorMessage)
wait ti? cf mark wait with timeout ti secs (default 3600)
until communicationfile cf is marked ok
receive fn receive (filename or -dd)
************************************************************************
05.09.08 W. Keller neu
***********************************************************************/
parse arg args
call errReset 'h'
if args = '?' then /* no help for //?? || */
return help()
else if args = '' then do
if 1 then
return errHelp('no args')
args = 'node rz1 mark A540769.tmp.ganz.neu(eins) hier submit' ,
'node rr2' ,
'job A540769.WK.JCL(sendJobI) 9//?? ' ,
' A540769.tmp.e.d(sejoTest) sejoTest' ,
'receive A540769.TMP.TEXT(BBB)'
end
/* 'mark A540769.tmp.b.c(d) markMarjk ok',
'job A540769.WK.TEST(RUN) 13 A540769.tmp.b.c(cf) jobEins'
*/
defTimeOut = 3600
ax = 1
do forever
parse value subword(args, ax, 5) with w1 w2 w3 w4 w5 .
upper w1
em = w1 '(word' ax' in' space(args, 1)')'
if w1 = '' then
leave
if w2 = '' then
call errHelp 'argument missing for' em
if w1 = 'NODE' then do
m.node = w2
ax = ax + 2
end
else if m.node = '' then do
call errHelp 'first statement not NODE in' em
end
else if w1 = 'JOB' then do
cc = (datatype(w3, 'N') | pos('//', w3) > 0) + 4
ax = ax + cc
if value('w'cc) = '' then
call errHelp 'argument missing for' em
if cc = 5 & abbrev(w3, '//') then
w3 = defTimeOut || w3
if cc = 5 then
call job w2, w3, w4, w5
else
call job w2, defTimeOut, w3, w4
end
else if w1 = 'MARK' then do
if w4 = '' then
call errHelp 'argument missing for' em
call mark w2, w3, w4
ax = ax + 4
end
else if w1 = 'RECEIVE' then do
say 'copying' m.node'/'w2 'to */'w2
call csmCopy m.node'/'w2, '*/'w2
ax = ax + 2
end
else if w1 = 'SEND' then do
say 'copying' '*/'w2 'to' m.node'/'w2
call csmCopy '*/'w2, m.node'/'w2
ax = ax + 2
end
else if w1 = 'WAIT' then do
cc = datatype(w2, 'N')+3
ax = ax + cc
if value('w'cc) = '' then
call errHelp 'argument missing for' em
if datatype(w3, 'N') then
call wait w2, w3, w4
else
call wait defTimeOut, w2, w3
end
else do
call errHelp 'bad statement' em
end
end
exit
job: procedure expose m.
parse arg jo, tiOu '//' rep, cf, mark
sysl = csmSysDsn(m.node'/')
if sysl = '*/' then
sysl = ''
say 'job from' jo 'tiOu' tiOu 'communicationfile' cf 'mark' mark
call mark sysl || cf, mark, 'submit'
call readDsn jo, j.
if rep ^= '' then
do jx=1 to j.0
if abbrev(j.jx, rep) then
j.jx = '//'substr(j.jx, length(rep)+1)
end
call writeDsn sysl 'SYSOUT(T) dd(ir) .WRITER(INTRDR)', j.
call wait tiOu, cf, mark
return
endProcedure job
wait: procedure expose m.
parse arg tiOu, cf, mark
sysl = csmSysDsn(m.node'/')
if sysl = '*/' then
sysl = ''
cf = sysl || cf
tot = 0
info = 'job' mark 'on' cf
do dly=1 by 1
say time() 'after' tot 'secs, waiting for' info
call sleep min(dly, 60)
tot = tot + min(dly, 60)
call readDsn cf, j.
if j.0 ^== 1 then
call err 'communicationFile' cf 'has' j.0 'records not 1'
if ^ abbrev(j.1, mark' ') then
call err 'communicationFile' cf 'should start with' mark,
'not' strip(j.1, 't')
rst = strip(substr(j.1, length(mark)+2))' '
upper rst
if abbrev(rst, 'OK') then do
say time() 'after' tot 'secs' info 'ended ok:' strip(j.1)
return
end
if ^ abbrev(rst, 'SUBMIT') then
call err info 'ended with error' strip(j.1, 't')
else if tot >= tiOu then
call err info 'timed out after' tot 'secs'
end
return
endProcedure job
mark: procedure expose m.
parse arg cf, mark, res
o.1 = mark res
say 'mark communicationfile' cf 'with' o.1
call writeDsn cf '::F', o., 1, 1
return
endProcedure mark
sleep: procedure expose m.
parse arg secs, sayIt
if sayit <> 0 then
say 'sleeping' secs 'secs' time()
CALL SYSCALLS 'ON'
ADDRESS SYSCALL "sleep" secs
CALL SYSCALLS 'OFF'
if sayit <> 0 then
say 'slept' secs 'secs' time()
return
endProcedure sleep
/* copy csm begin ******************************************************
interface to csm,
it is integrate with adrTso, eg. dsnAlloc , 'RZ3/..' uses csm
***********************************************************************/
adrCsm:
return adrTso('csmExec' arg(1), arg(2))
endProcedure adrCsm
csmCopy: procedure expose m.
parse arg csnFr, csnTo, ggRet
if dsnGetMbr(csnTo) ^= '' ,
& dsnGetMbr(csnFr) <> dsnGetMbr(csnTo) then
call err 'member rename' csnFr 'to' csnTo
parse value csmSysDsn(csnFr) with sysFr '/' dsnFr
parse value csmSysDsn(csnTo) with sysTo '/' dsnTo
if sysFr = '*' & sysTo <> '*' then do
pdsTo = dsnSetMbr(dsnTo)
al = "SYSTEM("sysTo") DDNAME(COPYTo)",
"DATASET('"pdsTo"') DISP(SHR)"
alRes = dsnAlloc(systo'/'pdsTo, ,'COPYTO', '*')
if datatype(alRes, 'n') then do
/* wir müssen es selbst allozieren csmxUtil
vergisst management class ||||| */
say 'could not allocate' al
say 'trying to create'
rc = listDsi("'"dsnSetMbr(dsnFr)"' SMSINFO")
if rc ^= 0 then
call err 'listDsi rc' rc 'reason' sysReason,
sysMsgLvl1 sysMsgLvl2
al = left(al, length(al)-4)'CAT)'
if right(sysDsSms, 7) == 'LIBRARY' ,
| abbrev(sysDsSms, 'PDS') then
al = al 'DSNTYPE(LIBRARY)'
if sysUnits = 'TRACK' then
sysUnits = 'TRACKS'
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")",
"RECFM("sysREcFM") LRECL("SYSLRECL")",
"blksize("sysBLkSIZE")",
"SPACE("sysPrimary"," sysSeconds")" sysUnits
call adrCsm "allocate" al
end
call adrTso 'free dd(copyTo)'
end
c = "'COPY" sysFr"/''"dsnFr"'' TO" ,
sysTo"/''"dsnSetMbr(dsnTo)"'' REPLACE'"
return adrTso("exec 'CSM.DIV.P0.EXEC(CSRXUTIL)'" c , ggRet)
return
endProcedure csmCopy
csmAlloc: procedure expose m.
parse upper arg dd, disp, dsn, rest, nn, retRc
sys = ''
a2 = ''
parse value csmSysDsn(dsn) with sys '/' dsn
if disp = '' then
disp = 'shr'
al = "SYSTEM("sys") DDNAME("dd")"
if dsn <> '' then do
a2 = "DATASET('"dsnSetMbr(dsn)"')"
mbr = dsnGetMbr(dsn)
if mbr <> '' then
a2 = a2 'MEMBER('mbr')'
end
if abbrev(disp, 'SYSOUT(') then
a2 = a2 disp
else
a2 = a2 "DISP("disp")"
if retRc <> '' | nn = '' then do
alRc = adrCsm('allocate' al a2 rest, retRc)
if alRc <> 0 then
return alRc
return dd 'call adrTso "free dd('dd')";'
end
do retry=0 by 1
alRc = adrCsm('allocate' al a2 rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 then
leave
say 'csmAlloc rc' alRc 'for' al a2 rest '...trying to create'
nn = al 'disp(cat)' dsnCreateAtts(dsn, nn, 1)
call adrCsm 'allocate' nn
call adrTso 'free dd('dd')'
end
call err 'cmsAlloc rc' alRc 'for' al rest
endProcedure csmAlloc
csmSysDsn: procedure expose m.
parse upper arg dsn, withStar
if pos('/', dsn) < 1 then
sys = '*'
else
parse var dsn sys '/' dsn
if sys <> '' & sys <> '*' & sys <> sysvar(sysnode) then
return sys'/'dsn
else if withStar == 0 then
return dsn
else
return '*/'dsn
endProcedure csmSysDsn
/* copy csm 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 by 1
alRc = adrTso(c rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for' c rest
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
endProcedure tsoAlloc
dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
bl = 32760
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
recfm='f b'
bl = bl - (bl // rl)
end
else do
if rl = '' then
rl = bl-4
recfm = substr(atts, 2, 1) 'B'
end
end
if pos('(', dsn) > 0 then
po = 'dsntype(library) dsorg(po)'
else
po = ''
dsn = dsnSetMbr(dsn)
if forCsm == 1 then
return "dataset('"dsn"')" po,
"recfm("space(recfm, 0)") lrecl("rl") blkSize("bl")" ,
"mgmtclas(s005y000) space(10, 1000) cylinder"
else
return "dsn('"dsn"')" po,
"recfm("recfm") lrecl("rl") block("bl")" ,
"mgmtclas(s005y000) 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(SER) cre=2006-12-04 mod=2006-12-04-17.26.02 F540769 ---
/*REXX *****************************************************************
serialise a list of PDS or other Dataset to a single stream
! mit einem ! am Anfang
!! mit zwei ! am Anfang
!!! mit drei ! am Anfang
***********************************************************************/
call serCreate '~zzz.backup(d'right(date(s), 6)')', ,
'~ WK.JCL wk.msgs wk.panels wk.pli wk.rexx wk.rexx.old' ,
'WK.SQL'
exit
call serOpen s, '~wk.texv(serTst1)'
call serAddDsn s, 'wk.rexx(ser)~'
call serAddPds s, 'wk.text(v*)~'
call serAdd s, '~ wk.text(a*) wk.rexx(sv)'
call serClose s
exit
serCreate: procedure
parse arg dst, list
call serOpen qq, dst
call serAdd qq, list
call serClose qq
return
endProcedure serCreate
serOpen: procedure expose m.
parse arg m, dsnSpec
if m.ser.ini <> 1 then do
m.ser.ini = 1
m.ser.next = 0
end
if symbol('m.ser.m.id') <> 'VAR' then do
nx = m.ser.next + 1
m.ser.next = nx
m.ser.m.id = nx
end
m.ser.m.dsns = 0
m.ser.m.rds = 0
m.ser.m.wrts = 0
alc = dsnAlloc(dsnSpec, 'OLD', 'SERW'm.ser.m.id)
m.ser.m.dd = word(alc, 1)
m.ser.m.ddClose = subword(alc, 2)
call writeDDbegin m.ser.m.dd
return
endProcedure serOpen
serClose: procedure expose m.
parse arg m
call writeDDend m.ser.m.dd
interpret m.ser.m.ddClose
say 'serialised' m.ser.m.dsns 'datasets with' m.ser.m.rds 'reads' ,
'and' m.ser.m.wrts 'writes'
return
endProcedure serClose
serAddDsn: procedure expose m.
parse arg m, dsnSpec
alc = dsnAlloc(dsnSpec, 'SHR', 'SERR'm.ser.m.id)
inDD = word(alc, 1)
dsn = dsnSpecDsn(dsnSpec)
call readDDbegin inDD
r.1 = '!beg' dsn
call writeDD m.ser.m.dd, r., 1
c = 0
do while readDD(inDD, r.)
c = c + r.0
do i=1 to r.0
if left(r.i, 1) = '!' then
r.i = '!'r.i
end
call writeDD m.ser.m.dd, r.
end
r.1 = '!end' dsn
call writeDD m.ser.m.dd, r., 1
call readDDend inDD
interpret subword(alc, 2)
m.ser.m.dsns = m.ser.m.dsns + 1
m.ser.m.rds = m.ser.m.rds + c
m.ser.m.wrts = m.ser.m.wrts + c + 2
return
endProcedure serAddDsn
serAddPds: procedure expose m.
parse arg m, dsnSpec
dsn = dsnSpecDsn(dsnSpec)
id = lmmBegin(dsnSpec)
do mx=0 by 1
mbr = lmmNext(id)
if mbr = '' then
leave
d1 = dsnSetMbr(dsn, mbr)
call serAddDsn m, d1
end
call lmmEnd id
say mx 'members in' dsn
return
endProcedure serPds
serAdd: procedure expose m.
parse arg m, list
ap = ''
upper list
do wx=1 to words(list)
w = word(list, wx)
if w == '~' then do
ap = w
iterate
end
dsn = dsnSpecDsn(ap || w)
mbr = dsnGetMbr(dsn)
pds = dsnSetMbr(dsn)
lr = listDsi("'"pds"'")
if lr <> 0 then
call err "rc" lr "for listDsi('"pds"'):" sysReason
else if left(sysDsOrg, 2) = 'PS' & mbr = '' then
call serAddDsn m, ap || w
else if left(sysDsOrg, 2) = 'PO' then
call serAddPds m, ap || w
else
call err "bad sysDsOrg" sysDsOrg 'for' pds
end
return
endProcedure serAdd
serMap: procedure expose m.
parse arg dsn
pds = dsnSetMbr(dsn)
mbr = dsnGetMbr(dsn)
if m.ser.map.lastPds ^= pds then do
if symbol('m.ser.map.lastPds') == 'VAR' ,
& m.ser.map.lastPds ^== '' then
say m.ser.map.lastMbrs 'members from' m.ser.map.lastPds
m.ser.map.lastPds = pds
m.ser.map.lastMbrs = 0
end
m.ser.map.lastMbrs = m.ser.map.lastMbrs + 1
if mbr = '' then
mbr = dsnGetLev(pds, -1)
return "disp=shr dsn='''"dsn"'''"
return 'disp=shr dsn=wk.test('mbr')'
return ''
endProcedure serSave
serSave:
mbr = 'sv'translate(right(date('s'), 6), '0', ' ')
say 'mbr' mbr
call serialize 'zzz.serial('mbr')',
, "wk.clist wk.rexx wk.pli wk.jcl wk.pli wk.sql",
"wk.msgs wk.panels"
/* "zlib.* " */
return
endProcedure serSave
serIni:
parse arg serOutDsn
if m.ser.ini == 1 then
return
m.ser.ini = 1
m.ser.mark = '!'
m.ser.begin = 'begin'
m.ser.end = 'end'
m.ser.len = 10
return
serDesDS: procedure expose m.
parse arg dss, map
rx = readDS(wrNew(), dss)
call serDesReader rx, map
call reClose rx
call wrFree rx
return
endProcedure serDesDS
serDesReader: procedure expose m.
parse arg rx, map
call serIni
dsn = ''
ox = wrNew()
do while readLn(rx, li)
if abbrev(m.li, m.ser.mark) then do
rest = substr(m.li, 1 + length(m.ser.mark))
w2 = translate(word(rest, 2))
if abbrev(rest, m.ser.begin) then do
if dsn ^== '' then
call serErr rx, li, 'nested begin'
if w2 = '' then
call serErr rx, li, 'begin with empty dsngin'
dsn = w2
interpret map
writing = toDs ^= ''
if writing then
call wr2DS ox, toDs
iterate
end
else if abbrev(rest, m.ser.end) then do
if writing then
call wrClose ox
if dsn == '' then
call serErr rx, li, 'unpaired end'
if w2 ^== dsn then
call serErr rx, li, 'mismatched end for' dsn
dsn = ''
iterate
end
else if abbrev(rest, m.ser.mark) then do
m.li = rest
end
else do
call serErr rx, li, 'bad line'
end
end
if dsn == '' then
call serErr rx, li, 'data out of sequence'
if writing then
call writeLn ox, m.li
end
if dsn ^== '' then
call serErr rx, li, 'input ends without end'
dsn = ''
interpret map
call wrFree ox
return
endProcedure serDesReader
serErr: procedure expose m.
parse arg rx, li, msg
say '*** error' msg
say ' line ' m.li
say ' info ' readInfo(rx, '*')
call err msg
endProcedure serErr
serialize: procedure expose m.
parse upper arg toDsn, dsns
call serIni
wx = wr2DS(wrNew(), 'dsn='toDsn)
call outPush wx
call serLst dsns
call wrClose wx
call outPop
call wrFree wx
return
endProcedure serialize
serLst: procedure expose m.
parse upper arg dsns
px = piNew(2)
call piBegin px
call piDefine , "call lmx" quote(dsns)
call piBar
call piDefine ,, "call serDsn m.line"
call piEnd px
call wrClose px
call wrFree px
return
endProcedure serLst
serTst: procedure
return date(s) time()
endProcedure serTst
err:
call errA arg(1), 1
endSubroutine err
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = '~wk.pli(w*)'
else if dsn = '=' then do
ff = dsnAlloc('~wk.rexx',shr,abc)
dsn = '=abc'
end
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
if words(ff) > 1 then
interpret subword(ff, 2)
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
lmmBegin: procedure
parse arg dsnSpec
parse value dsnSpec(dsnSpec) with dd disp dsn .
if disp = '=' then do
pds = 'ddName('dd')'
mbr = ''
end
else do
mbr = dsnGetMbr(dsn)
pds = "dataset('"dsnSetMbr(dsn, )"')"
end
call adrIsp "LMINIT DATAID(lmmId)" 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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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 -------------------------------------------*/
dsnSpec: procedure
parse upper arg spec
dd = '-'
dsn = '-'
disp = '-'
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 by 1
w = word(spec, wx)
if left(spec, 1) = '=' then
return substr(spec, 2) '= -'
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if abbrev(w, 'DSN(') & dsn = '-' then
dsn = dsn2jcl(substr(w, 5, length(w)-5), addPref)
else if dsn = '-' & w <> '' then
dsn = dsn2jcl(w, addPref)
else
return dd disp dsn subword(spec, wx)
end
endProcedure dsnSpec
dsnSpecDsn: procedure
parse arg spec
parse value dsnSpec(spec) with dd disp dsn .
if dsn = '' then
call 'err listDsi for dsn="" not implemented yet'
return dsn
endProcedure dsnSpecDsn
dsnAlloc: procedure
parse upper arg spec, defDisp, defDD
parse value dsnSpec(spec) with dd disp dsn rest
if disp = '=' then
return dd
if dd = '-' then
DD = defDD
if dd = '' then
dd = 'DD' || ooNew()
if disp = '-' then
disp = defDisp
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if dsn <> '-' then
disp = disp "dsn('"dsn"')"
call adrTso 'alloc dd('dd')' disp rest
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(SERMS) cre=2007-04-25 mod=2007-08-31-14.27.29 F540769 ---
/*REXX *****************************************************************
serialise a list of PDS or other Dataset to a single stream
! mit einem ! am Anfang
!! mit zwei ! am Anfang
!!! mit drei ! am Anfang
***********************************************************************/
if 1 then do
call serCreate '~zzz.backup(pdsedit)',
, ORG.U0009.B0106.KIUT23.LOADLIB
end
else do
call serDesDs '~zzz.backup(martin)',
, "if left(dsn, 16) = 'DSN.A390880.TSO.' then" ,
"toDsn = 'A540769.tmpul.'substr(dsn, 17);" ,
"say dsn '==>' toDsn"
end
exit
call serOpen s, '~wk.texv(serTst1)'
call serAddDsn s, 'wk.rexx(ser)~'
call serAddPds s, 'wk.text(v*)~'
call serAdd s, '~ wk.text(a*) wk.rexx(sv)'
call serClose s
exit
serCreate: procedure
parse arg dst, list
call serOpen qq, dst
call serAdd qq, list
call serClose qq
return
endProcedure serCreate
serOpen: procedure expose m.
parse arg m, dsnSpec
if m.ser.ini <> 1 then do
m.ser.ini = 1
m.ser.next = 0
end
if symbol('m.ser.m.id') <> 'VAR' then do
nx = m.ser.next + 1
m.ser.next = nx
m.ser.m.id = nx
end
m.ser.m.dsns = 0
m.ser.m.rds = 0
m.ser.m.wrts = 0
alc = dsnAlloc(dsnSpec, 'OLD', 'SERW'm.ser.m.id)
m.ser.m.dd = word(alc, 1)
m.ser.m.ddClose = subword(alc, 2)
call writeDDbegin m.ser.m.dd
return
endProcedure serOpen
serClose: procedure expose m.
parse arg m
call writeDDend m.ser.m.dd
interpret m.ser.m.ddClose
say 'serialised' m.ser.m.dsns 'datasets with' m.ser.m.rds 'reads' ,
'and' m.ser.m.wrts 'writes'
return
endProcedure serClose
serAddDsn: procedure expose m.
parse arg m, dsnSpec
alc = dsnAlloc(dsnSpec, 'SHR', 'SERR'm.ser.m.id)
inDD = word(alc, 1)
dsn = dsnSpecDsn(dsnSpec)
call readDDbegin inDD
r.1 = '!beg' dsn
call writeDD m.ser.m.dd, r., 1
c = 0
do while readDD(inDD, r.)
c = c + r.0
do i=1 to r.0
if left(r.i, 1) = '!' then
r.i = '!'r.i
end
call writeDD m.ser.m.dd, r.
end
r.1 = '!end' dsn
call writeDD m.ser.m.dd, r., 1
call readDDend inDD
interpret subword(alc, 2)
m.ser.m.dsns = m.ser.m.dsns + 1
m.ser.m.rds = m.ser.m.rds + c
m.ser.m.wrts = m.ser.m.wrts + c + 2
return
endProcedure serAddDsn
serAddPds: procedure expose m.
parse arg m, dsnSpec
dsn = dsnSpecDsn(dsnSpec)
id = lmmBegin(dsnSpec)
do mx=0 by 1
mbr = lmmNext(id)
if mbr = '' then
leave
d1 = dsnSetMbr(dsn, mbr)
call serAddDsn m, d1
end
call lmmEnd id
say mx 'members in' dsn
return
endProcedure serPds
serAdd: procedure expose m.
parse arg m, list
ap = ''
upper list
do wx=1 to words(list)
w = word(list, wx)
if w == '~' then do
ap = w
iterate
end
dsn = dsnSpecDsn(ap || w)
mbr = dsnGetMbr(dsn)
pds = dsnSetMbr(dsn)
lr = listDsi("'"pds"'")
if lr <> 0 then
call err "rc" lr "for listDsi('"pds"'):" sysReason
else if left(sysDsOrg, 2) = 'PS' & mbr = '' then
call serAddDsn m, ap || w
else if left(sysDsOrg, 2) = 'PO' then
call serAddPds m, ap || w
else
call err "bad sysDsOrg" sysDsOrg 'for' pds
end
return
endProcedure serAdd
serMap: procedure expose m.
parse arg dsn
pds = dsnSetMbr(dsn)
mbr = dsnGetMbr(dsn)
if m.ser.map.lastPds ^= pds then do
if symbol('m.ser.map.lastPds') == 'VAR' ,
& m.ser.map.lastPds ^== '' then
say m.ser.map.lastMbrs 'members from' m.ser.map.lastPds
m.ser.map.lastPds = pds
m.ser.map.lastMbrs = 0
end
m.ser.map.lastMbrs = m.ser.map.lastMbrs + 1
if mbr = '' then
mbr = dsnGetLev(pds, -1)
return "disp=shr dsn='''"dsn"'''"
return 'disp=shr dsn=wk.test('mbr')'
return ''
endProcedure serSave
serSave:
mbr = 'sv'translate(right(date('s'), 6), '0', ' ')
say 'mbr' mbr
call serialize 'zzz.serial('mbr')',
, "wk.clist wk.rexx wk.pli wk.jcl wk.pli wk.sql",
"wk.msgs wk.panels"
/* "zlib.* " */
return
endProcedure serSave
serIni:
parse arg serOutDsn
if m.ser.ini == 1 then
return
m.ser.ini = 1
m.ser.mark = '!'
m.ser.begin = 'begin'
m.ser.end = 'end'
m.ser.len = 10
return
serDesDS: procedure expose m.
parse arg dss, map
rx = readDS(wrNew(), dss)
call serDesReader rx, map
call reClose rx
call wrFree rx
return
endProcedure serDesDS
serDesReader: procedure expose m.
parse arg rx, map
call serIni
dsn = ''
ox = wrNew()
do while readLn(rx, li)
if abbrev(m.li, m.ser.mark) then do
rest = substr(m.li, 1 + length(m.ser.mark))
w2 = translate(word(rest, 2))
if abbrev(rest, m.ser.begin) then do
if dsn ^== '' then
call serErr rx, li, 'nested begin'
if w2 = '' then
call serErr rx, li, 'begin with empty dsName'
dsn = w2
toDs = ''
interpret map
writing = toDs ^= ''
if writing then
call wr2DS ox, toDs
iterate
end
else if abbrev(rest, m.ser.end) then do
if writing then
call wrClose ox
if dsn == '' then
call serErr rx, li, 'unpaired end'
if w2 ^== dsn then
call serErr rx, li, 'mismatched end for' dsn
dsn = ''
iterate
end
else if abbrev(rest, m.ser.mark) then do
m.li = rest
end
else do
call serErr rx, li, 'bad line'
end
end
if dsn == '' then
call serErr rx, li, 'data out of sequence'
if writing then
call writeLn ox, m.li
end
if dsn ^== '' then
call serErr rx, li, 'input ends without end'
dsn = ''
interpret map
call wrFree ox
return
endProcedure serDesReader
serErr: procedure expose m.
parse arg rx, li, msg
say '*** error' msg
say ' line ' m.li
say ' info ' readInfo(rx, '*')
call err msg
endProcedure serErr
serialize: procedure expose m.
parse upper arg toDsn, dsns
call serIni
wx = wr2DS(wrNew(), 'dsn='toDsn)
call outPush wx
call serLst dsns
call wrClose wx
call outPop
call wrFree wx
return
endProcedure serialize
serLst: procedure expose m.
parse upper arg dsns
px = piNew(2)
call piBegin px
call piDefine , "call lmx" quote(dsns)
call piBar
call piDefine ,, "call serDsn m.line"
call piEnd px
call wrClose px
call wrFree px
return
endProcedure serLst
serTst: procedure
return date(s) time()
endProcedure serTst
err:
call errA arg(1), 1
endSubroutine err
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = '~wk.pli(w*)'
else if dsn = '=' then do
ff = dsnAlloc('~wk.rexx',shr,abc)
dsn = '=abc'
end
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
if words(ff) > 1 then
interpret subword(ff, 2)
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
lmmBegin: procedure
parse arg dsnSpec
parse value dsnSpec(dsnSpec) with dd disp dsn .
if disp = '=' then do
pds = 'ddName('dd')'
mbr = ''
end
else do
mbr = dsnGetMbr(dsn)
pds = "dataset('"dsnSetMbr(dsn, )"')"
end
call adrIsp "LMINIT DATAID(lmmId)" 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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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 -------------------------------------------*/
dsnSpec: procedure
parse upper arg spec
dd = '-'
dsn = '-'
disp = '-'
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 by 1
w = word(spec, wx)
if left(spec, 1) = '=' then
return substr(spec, 2) '= -'
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if abbrev(w, 'DSN(') & dsn = '-' then
dsn = dsn2jcl(substr(w, 5, length(w)-5), addPref)
else if dsn = '-' & w <> '' then
dsn = dsn2jcl(w, addPref)
else
return dd disp dsn subword(spec, wx)
end
endProcedure dsnSpec
dsnSpecDsn: procedure
parse arg spec
parse value dsnSpec(spec) with dd disp dsn .
if dsn = '' then
call 'err listDsi for dsn="" not implemented yet'
return dsn
endProcedure dsnSpecDsn
dsnAlloc: procedure
parse upper arg spec, defDisp, defDD
parse value dsnSpec(spec) with dd disp dsn rest
if disp = '=' then
return dd
if dd = '-' then
DD = defDD
if dd = '' then
dd = 'DD' || ooNew()
if disp = '-' then
disp = defDisp
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if dsn <> '-' then
disp = disp "dsn('"dsn"')"
call adrTso 'alloc dd('dd')' disp rest
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(SIGNAL) cre=2008-10-16 mod=2008-10-16-09.33.18 F540769 ---
/*rexx*/
say 'signal start'
call p1
say 'signal exit'
exit
p1:
say 'p1 start'
call p2
say 'p1 end'
return
p2:
say 'p2 start'
do x=1 to 3
eins: say 'eins' x
signal zwei
end
zwei: say 'zwei' x
say 'p2 return'
return
exit
}¢--- A540769.WK.REXX.O08(SLEEP) cre=2008-09-02 mod=2008-09-02-16.33.43 F540769 ---
/* rexx */
parse arg s
if s = '' then
call sleep 5
else
call sleep s
exit
sleep: procedure expose m.
parse arg secs, sayIt
if sayit <> 0 then
say 'sleeping' secs 'secs' time()
CALL SYSCALLS 'ON'
ADDRESS SYSCALL "sleep" secs
CALL SYSCALLS 'OFF'
if sayit <> 0 then
say 'slept' secs 'secs' time()
return
endProcedure sleep
}¢--- A540769.WK.REXX.O08(SORT) cre=2008-06-23 mod=2008-06-23-16.21.19 F540769 ---
/* copy sort begin ****************************************************/
sort: procedure expose m.
parse arg i, o
call sort1 i, 1, m.i.0, o, 1, sort.work, 1
m.o.0 = m.i.0
return
endProcedure sort
sort1: procedure expose m.
parse arg i, i0, le, o, o0, w, w1
if le <= 1 then do
if le = 1 then
m.o.o0 = m.i.i0
return
end
h = (le + 1) % 2
call sort1 i, i0, h, o, o0+le-h, w, w1
call sort1 i, i0+h, le-h, w, w1, o, o0
call sortMerge o, o0+le-h, o0+le, w, w1, w1+le-h, o, o0
return
endProcedure sort1
sortMerge: procedure expose m.
parse arg l, l0, le, r, r0, re, o, o0
do while l0 < le & r0 < re
if m.l.l0 <<= m.r.r0 then do
m.o.o0 = m.l.l0
l0 = l0 + 1
end
else do
m.o.o0 = m.r.r0
r0 = r0 + 1
end
o0 = o0 + 1
end
do while l0 < le
m.o.o0 = m.l.l0
l0 = l0 + 1
o0 = o0 + 1
end
do while r0 < re
m.o.o0 = m.r.r0
r0 = r0 + 1
o0 = o0 + 1
end
return
endProcedure sortWork
/* copy sort end ****************************************************/
}¢--- A540769.WK.REXX.O08(SORTTEST) cre=2007-02-02 mod=2007-02-02-09.59.12 F540769 ---
call mAdd i, 'null', 'eins', 'zwei', 'drei', 'vier', 'fuenf', 'sechs',
, 'sieben', 'acht', 'neun', 'zehn', 'elf', 'zwölf' ,
, 'dreizehn', 'vierzehn', 'fuenfzehn', 'sechzehn' , 'siebze'
do cc=0 to 18
m.i.0 = cc
say 'sort' cc '**********'
call sort o, i
do x=1 to mSize(o)
k = mAtSq(o,x)
v = m.k
say x k v m.v
end
end
exit
sort: procedure expose m.
parse arg o, i
iSz = mSize(i)
do x=1 to iSz
m.sort.0.x = i'.' || x
end
call sort1 1, o, 'SORT.0', 1 , iSz+1
m.o.0 = iSZ
return
endProcedure sort
sort1: procedure expose m.
parse arg nx, o, i, ib, ie
iSz = ie - ib
if iSz < 2 then do
if iSZ = 1 then
m.o.1 = m.i.ib
return
end
im = (ie + ib) % 2
bs = 'SORT.'nx
ms = 'SORT.' || (nx+1)
call sort1 nx+2, bs, i, ib, im
call sort1 nx+2, ms, i, im, ie
bx = 1
bz = 1 + im - ib
mx = 1
mz = 1 + ie - im
ox = 0
do while bx < bz & mx < mz
bk = m.bs.bx
mk = m.ms.mx
ox = ox+1
if m.bk <= m.mk then do
m.o.ox = bk
bx = bx + 1
end
else do
m.o.ox = mk
mx = mx + 1
end
end
do bx=bx to bz-1
ox = ox + 1
m.o.ox = m.bs.bx
end
do mx=mx to mz-1
ox = ox + 1
m.o.ox = m.ms.mx
end
return
endProcedure sort1
/* copy m begin ********************************************************
stem and tree handling
***********************************************************************/
/*--- increase m.m and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg m, delta
if delta = '' then
m.m = m.m + 1
else
m.m = m.m + delta
return m.m
endProcedure mInc
/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
parse arg m, delta
if symbol('m.m') <> 'VAR' then
m.m = 0
return mInc(m)
endProcedure mIncD
/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
parse arg m
return m.mKey.m
endProcedure mKy
/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
parse arg m
if symbol('m.m.0') == 'VAR' then
return m.m.0
else
return 0
endProcedure mSize
/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg m
dx = lastPos('.', m)
if dx <= 1 then
return ''
else
return left(m, dx - 1)
endProcedure mPar
/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg m, Ky, val
if m == '' then
m = 'mRoot.' || mIncD('mRoot.0')
m.m = val
m.mKey.m = Ky
m.m.0 = 0
return m
endProcedure mRoot
/*--- add one or several values to stem m.m --------------------------*/
mAdd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
end
m.m.0 = ix
return m'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSeq: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
dx = mSize(dst)
do sx = begX to endX
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return dst
endProcedure mAddSeq
/*--- add one value to the stem m.m ----------------------------------*/
mAddNd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
m.m.ix.0 = 0
end
m.m.0 = ix
return m'.'ix
endProcedure mAddNd
/*--- add one Ky value pair to stem m.m -----------------------------*/
mAddKy: procedure expose m.
parse arg m, Ky, val
nn = mAddNd(m, val)
m.mKey.nn = Ky
return nn
endProcedure mAddKy
/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
parse arg m, ky, val
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
call err 'duplicate Ky' ky 'for node' m
nn = mAddNd(m, val)
m.mKey.nn = ky
m.mIndex.m.mKey.ky = nn
return nn
endProcedure mAddK1
/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg m, Ky, val
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
m.ch = val
return ch
end
else do
return mAddK1(m, Ky, val)
end
return
endProcedure mPut
/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg m, ky
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
return m.mIndex.m.mKey.ky
else
return ''
endProcedure mAtK1
/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg m, Ky
if symbol('m.mIndex.m.mKey.Ky') ^== 'VAR' then
call err 'no Ky' Ky 'at node' m
ch = m.mIndex.m.mKey.Ky
return m.ch
endProcedure mVaAtK1
/*--- return the value of the first defined ky in the list of nodes
def if ky isn't defined ---------------------------------------*/
mFirst: procedure expose m.
parse arg Ky, def
do ax=3 to arg()
m = arg(ax)
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
return m.ch
end
end
return def
endProcedure mFirst
/*--- return the child at sequenceNo seq of node m -------------------*/
mAtSq: procedure expose m.
parse arg m, seq
if symbol('m.m.seq') ^== 'VAR' then
return ''
else
return m'.'seq
endProcedure mAtSq
/*--- remove all or all after nwSz children --------------------------*/
mRemCh: procedure expose m.
parse arg pa, nwSz
if nwSz = '' then
nwSz = 0
do cx=nwSz+1 to mSize(pa)
ch = pa'.'cx
call mRemCh ch
ky = m.mKey.ch
drop m.mIndex.pa.mKey.ky m.mKey.ch m.ch m.ch.0
end
m.pa.0 = nwSz
return pa
endProcedure mRemCh
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mAddTree: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
do sx=begX to endX
sCh = src'.'sx
if symbol('m.mKey.sCh') ^= 'VAR' then do
dCh = mAddNd(dst, m.sCh)
end
else do
ky = m.mKey.sCh
if symbol('m.mIndex.src.mKey.ky') ^= 'VAR' then
dCh = mAddKy(dst, ky, m.sCh)
else
dCh = mAddK1(dst, ky, m.sCh)
end
call mAddTree dCh, sCh
end
return dst
endProcedure mAddTree
/*--- show from one node everything that is defined ------------------*/
mShowNd: procedure expose m.
parse arg m
pa = mPar(m)
t = 'node' m 'pa='pa
if symbol('m.m') == 'VAR' then
t = t 'va='m.m
if symbol('m.m.0') == 'VAR' then
t = t 'size='m.m.0
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
t = t 'ky='ky
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t = t 'index='m.mIndex.pa.mKey.ky
end
say t
return
endProcedure mShowNd
/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg m, lv
if lv = '' then
lv = 0
t = left('', lv)m
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
pa = mPar(m)
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t= t ky '>'
else
t= t ky '='
end
say t strip(m.m, 't')
do cx=1 to mSize(m)
call mShow mAtSq(m, cx), lv+1
end
return
endProcedure treeShow
/* copy m end *********************************************************/
}¢--- A540769.WK.REXX.O08(SP) cre=2008-05-07 mod=2008-05-09-10.49.07 F540769 ---
call sqlIni
call errReset 'h'
call sqlDsn st, 'DBAF', '-DIS DATABASE(DA540769) SPACE(A01*)'
call sqlDsn st, 'DBAF', '-DIS GROUP'
do x=1 to m.st.0
say strip(m.st.x, 't')
end
call sqlConnect dbaf
call t1 3
call t2 3
call t3 7
call sqlDisconnect
exit
t1:
parse arg cx
call sqlPrepare cx, "select 'abc' , 'efg'",
'from sysibm.sysDummy1'
call sqlExec 'declare c'cx 'cursor for s'cx
call sqlOpen cx
a = 'abcdef'
b = 123
call sqlFetchInto cx, ':m.a.b.ab, :m.a.b.ef'
say 'fetched ab= m.'a'.' || b'.'ab m.a.b.ab 'ef=' m.a.b.ef
call sqlClose cx
return
t2:
parse arg cx
call sqlPreDeclare cx, "select name" ,
"from sysibm.sysTables" ,
"where creator = 'SYSIBM' and name = ?"
call sqlOpen cx, 'SYSTABLES'
say sqlFetchInto(cx, ':NM') nm
say sqlFetchInto(cx, ':NM') nm
call sqlClose cx
call sqlOpen cx, 'SYSINDEXES'
a = 'a b c'
b = 1234565687687234
say sqlFetchInto(cx, ':M.a.b.n') m.a.b.n
say sqlFetchInto(cx, ':M.a.b.n') m.a.b.n
call sqlClose cx
return
t3:
parse arg cx
src = "select name" ,
"from sysibm.sysTables" ,
"where creator = 'SYSIBM' and name like 'SYSTABLES%'",
"fetch first 3 rows only"
call sqlPreDeclare cx, src
st = 'wie geht'' s'
say 'opAllCl' sqlOpAllCl(cx, st, ':M.ST.SX.NAME')
do x=1 to m.st.0
say x m.st.x.name
end
st = 'auch noch'
src = "select strip(creator) || '.' || strip(name)" substr(src,12)
say 'PreAllCl' sqlPreAllCl(cx+11, src, st, ':M.ST.SX.NAME')
do x=1 to m.st.0
say x m.st.x.name
end
return
/* copy sql begin ***************************************************
sql interface
sqlIni --> nur sql ohne o und j Anbindung
sqlOini --> sql mit o und j Anbindung
***********************************************************************/
sqlIni: procedure expose m.
m.sql.null = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src' s
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
m.sql.cx.i.ix.sqlData = arg(ix+1)
m.sql.cx.i.ix.sqlInd = - (arg(ix+1) == m.sql.null)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- open cursor 'c'cx fetch all into variables vars and close
return number of rows fetched ----------------------------------*/
sqlOpAllCl: procedure expose m.
parse arg cx, st, vars
do ix=1 to arg()-2
m.sql.cx.i.ix.sqlData = arg(ix+2)
m.sql.cx.i.ix.sqlInd = - (arg(ix+2) == m.sql.null)
end
call sqlOpen cx
do sx = 1 while sqlFetchInto(cx, vars)
end
m.st.0 = sx - 1
call sqlClose cx
return m.st.0
endProcedure sqlOpAllCl
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl: procedure expose m.
parse arg cx, src, st, vars
call sqlPreDeclare cx, src
return sqlOpAllCl(cx, st, vars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute: procedure expose m.
parse arg cx
do ix=1 to arg()-1
m.sql.cx.i.ix.sqlData = arg(ix+1)
m.sql.cx.i.ix.sqlInd = - (arg(ix+1) == m.sql.null)
end
call sqlExec 'execute s'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure sqlExImm
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure
parse arg ggSys, ggRetCon
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call sqlExec "connect" ggSys, ggRetCon ,1
return
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql end **************************************************/
/* copy sqlxx begin ***************************************************
sql interface
sqlIni --> nur sql ohne o und j Anbindung
sqlOini --> sql mit o und j Anbindung
***********************************************************************/
/*--- fetch all rows into stem st
from sql src using type ty and format fmt -----------------*/
sql2St: procedure expose m.
parse arg st, src, ty, fmt
cx = 49
call sql2Cursor cx, src, ty, fmt
call sqlOpen cx
do ix=1 by 1 while sqlFetch(cx, st'.'ix)
end
m.st.0 = ix-1
call sqlClose cx
return ix-1
endProcedure sql2St
/*--- prepare statement 's'cx and declare cursor 'c'cx from sql src
use or generate type ty and format fo ---------------------*/
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
call sqlExec 'prepare s'cx 'into :M.SQL.'cx'.D from :src'
call sqlExec 'declare c'cx 'cursor for s'cx
if ty == '*' | ty = '' then do
flds = 'SQL.'cx'.FLD'
ff = ''
do ix=1 to m.sql.cx.d.sqlD
f1 = word(m.sql.cx.d.ix.sqlName, 1)
if f1 == '' then
f1 = 'COL'ix
ff = ff f1
end
ty = oFldOnly(ff, 'e')
end
call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
flds = oFlds(ty)
m.Sql.cx.FMT.0 = 0
m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
ff = m.Sql.cx.FMT
call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
return
endProcedure sql2Cursor
/*--- return the type for sql cx -------------------------------------*/
sqlType: procedure expose m.
parse arg cx
return oGetTypePara('SQL.TY.'cx)
/*--- fetch cursor 'c'cx into destination dst
each column is formatted and assigned to m.dst.<colName> ---*/
sqlFetch: procedure expose m.
parse arg cx, dst
if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
return 0
if dst == '' then
return 1
fi = oFlds(sqlType(cx))
fo = m.sql.cx.fmt
do ix=1 to m.sql.cx.d.SQLD
f = m.fi.ix
if m.sql.cx.d.ix.sqlInd = 0 then
m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
else
m.dst.f = fmtS(m.sql.null, m.fo.ix)
end
return 1
endProcedure sqlFetch
/*--- fetch cursor 'c'cx
put the formatted and concatenated columns into m.var
return 1 if a row fetched, 0 if not ------------------------*/
sqlFetchLn: procedure expose m.
parse arg cx, var
st = 'SQL.'cx'.FET'
if ^ sqlFetch(cx, st) then
return 0
m.var = oFldCat(sqlType(cx), st, m.sql.cx.fmt)
return 1
endProcedure sqlFetchLn
/*--- generate the format ff for a sql cx as specified in sp
use the information from the sqlDa -------------------------*/
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
if abbrev(sp, '=') then
return substr(sp, 2)
if sp = '' then
sp = '*st'
m.ff.0 = m.sql.cx.d.sqlD
m.ff.flds = oFlds(sqlType(cx))
if abbrev(sp, '*') then do
do ix=1 to m.ff.0
m.ff.ix = substr(sp, 2)
end
return ff
end
if abbrev(fmts, '=') then
m.Sql.cx.FMT = substr(fmts, 2)
defs = 'ir7 fr9 sl12 Tl26' sp
do wx = 1 to words(defs)
parse value word(defs, wx) with ty 2 fo
select
when ty = 'd' then t.384 = fo
when ty = 'f' then t.480 = fo'/f'
when ty = 'i' then t.496 = fo'/i'
when ty = 'n' then t.484 = fo'/n'
when ty = 's' then t.448 = fo
when ty = 't' then t.388 = fo
when ty = 'T' then t.392 = fo
otherwise call err 'bad type' ty 'for format' fo
end
end
if symbol('t.496') == 'VAR' then
t.500 = t.496
if symbol('t.448') == 'VAR' then do
t.452 = t.448
t.456 = t.448
t.464 = t.448
end
do wx = 1 to m.ff.0
ty = m.sql.cx.d.wx.sqlType
le = m.sql.cx.d.wx.sqlLen
withNulls = ty // 2
ty = ty - withNulls
if symbol('t.ty') <> 'VAR' then
call err 'sqlType' ty 'not supported'
parse var t.ty fo 2 fl '/' op
if op = 'i' then
if le = 2 then le = 6
else le = 12
else if op <> '' then
call err 'length for sqlType' ty 'op' op 'not implemented'
if fl = '=' then
fl = le
else if abbrev(fl, '<') then
fl = min(le, substr(fl, 2))
m.ff.wx = fo || fl
end
return ff
endProcedure sqlGenFmt
/*--- sql o interface ------------------------------------------------*/
/*--- return a reader for the givenn sql or std input ----------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
if ty = '' then
ty = '*'
if src == '' then
src = envCatStr(' ', 'sb')
call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
call oMutate 'SQL.TY.'cx, 'SqlType'
return 'SQL.TY.'cx
endProcedure sql2obj
/*--- write to std output the result columns of
the sql given in src or std input --------------------------*/
sql: procedure expose m.
parse arg cx, src, ty, fo
call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
return
endProcedure sql
/*--- write to std output the result lines of
the sql given in src or std input --------------------------*/
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
if fo = '' then
fo = '~'
squash = abbrev(fo, '~')
if ^ abbrev(fo, '=') then
fo = left(fo, squash) 'sl=' substr(fo, squash+1)
t = sql2Obj(cx, src, ty, fo)
if squash then do
call fmtFldSquashRw t, 'opCl'
return
end
m = 'SQL.LN.'cx
call oMutate m, 'SqlLn'
call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
call jWriteAll m.j.jOut, "r£", m
return
endProcedure sqlLn
sqlOini: procedure expose m.
if m.sqlO.ini == 1 then
return
m.sqlO.ini = 1
call sqlIni
call envIni
call oDecMethods oNewClass("SqlType"),
, "jOpen call sqlOpen substr(m, 8)",
, "jClose call sqlClose substr(m, 8)",
, "jRead return sqlFetch(substr(m, 8), var)"
call oDecMethods oNewClass("SqlLn", "SqlType"),
, "jRead return sqlFetchLn(substr(m, 8), var)"
return
endProcedure sqlOini
/* copy sql 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 *****************************************************/
/* 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 = '' & ^ abbrev(disp, 'SYSO') then
return 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 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
/*--- 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 'finis)'
interpret subword(ggAlloc, 2)
if ggSay == 1 | m.debug == 1 then
say ggCnt 'records written to' ggDsnSpec
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
}¢--- A540769.WK.REXX.O08(SPL) cre=2006-05-31 mod=2006-09-25-09.11.31 F540769 ---
/* REXX *************************************************************
spl offset? target?
edit macro to Split lines at find target
use q or qq lineCommand to select part of the file
the lines are split at each string found
target may be any ispf editor find target
offset may be -number or +number
and shifts the split point so many chars to left or right
***********************************************************************/
/**** Test Data *******************************************************
1 jcl = abx(jclm) * sdf
2 jcl = abx(2clm) * sdf
3
4 abc(jclm) * sdf
5 abc 6 abc 7 abc 8 abc 9 abc
10 abc
**********************************************************************/
call adrEdit('macro (args) NOPROCESS')
say 'macro args' args
parse var args delta fnd
if left(args, 1) = '?' | translate(left(args, 4)) = 'HELP' then
exit help()
if ^ datatype(delta, 'n') then do
delta = 0
fnd = args
end
if fnd = '' then
fnd = '*'
say 'delta' delta 'fnd' fnd
call adrEdit 'process range Q R', 4
call adrEdit '(lf) = linenum .zfrange'
call adrEdit '(lT) = linenum .zLrange'
say 'delta' delta 'fnd' fnd 'from line' lf 'to' lt
call adrEdit "cursor = .zfrange 1"
call adrEdit "label" lt "= .end"
fnd = fnd '.zfrange .end'
cnt = 0
do while adrEdit("seek" fnd, 4) = 0
cnt = cnt + 1
call adrEdit "(lx, cx) = cursor"
call adrEdit "(line) = line" lx
/* say "line" lx "col" cx 'line' strip(line, 'l') */
cs = cx+delta
if cs < 1 then
cs = 1
else if cs > length(line)+1 then
cs = length(line)+1
c1 = verify(line, ' ')
lin2 = left('',c1-1)substr(line, cs)
line = left(line, cs-1)
/* say 'cs' cs 'c1' c1 'line' length(line) 'l2' length(lin2) */
call adrEdit "line" lx "= (lin2)"
call adrEdit "line_before" lx "= (line)"
if delta <= 0 then
call adrEdit "cursor = " (lx+1) (c1-delta)
else
call adrEdit "cursor = " (lx) (cx)
end
say cnt 'split at' fnd 'offset' delta
exit
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
/**********************************************************************
adr*: address an environment
***********************************************************************/
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 'for' ggIspCmd
endSubroutine adrIsp
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 err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
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 zIspfRc
back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say 'help for rexx' s3
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
return 4
endProcedure help
/* copy err end *****************************************************/
}¢--- A540769.WK.REXX.O08(SPLT) cre=2006-08-02 mod=2006-08-04-08.57.50 F540769 ---
/* rexx ****************************************************************
line- word and character count
***********************************************************************/
parse arg dsn
if dsn = '' then
dsn = "'TSS.SKA.PF22.KEM4000P.UNLOAD.S2006211'"
outPr = TSS.SKA.PF22.KEM4000P.UNLOAD.W
outat = "new catalog mgmtclas(BAT#ZJ) dataclas(EYN0XP) like("dsn")" ,
"space (500, 1000) cylinders"
call adrTso 'alloc dd(inDD) shr reuse dsn('dsn')'
call readDDBegin inDD
cc = 0
lc = 0
wc = 0
last = ''
outFi = ''
oc = 0
or = 0
ot = 0
do bc=1 by 1 while readDD(inDD, r.)
rx = 0
do while rx < r.0
rx = rx + 1
lc = lc + 1
cc = cc + length(r.rx)
wc = wc + words(r.rx)
cur = substr(r.rx, 7, 26)
jul = left(cur, 4)substr(cur, 6,2)substr(cur, 9,2)
jul = left(jul, 4)right(date('d', jul, 's'), 3, '0')
if last >= cur then
call err 'line' lc cur '<= previous' last
if left(cur, 7) <> left(last, 7) then do
rx = closeOut(rx)
if substr(cur, 6, 2) = '12' then do
outFi = (left(cur, 4) + 1)'001'
end
else do
da = left(cur, 4)right(substr(cur, 6, 2)+1, 2, '0')'01'
outFi = left(da, 4)right(date('d', da, 's'), 3, '0')
end
oc = oc + 1
outFi = left(cur,4)substr(cur,6,2)
outDsn = "'"outPr || outFi"'"
say 'open outFi' oc outFi outDsn 'lc' lc
call adrTso "alloc dd(ddOut)" outAt "dsn("outDsn")"
call writeDDBegin ddOut
end
last = cur
end
call writeDD ddOut, r.
or = or + r.0
if (bc // 1000) == 0 then
say 'lc' lc 'wc' wc 'cc' cc 'lRecL' (cc/lc) 'block' bc
end
rx = closeOut(1)
call readDDEnd inDD
call adrTso 'free dd(inDD)'
say 'lc' lc 'wc' wc 'cc' cc 'lRecL' (cc/lc) 'block' bc
say ' for' dsn
exit
closeOut:
parse arg nxt
if outFi <> '' then do
if nxt > 1 then do
call writeDD ddOut, r., nxt-1
or = or + nxt - 1
end
call writeDDEnd ddOut
call adrTso "free dd(ddOut)"
ot = ot + or
say 'close outFi' oc outFi 'written' or 'tot' ot 'lc' lc
or = 0
end
if nxt > 1 then do
do nqq=nxt by 1 to r.0
nqd = nqq - nxt + 1
r.nqd = r.nqq
end
r.0 = r.0 - nxt + 1
end
return 1
endSubroutine closeOut
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
/* copy adrTso begin *************************************************/
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
/**********************************************************************
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 */
readDDall:
parse arg ggDD, ggSt
call adrTso 'execio * diskr' ggDD '(stem' ggSt' finis)'
return
endSubroutine readDDall
readDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(readDsn) shr dsn('dsn')'
call readDDall readDsn, ggSt
call adrTso 'free dd(readDsn)'
return
endSubroutine readDsn
/*--- 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 */
/*--- end write a stem to a dsn -------------------------------------*/
writeDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(wriDsn) shr dsn('dsn')'
call adrTso 'execio' value(ggSt'0') ,
'diskw wriDsn (stem' ggSt 'finis)'
call adrTso 'free dd(wriDsn)'
return
/*--- 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 */
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
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 zIspfRc
back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say 'help for rexx' s3
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
return 4
endProcedure help
/* copy err end *****************************************************/
}¢--- A540769.WK.REXX.O08(SQL) cre=2007-12-27 mod=2008-10-28-13.06.48 F540769 ---
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm:
parse arg ggSrc, ggRet
return sqlExec('execute immediate :ggSrc', ggRet)
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure expose m.
parse arg ggSys, ggRetCon
call sqlIni
address tso "SUBCOM DSNREXX"
if rc <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
if ggSys = '-' then
return 0
return sqlExec("connect" ggSys, ggRetCon ,1)
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure expose m.
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
call address tso 'DSN SYSTEM('sys')'
rr = rc
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql end **************************************************/
}¢--- A540769.WK.REXX.O08(SQLBSP) cre=2008-09-18 mod=2008-09-18-09.47.54 F540769 ---
/* rexx ****************************************************************
synopsis tso sqlBsp arg subsys cr tb
zaehlt die rows der Tabelle cr.tb im db2 Subsystem subsys
return code 0 falls 0 rows sonst Anzahl Stellen des Count
***********************************************************************/
parse arg subsys cr tb
call errReset 'h'
if subsys = '?' | tb = '' then
exit help()
call sqlConnect subsys
if sqlPreAllCl(1, "select count(*), '"cr"."tb"'",
"from" cr"."tb,
, x, ":cn, :nm") <> 1 then
call err m.x.0 'fetchs statt 1 im select count(*) ....'
if cn = 0 then
cc = 0
else
cc = length(0+cn)
say 'table' nm 'hat' cn 'rows, Returncode' cc
exit cc
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure expose m.
parse arg ggSys, ggRetCon
call sqlIni
address tso "SUBCOM DSNREXX"
if rc <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
if ggSys = '-' then
return 0
return sqlExec("connect" ggSys, ggRetCon ,1)
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure expose m.
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
call address tso 'DSN SYSTEM('sys')'
rr = rc
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql 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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(SQLCODET) cre=2008-04-29 mod=2008-07-01-18.23.53 F540769 ---
/* rexx ****************************************************************
translate an sqlCode and Warnings to text
synopsis
sqlCodeT(sqlCode, sqlErrMC, warn, version, expEq
* return text for sqlCode with expanded arguments&warnings
sqlCodeT('/w', warn)
* return text for warnings
sqlCodeT '/g'
* generate rexx source for v8 and v9 messages
sqlCodeT '/t'
* issue some test translations
arguments:
sqlCode from sqlCA
sqlErrMC from sqlCA
warn '' or from sqlCA
sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',' ,
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10
expEx 1 for expand arguments as ${argumentName=argumentValue}
version: 'V8', 'V9' or '' (for default, currently V8)
***********************************************************************/
/**** History **********************************************************
01.05.08 W.Keller, KIUT 23 - neu
***********************************************************************/
call errReset h
parse arg sqlCode, sqlErrMc, warn, version, expEq
if ^ abbrev(sqlCode, '/') then
return sqlCodeText(sqlCode, sqlErrMc, warn, version, expEq)
if sqlCode = '/w' then
return sqlCodeWarn(sqlErrMc)
if sqlCode = '/g' then do
call mIni
m.pref = '~wk.texv(sqlCod'
call sqlCodeConvertV8
call sqlCodeConvertV9
call sqlCodeMerge 'V8 V9', 'VV'
end
else if sqlCode = '/t' then do
call mIni
say sqlCodeText(0)
say sqlCodeText(-152)
say sqlCodeText(-152, , , 'V7')
say sqlCodeText(-152, 'eins', 'W: WWW,WWWZW', 'V8')
say sqlCodeText(-152, 'eins' || 'ff'x || 'zwei')
say sqlCodeText(-152, 'eins' || 'ff'x || 'zwei'||'ff'x||'drei')
say sqlCodeText(-152, 'eins' || 'ff'x || 'zwei'||'ff'x||'drei',
||'ff'x||'vier')
end
else do
call errHelp 'bad argument sqlCode' sqlCode
end
exit
sqlCodeText: procedure expose m.
parse arg co, mc, warn, rel, expEq
if rel = '' then
rel = 'V9'
expEq = expEq = 1
st = sqlCodeT'.'rel
if symbol('m.st') <> 'VAR' then do
call sqlCodeFromSource st, 'sqlCodes', rel
if m.st = 0 then
say 'warning no sql Message for release' rel
end
cc = co+0
if symbol('m.st.co') = 'VAR' then
li = m.st.co
else
li = "<<text for sqlCode" co "not found>>"
cx = 1
px = 1
res = ''
do forever
nx = pos('${', li, cx)
if nx < 1 then
leave
ex = pos('}', li, nx)
if ex < cx then
call err 'closing } missing in' li
if ^ expEq then
res = res || substr(li, cx, nx - cx)
else
res = res || substr(li, cx, ex - cx) || '='
cx = ex+(^expEq)
if px > length(mc) then do
res = res || '<missingErrMC>'
end
else do
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res || substr(mc, px, qx-px)
px = qx + 1
end
end
res = res || substr(li, cx)
do while px <= length(mc)
qx = pos('FF'x, mc, px)
if qx < 1 then
qx = length(mc)+1
res = res '${extraErrMc =' substr(mc, px, qx-px)'}'
px = qx + 1
end
if warn ^== '' then
res = res '\nwarnings' sqlCodeWarn(warn)
return strip(res)
endProcedure sqlCodeText
/*--- return the text for the passed warnings
in format 0:12345,6789A ---------------------------*/
sqlCodeWarn: procedure expose m.
parse arg warn
if warn = '' | abbrev(warn, ' ') | abbrev(warn, 'SQLWARN.') then
return ''
if substr(warn, 2, 1) ^== ':' | substr(warn, 8, 1) ^== ',' ,
| length(warn) > 13 then
return 'bad warn' warn
parse var warn . 3 w1 4 w2 5 w3 6 w4 7 w5 8 . 9 ,
w6 10 w7 11 w8 12 w9 13 wA 14 wRest
wAll = substr(warn, 3, 5)substr(warn, 9, 5)
r = ''
text =' 1=W var truncated, 1=S scrollable, 1=N nonScrollable,' ,
'2=W nulls in aggregate,' ,
'3=W more cols than vars,' ,
'3=Z more result sets than locators,' ,
'4=W no where, 4=D sensitive dynamic, 4=I insensitive,' ,
'4=S sensitive static,' ,
'5=W not valid sql, 5=1 readOnly, 5=2 readDelete,' ,
'5=3 readDeleteUpdate,' ,
'6=W day changed to month range,' ,
'7=W dec digits truncated,' ,
'8=W char substituted,' ,
'9=W arith excep in count, 9=Z multipe result sets,' ,
'10=W char conversion err in ca,'
do wx = 1 to 10
w = substr(wAll, wx, 1)
if w = ' ' then
iterate
t = wx'='w
cx = pos(' 'wx'='w' ', text)
ex = pos(',' , text, cx + 1)
if cx < 1 then
r = r wx'='w '?,'
else
r = r substr(text, cx+1, ex-cx)
end
return strip(r, 't', ',')
endProcedure sqlCodeWarn
sqlCodeMerge: procedure expose m.
parse arg inSu, outSu
do wx=1 to words(inSu)
su = word(inSu, wx)
call sqlCodeFromPds mCut(su, 0), su
say 'read' su m.su.0
end
call mCut all, 0
do wx=1 to words(inSu) /* each list */
su = word(inSu, wx) /* each msg in one list */
do sx=1 to m.su.0
suffs = ''
k = word(m.su.sx, 1) + 0
do qx=1 to words(inSu) /* each list */
qu = word(inSu, qx)
qy = m.qu.key.k
if symbol('m.qu.key.k') == 'VAR' ,
& m.su.sx = m.qu.qy then
suffs = suffs qu
end /* each list */
suffs = strip(suffs)
if wordPos(su, suffs) < 1 then
call err 'self missing wx' wx 'su' su 'sx' sx 'k' k
else if wordPos(su, suffs) > 1 then
iterate
if symbol('all.suffs') ^== 'VAR' then do
all.suffs = 1
call mAdd all, suffs
call mCut 'ALL.'suffs, 0
end
call mAdd 'ALL.'suffs, m.su.sx
end /* each msg in one list */
end /* each list */
call mCut o, 0
do lx=1 to m.all.0
li = m.all.lx
say 'list' li m.all.li.0
call sqlCodeConvertFormat all'.'li, o, 'sqlCodes' li
end
call writeDsn m.pref'VV)', m.o., , 1
return
endProcedure sqlCodeMerge
sqlCodeFromSource: procedure expose m.
parse arg o, mark, rel
sta = '/*<<<' mark
sto = '>>>>>' mark
sx = 0
ox = 0
do forever
do sx=sx+1 to sourceline() while ^abbrev(sourceline(sx), sta)
end
if sx > sourceline() then
leave
if wordPos(rel, sourceline(sx)) < 1 then
iterate
do sx=sx+1 to sourceline() while ^abbrev(sourceline(sx), sto)
if abbrev(sourceline(sx), ' ') then do
m.o.cd = m.o.cd || substr(sourceline(sx), 3, 70)
end
else do
if ox > 0 then
m.o.cd = strip(m.o.cd)
cd = word(sourceline(sx), 1) + 0
if symbol('m.o.cd') == 'VAR' then
call err 'duplicate sqlCodeFromSource' rel,
'line' sx sourceline(sx)
ox = ox+ 1
m.o.cd = substr(sourceline(sx), 1, 72)
end
end
end
m.o = ox
if ox > 0 then
m.o.cd = strip(m.o.cd)
return
endProcedure sqlCodeFromSource
sqlCodeFromPDS: procedure expose m.
parse arg o, suf
ox = m.o.0
sta = '/*<<<'
sto = '>>>>>'
call readDsn m.pref || suf || ')', i.
do sx=1 to i.0
if abbrev(i.sx, sta) then
iterate
if abbrev(i.sx, sto) then
iterate
if abbrev(i.sx, ' ') then do
m.o.ox = m.o.ox || substr(i.sx, 3, 70)
end
else do
ox = ox+ 1
m.o.ox = substr(i.sx, 1, 72)
k = word(m.o.ox, 1) + 0
m.o.key.k = ox
end
end
m.o.0 = ox
return
endProcedure sqlCodeFromPds
sqlCodeConvertV9: procedure expose m.
call readDsn m.pref'S9)', m.i.
call sqlCodeConvertV9Lines i, mCut(ll, 0)
call sqlCodeConvertSplitLines ll, mCut(mm, 0)
call sqlCodeConvertParameter mm
call sqlCodeConvertFormat mm, mCut(o, 0), 'sqlCodes V9'
call writeDsn m.pref'V9)', m.o., , 1
return
endProcedure sqlCodeConvertV9
sqlCodeConvertV8: procedure expose m.
call readDsn m.pref'S8)', m.i.
call sqlCodeConvertV8Lines i, mCut(ll, 0)
call sqlCodeConvertSplitLines ll, mCut(mm, 0)
call sqlCodeConvertParameter mm
call sqlCodeConvertFormat mm, mCut(o, 0), 'sqlCodes V8'
call writeDsn m.pref'V8)', m.o., , 1
return
endProcedure sqlCodeConvertV8
/*--- input sqlCode textes from db2 reference summary:
copy pasted from pdf and transfered to vb member
output lines without header footer etc. ------------------------*/
sqlCodeConvertV9lines: procedure expose m.
parse arg i, o
do ix=1 to m.i.0
li = strip(m.i.ix)
if right(li, 16) = 'SQL return codes' then
li = left(li, length(li) - 16)
if abbrev(li, 'Warning SQL codes') ,
| li = '¨' | li = '' ,
| subword(li, 2) == 'Reference Summary' ,
| abbrev(li, 'Chapter 4. SQL return codes') ,
| li = 'SQL return codes' then
iterate
if pos('opyrigh', li) > 0 then
call err 'remove copyright in line' ix,
'pos' pos('opyrigh', li),
substr(li, pos('opyrigh', li), 30)
call mAdd o, strip(li)
end
return
endProcedure sqlCodeConvertV9lines
/*--- input sqlCode textes from db2 reference summary:
copy pasted from pdf and transfered to vb member
output lines without header footer etc. ------------------------*/
sqlCodeConvertV8lines: procedure expose m.
parse arg i, o
do ix=1 to m.i.0
li = strip(m.i.ix)
if words(li) = 1 then do
w = strip(li)
if wordpos(w, 'Copyright IBM CORP Corp. Chapter SQL' ,
'1982, return codes Reference Summary') > 0 then
iterate
if datatype(w, n) then
iterate
end
if right(li, 4) = ' SQL' then
li = strip(left(li, length(li) - 4))
if pos('opyrigh', li) > 0 then
call err 'remove copyright in line' ix,
'pos' pos('opyrigh', li),
substr(li, pos('opyrigh', li), 30)
call mAdd o, strip(li)
end
return
endProcedure sqlCodeConvertV8lines
/*--- split the lines into single sql messages -----------------------*/
sqlCodeConvertSplitLines: procedure expose m.
parse arg i, o
do ix=1 to m.i.0
li = m.i.ix
catIt = ^ datatype(word(li, 1), n)
cx = 1
do while cx <= length(li)
e0 = cx+1
do forever
e1 = pos(' -', li, e0)
e2 = pos(' +', li, e0)
if e1 < 1 then do
if e2 < 1 then do
ex = length(li) +1
leave
end
ex = e2
end
else if e2 < 1 then
ex = e1
else
ex = min(e1, e2)
if datatype(word(substr(li, ex), 1), n) then
leave
e0 = ex+1
end
if catIt then do
ox = m.o.0
m.o.ox = m.o.ox substr(li, cx, ex-cx)
catIt = 0
end
else do
msg = substr(li, cx, ex-cx)
k = word(msg, 1)
if symbol('k.k') = 'VAR' then do
kkxx = k.k
if m.o.kkxx <> k & m.o.kkxx <> msg then
call err 'duplicate msg' msg
say 'duplicate msg' m.o.kkxx
say ' new msg' msg
m.kkxx = msg
end
else do
call mAdd o, substr(li, cx, ex-cx)
k.k = m.o.0
end
end
cx = ex+1
end
end
return
endProcedure sqlCodeConvertSplitLines
/*--- add parameter markers ${ and } ---------------------------------*/
sqlCodeConvertParameter: procedure expose m.
parse arg o
do ox=1 to m.o.0
li = strip(m.o.ox)
cx = 1
res = ''
do forever
nx = verify(li, m.mAlfLc, 'm', cx)
do while nx > 0
if nx < 1 then
leave
else if substr(li, nx, 9) = 'he XML NA' then
nx = verify(li, m.mAlfLc, 'm', nx+5)
else if substr(li, nx,25) ,
= 'he decimal number is used' then
nx = 0
else
leave
end
if nx < 1 then
leave
qx = verify(li, m.mAlfNum'-#.', 'n', nx)
if qx < 1 then
qx = length(li) + 1
res = res || substr(li, cx, nx-cx) ,
|| '${' || substr(li, nx, qx-nx) || '}'
if right(res, 2) == '.}' then
res = left(res, length(res) - 2)'}.'
cx = qx
end
m.o.ox = res || substr(li, cx)
end
return
endProcedure sqlCodeConvertParameter
/*--- split the sql messages into 72 byte lines ----------------------*/
sqlCodeConvertFormat: procedure expose m.
parse arg i, o, mark
call mAdd o, left('/*<<<' mark' ', 72, '<')
do ix=1 to m.i.0
li = strip(m.i.ix)
pr = ''
cx = 1
do forever
l = 72 - length(pr)
if cx + l > length(li) then
leave
call mAdd o, pr || substr(li, cx, l)
cx = cx + l
pr = ' '
end
call mAdd o, pr || substr(li, cx)
end
call mAdd o, left('>>>>>' mark' ', 70, '>')'*/'
return
endProcedure sqlCodeConvertFormat
m.x.xx = m.x.xx li
say 'cat' (ix-1) 'and' ix left(tt m.i.ix, 50)
end
fx = posM(li, 1, ' 000 ', ' +', ' -') + 1
if fx < 2 then
iterate
end
do xx=1 to m.xx.0
return
call adrEdit 'macro (mArgs)'
call adrEdit "(zl) = lineNum .zl"
say 'zl' zl
call mAdd mCut(o, 0), '****************'
s = 0
bef = ''
do lx = 1 to zl
call adrEdit "(li) = line" lx
li = strip(li ,'t')
if li = 'return' & (lx-1)=laLx & right(bef, 4) = ' SQL' then
bef = left(bef, length(bef)-4)
if abbrev(li, '-') | abbrev(li, '+') then do
fx = 1
end
else do
fx = posM(li, 1, ' 000 ', ' +', ' -') + 1
if fx < 2 then
iterate
end
if bef ^== '' then do
if fx > 2 then
call mAdd o, bef left(li, fx-2)
else
call mAdd o, bef
bef = ''
end
laLx = lx
do forever
tx = posM(li, fx + 3, ' 000 ', ' +', ' -')
do while tx > fx & ^ datatype(substr(li, tx+1, 3), 'n')
tx = posM(li, tx + 1, ' 000 ', ' +', ' -')
end
if tx < 1 then
leave
call mAdd o, substr(li, fx, tx+1-fx)
fx = tx + 1
end
bef = substr(li, fx)
end
if bef ^== '' then
call mAdd o, bef
do ox=1 to m.o.0
li = m.o.ox
cx = 1
res = ''
do forever
nx = verify(li, m.mAlfLc, 'm', cx)
do while nx > 0
say 'nx' nx length(li)
if nx < 1 then
leave
else if substr(li, nx, 9) = 'he XML NA' then
nx = verify(li, m.mAlfLc, 'm', nx+5)
else if substr(li, nx,25) ,
= 'he decimal number is used' then
nx = 0
else
leave
end
if nx < 1 then
leave
qx = verify(li, m.mAlfNum'-', 'n', nx)
if qx < 1 then
qx = length(li) + 1
res = res || substr(li, cx, nx-cx) ,
|| '${' || substr(li, nx, qx-nx) || '}'
cx = qx
end
m.o.ox = res || substr(li, cx)
end
do ox=1 to m.o.0
li = m.o.ox
ec = adrEdit("line_after .zl = (li)", '*')
if ec <> 0 then
say 'line_after rc' ec 'le' length(li) li
end
exit
posM: procedure expose m.
parse arg src, fx
res = 0
do ax=3 to arg()
p = pos(arg(ax), src, fx)
if p ^= 0 & (res = 0 | p < res) then
res = p
end
return res
endProcedure mPos
/* copy m begin ********************************************************
stem handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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 -------------------------------------------*/
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 = '' & ^ abbrev(disp, 'SYSO') then
return 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 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
/*--- 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 '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
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, ggStem, ggOpt
drop err handler opt
if ggOpt == '' & symbol('m.err.handler') == 'VAR' then do
interpret m.err.handler
return 12
end
say 'fatal error:' ggTxt
if ggOpt == '' | ggOpt == '*' then
ggOpt = translate(value('m.err.opt'), 'ht', 'HT')
if ggStem ^== '' then do
do ggXX=1 to m.ggStem.0
say ' ' m.ggStem.ggXX
end
if ggXX > 3 then
say 'fatal error in' ggS3':' ggTxt
end
parse source . . ggS3 . /* current rexx */
if ggOpt == 'h' 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 setRc(12)
endSubroutine err
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, st, op
say 'fatal error:' msg
call help
call err msg, st, 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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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
/*<<< sqlCodes V8 V9 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A COR
RELATED REFERENCE
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY
IS AN EMPTY TABLE
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBS
YSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT
COLUMNS
+162 TABLESPACE ${database-name.tablespace-name} HAS BEEN PLACED IN CHEC
K PENDING
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-U
NIQUE OR UNEXPOSED NAME
+204 ${name} IS AN UNDEFINED NAME
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT
DEFINED PROPERLY
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQU
IRED FOR ${integer3} COLUMNS
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR E
NTRIES ARE NEEDED FOR ${integer3} COLUMNS BECAUSE AT LEAST ONE OF THE
COLUMNS BEING DESCRIBED IS A LOB
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQU
IRED FOR ${integer3} COLUMNS BECAUSE AT LEAST ONE OF THE COLUMNS BEING
DESCRIBED IS A DISTINCT TYPE
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST V
ARIABLE BECAUSE THE VALUE IS NOT WITHIN THE RANGE OF THE HOST VARIABLE
IN POSITION ${position-number} WITH DATA TYPE ${data-type2}
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-nu
m} ${var-name-or-num} TO COLUMN NAME, HOST VARIABLE, OR EXPRESSION NUM
BER ${col-name-or-num} FROM ${from} ${ccsid} TO ${to-ccsid}, AND RESUL
TING IN SUBSTITUTION CHARACTERS.
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE
SOME CHARACTER CONVERSION INCONSISTENCIES
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINI
TE LOOP
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT
EXIST
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-na
me}) HAS RETURNED A WARNING SQLSTATE, WITH DIAGNOSTIC TEXT ${text}
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS
THE DEFINED LIMIT ${integer}
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (
${estimate-amount2} SERVICE UNITS) IN COST CATEGORY ${cost-category} E
XCEEDS A RESOURCE LIMIT WARNING THRESHOLD OF ${limit-} ${amount} SERVI
CE UNITS
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORD
ER OF THE ROWS
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAU
SE IT IS A DUPLICATE
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${opera
tion} ON OBJECT ${object-name}
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${opera
tion}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRAN
TED PUBLIC AT ALL LOCATIONS
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS
THE PRIVILEGE FROM THE GRANTOR
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A
LONG STRING DATA TYPE
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${util
ity} PENDING
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT
AVAILABLE BECAUSE ITS PARTITIONED INDEX HAS NOT BEEN CREATED
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOL
UME IDS. IT WILL NOT BE ALLOWED IN FUTURE RELEASES
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILA
R CHANGE ON READ-ONLY SYSTEMS
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST A
T THE SERVER SITE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-t
ype} OPERATION ON ${data-type} DATA, POSITION ${position-number}
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR
LOCKSIZE ROW AND LOCKMAX 0
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNO
T BE UNDONE, OR AN OPERATION THAT CANNOT BE UNDONE OCCURRED WHEN THERE
WAS A SAVEPOINT OUTSTANDING
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BU
FFER POOL DEPENDENT IN A DATA SHARING ENVIRONMENT
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS C
ONTEXT
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${
token-list}
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator}
IS FOLLOWED BY A PARENTHESIZED LIST OR BY ANY OR ALL WITHOUT A SUBQUER
Y
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPEC
IFIED OR IMPLIED COLUMNS
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO
IDENTIFIED IN A FROM CLAUSE
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CO
NSTANT OR KEYWORD
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE
RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY
CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRIN
G PATTERN CONTAINS AN INVALID OCCURRENCE OF THE ESCAPE CHARACTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID B
ECAUSE ALL COLUMN REFERENCES IN ITS ARGUMENT ARE NOT CORRELATED TO THE
GROUP BY RESULT THAT THE HAVING CLAUSE IS APPLIED TO
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-le
ngth}
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE
${constraint-name} IS A ${constraint-type}
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES
NOT INCLUDE A UNIQUE NAME FOR EACH COLUMN
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${objec
t-name} IS NOT THE NAME OF A TABLE.
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SA
ME AS THE NUMBER OF COLUMNS SPECIFIED BY THE FULLSELECT, OR THE NUMBER
OF COLUMNS SPECIFIED IN THE CORRELATION CLAUSE IN A FROM CLAUSE IS NO
T THE SAME AS THE NUMBER OF COLUMNS IN THE CORRESPONDING TABLE, VIEW,
TABLE EXPRESSION, OR TABLE FUNCTION
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NO
T SATISFY THE VIEW DEFINITION
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALI
FICATION ${authorization-ID}
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-nam
e} IS INVALID
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETI
ME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS
NOT WITHIN THE VALID RANGE OF DATES
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER
MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LO
CAL EXIT HAS BEEN INSTALLED
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND E
XECUTING PROGRAM RELIES ON THE OLD LENGTH
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK
OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART O
F THE RESULT TABLE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A
TRIGGER DEFINITION
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${positio
n-or-expression-start} IN THE ${clause-type} CLAUSE IS NOT VALID. REAS
ON CODE = ${reason-code}
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NO
T MATCH. PREDICATE OPERATOR IS ${operator}.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT
DEFINED PROPERLY
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INC
OMPLETE. OPTIONAL COLUMN ${column-name} IS MISSING
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE
USING ${cursor-name}
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-
name}
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-
name} HAS AN UNKNOWN POSITION (${sqlcode},${sqlstate})
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED
SELECT STATEMENT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR
CURSOR ${cursor-name}
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${nu
m-rows} WHICH IS NOT VALID WITH ${dimension}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR
${cursor-name}, BUT INDICATOR VARIABLES WERE NOT PROVIDED TO DETECT TH
E CONDITION
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} S
PECIFIED ROW ${n} OF A ROWSET, BUT THE ROW IS NOT CONTAINED WITHIN THE
CURRENT ROWSET
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTE
NT WITH THE FETCH ORIENTATION CLAUSE ${clause} SPECIFIED
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART
OBJECT NAME
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-numbe
r} IS NOT NUL-TERMINATED
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-num
ber} CANNOT BE USED AS SPECIFIED BECAUSE OF ITS DATA TYPE
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number}
IS INVALID OR TOO LARGE FOR THE TARGET COLUMN OR THE TARGET VALUE
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${positio
n-number} BECAUSE THE DATA TYPES ARE NOT COMPARABLE
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST V
ARIABLE BECAUSE THE VALUE IS NOT WITHIN THE RANGE OF THE HOST VARIABLE
IN POSITION ${position-number} WITH DATA TYPE ${data-type2}
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${
position-number} BECAUSE NO INDICATOR VARIABLE IS SPECIFIED
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE N
ULL VALUE
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL D
ATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGA
TIVE OR GREATER THAN THE MAXIMUM
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER O
F PARAMETER MARKERS
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE P
ARTITION RANGE FOR THE LAST PARTITION
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQ
UESTED BY ${reason-code} IS NOT SUPPORTED
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLI
CATION REQUESTOR TO A V2R2 DB2 SUBSYSTEM
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOT
HER OCCURRENCE OF A COMMON TABLE EXPRESSION DEFINITION WITHIN THE SAME
STATEMENT
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${na
me1} AND ${name2}
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRES
SION ${name}
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN T
HE FIRST FULLSELECT, AS A SECOND OCCURRENCE IN THE SAME FROM CLAUSE, O
R IN THE FROM CLAUSE OF A SUBQUERY
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-numbe
r} OF THE SELECT-LIST
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-numbe
r} OF THE INPUT-LIST
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTE
D
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVI
OUS FETCH
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT
DURING FINAL CALL PROCESSING
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number}
BUT THE VARIABLE IS NOT A LOB
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPA
RABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARA
CTER OR DATETIME DATA
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF IT
S OBJECT COLUMN
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${co
lumn-name} CANNOT CONTAIN NULL VALUES
-409 INVALID OPERAND OF A COUNT FUNCTION
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE
OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRI
NG
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE
OPERANDS OF THE SAME OPERATOR
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAME
TER MARKERS
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HA
VE A NEGATIVE SCALE
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function
-name} FUNCTION
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-#}
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE
NOT ALLOWED
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES A
RE NOT ALLOWED
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HA
S ABNORMALLY TERMINATED
-433 VALUE ${value} IS TOO LONG
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name}
CONTAINS AN INVALID FORMAT OF THE EXTERNAL NAME CLAUSE OR IS MISSING
THE EXTERNAL NAME CLAUSE
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER
${parmnum}, OVERLAYED STORAGE BEYOND ITS DECLARED LENGTH.
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION S
TATEMENT FOR ${function-name}
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${funct
ion-name} MATCHES THE SIGNATURE OF SOME OTHER FUNCTION ALREADY EXISTIN
G IN THE SCHEMA
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-n
ame1} PROVIDED FOR THE SPECIFIC NAME DOES NOT MATCH THE SCHEMA NAME ${
schema-name2} OF THE FUNCTION
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specif
ic-name} ALREADY EXISTS IN THE SCHEMA
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RE
SERVED FOR SYSTEM USE
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHIN
G FUNCTION COULD NOT BE FOUND
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE $
{target-data-type}
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMET
ER ${number}
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${num
ber}, BUT THE STORED PROCEDURE DOES NOT SUPPORT NULL VALUES.
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${
rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function
-name} (SPECIFIC NAME ${specific-name})
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM
PREDEFINED TYPE (BUILT-IN TYPE)
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO
THE RETURNS TYPE ${type-2} OF THE USER-DEFINED FUNCTION ${function-nam
e}
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATUR
E, BUT THE FUNCTION IS NOT UNIQUE WITHIN ITS SCHEMA
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE
OBJECT ${name} OF TYPE ${type2} IS DEPENDENT ON IT
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PA
RAMETERS DOES NOT MATCH THE NUMBER OF PARAMETERS OF THE SOURCE FUNCTIO
N
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT
WHEN THE DEFINITION OF THE FUNCTION OR PROCEDURE DID NOT SPECIFY THIS
ACTION
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE
THE RANGE OF ALLOWABLE VALUES IN THIS CONTEXT (${minval}, ${maxval})
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HA
VE A RETURNS CLAUSE AND: THE EXTERNAL CLAUSE WITH OTHER REQUIRED KEYWO
RDS; THE RETURN STATEMENT AND PARAMETER NAMES; OR THE SOURCE CLAUSE
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMET
ER NUMBER ${number}. IT MAY INVOLVE A MISMATCH WITH A SOURCE FUNCTION
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (
${estimate-amount2} SERVICE UNITS) IN COST CATEGORY ${cost-category} E
XCEEDS A RESOURCE LIMIT ERROR THRESHOLD OF ${limit-} ${amount} SERVICE
UNITS
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT
SET THAT WAS NOT CREATED BY THE CURRENT SERVER
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DAT
ABASE ${database-name}
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER
RESULT SET FROM PROCEDURE ${procedure-name}.
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDA
TE CLAUSE OF THE SELECT STATEMENT OF THE CURSOR
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSI
TIONED ON A ROW OR ROWSET THAT CAN BE UPDATED OR DELETED
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE S
AME TABLE DESIGNATED BY THE CURSOR
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMEN
T CANNOT BE MODIFIED
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REM
OTE ALIAS
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOE
S NOT IDENTIFY A PREPARED SELECT STATEMENT
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED
CURSOR ${cursor-name}
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INV
ALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR
MORE DEPENDENT ROWS IN RELATIONSHIP ${constraint-name}
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE
AFFECTED BY THE OPERATION
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE ID
ENTIFIES COLUMN ${column-name} MORE THAN ONCE
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT
KEY OF TABLE ${table-name}
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACK
S A PRIMARY INDEX OR A REQUIRED UNIQUE INDEX
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTR
AINT, OR A PARENT KEY BECAUSE IT CAN CONTAIN NULL VALUES
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRA
INT ${check-constraint} RESTRICTS THE DELETION
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT
BE ADDED BECAUSE AN EXISTING ROW VIOLATES THE CHECK CONSTRAINT
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATIS
FY THE CHECK CONSTRAINT ${check-constraint}
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${
object}_${name} BECAUSE THE BIND OPTION DYNAMICRULES(RUN) IS NOT IN EF
FECT FOR ${object}_${type2}
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${opera
tion} ON OBJECT ${object-name}
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${opera
tion}
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} R
EVOKED BY ${authid1} BECAUSE THE REVOKEE DOES NOT POSSESS THE PRIVILEG
E OR THE REVOKER DID NOT MAKE THE GRANT
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS AR
E ${keyword-list}
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE
= ${package-name} PRIVILEGE = ${privilege}
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED C
OLUMN NAMES
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS W
ITH THE DEFINITION OF COLUMN ${column-name}
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEF
INITION OF THE FUNCTION OR PROCEDURE DID NOT SPECIFY THIS ACTION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFIN
ITION OF THE FUNCTION OR PROCEDURE DID NOT SPECIFY THIS ACTION
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE N
OT COMPATIBLE
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFI
ED PREDICATE, IN PREDICATE, OR AN EXISTS PREDICATE.
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} S
PECIFIED A ROW OF A ROWSET, BUT THE CURSOR IS NOT POSITIONED ON A ROWS
ET
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT
${env-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column
-name}
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WH
ICH ARE DUPLICATES WITH RESPECT TO THE VALUES OF THE IDENTIFIED COLUMN
S
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR S
CALE ATTRIBUTE
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPAC
E IS TABLESPACE OR TABLE
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY
COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN C
ANNOT BE CHANGED BECAUSE THE SUM OF THE INTERNAL LENGTHS OF THE COLUMN
S FOR THE INDEX IS GREATER THAN THE ALLOWABLE MAXIMUM
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCE
D BY ${obj-type2} ${obj-name2}
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${da
tabase-name}
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS
NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENES
S OF THE PRIMARY OR UNIQUE KEY
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT S
TOPPED
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CON
TAIN NULL VALUES
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE
OF DELETE RULE RESTRICTIONS
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS
MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL C
ANNOT BE A COLUMN OF THE KEY OF A PARTITIONED INDEX
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE H
AS TYPE 1 INDEX
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${ta
ble-space-name} BECAUSE IT ALREADY CONTAINS A TABLE
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${pr
oc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NO
T AVAILABLE BECAUSE ITS PARTITIONED INDEX HAS NOT BEEN CREATED
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP W
OULD HAVE BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TAB
LE SPACE ${tspace-name} BECAUSE KEY LIMITS ARE NOT SPECIFIED
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE
NUMBER OF COLUMNS IN THE KEY OF INDEX ${index-name}
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN
PROGRESS
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLIC
ITLY DROPPED
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN ED
IT PROCEDURE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SP
ECIFIED BECAUSE IT WOULD CHANGE THE PAGE SIZE OF THE TABLE SPACE
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON T
HE OBJECT
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PR
OCEDURE. RT: ${return-code}, RS: ${reason-code}, MSG: ${message-token}
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE
${data-item} CONTAINS INCOMPATIBLE CLAUSES
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER
COLUMN WITH DIFFERENT FIELD PROCEDURE
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msg
no}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASO
N ${reason-code}
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE
${table-name} DOES NOT EXIST
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE O
F CORRELATION NAME OR TRANSITION TABLE NAME ${name}. REASON CODE=${rea
son-code}
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED W
ITH THE FOR EACH STATEMENT CLAUSE. OLD_TABLE OR NEW_TABLE NAMES ARE NO
T ALLOWED IN A TRIGGER WITH THE BEFORE CLAUSE.
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED
BECAUSE IT DEPENDS ON FUNCTIONS OF THE RELEASE FROM WHICH FALLBACK HA
S OCCURRED
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS R
ELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-
dependency-mark} FAILED BECAUSE ${object-type} DEPENDS ON FUNCTIONS OF
THE RELEASE FROM WHICH FALLBACK HAS OCCURRED
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmre
qd} IS INVALID
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} A
LREADY EXISTS
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH
VERSION = ${version2} BUT THIS VERSION ALREADY EXISTS
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT
UNIQUE SO IT CANNOT BE CREATED
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-nam
e} DOES NOT EXIST
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}.
INFORMATION RETURNED: SQLCODE: ${sqlerror}, SQLSTATE: ${sqlstate}, MES
SAGE TOKENS ${token-list}, SECTION NUMBER ${section-number}
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EX
CEED THE MAXIMUM LEVEL OF INDIRECT SQL CASCADING
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLI
ED AN INVALID VALUE
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE A
RE ENABLE OR DISABLE ENTRIES CURRENTLY ASSOCIATED WITH THE PACKAGE
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCE
SSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET
OF A NESTED CALL STATEMENT
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A
TABLE IN A READ-ONLY SHARED DATABASE
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,
3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATT
RIBUTE BUT THE TABLE SPACE OR INDEX SPACE HAS NOT BEEN DEFINED ON THE
OWNING SUBSYSTEM
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHAR
E READ DATABASE MUST BE CONSISTENT WITH ITS DESCRIPTION IN THE OWNER S
YSTEM
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE
READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARE
D DATABASE
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS
CANNOT MODIFY DATA WHEN THEY ARE PROCESSED IN PARALLEL.
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH
IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-
name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PR
OCEDURE ${name} VIOLATES THE NESTING SQL RESTRICTION
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND
INDEXES FOR ITS EXTERNALLY STORED COLUMNS HAVE BEEN CREATED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) A
TTEMPTED TO EXECUTE AN SQL STATEMENT ${statement} THAT IS NOT ALLOWED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE
CONNECTABLE STATE
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN TH
E SAME DATABASE
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUE
STED OPERATION IS NOT PERMITTED
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTI
TION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTIC
S OF THE BASE TABLE
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-t
ype} OPERATION ON ${data-type} DATA, POSITION ${position-number}
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR
THE SQL STATEMENT, REASON ${reason}
-805 DBRM OR PACKAGE NAME ${location-name.collection-id.dbrm-name.consis
tency-token} NOT FOUND IN PLAN ${plan-name}. REASON ${reason}
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FR
OM ${connection-type} ${connection-name}
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STAT
EMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SE
T CLAUSE OF AN UPDATE STATEMENT IS A TABLE OF MORE THAN ONE ROW, OR TH
E RESULT OF A SUBQUERY OF A BASIC PREDICATE IS MORE THAN ONE VALUE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID
WAS FOUND IN THE CURRENT PACKAGESET SPECIAL REGISTER WHILE TRYING TO
FORM A QUALIFIED PACKAGE NAME FOR PROGRAM ${program-name.consistency-t
oken} USING PLAN ${plan-name}
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED I
N A SUBSELECT OF A BASIC PREDICATE OR THE SET CLAUSE OF AN UPDATE STAT
EMENT
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RES
ULT IN A PROHIBITED UPDATE OPERATION.
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFF
ERENT FROM THE BIND TIMESTAMP ${y} BUILT FROM THE DBRM ${z}
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE I
N THE CATALOG IS ZERO
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONT
AINS A VALUE THAT IS NOT VALID IN THIS RELEASE
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE AD
DRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CO
NNECTION
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${ob
ject}_${type} ${object}_${name}. REASON CODE = ${reason}_${code}
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE N
UMBER OF DESCRIPTORS
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SA
ME AS THE CONTAINING TABLE SPACE OR OTHER PARAMETERS
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TA
BLE SPACE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN
, DISTINCT TYPE, FUNCTION OR STORED PROCEDURE PARAMETER AS MIXED OR GR
APHIC WITH ENCODING SCHEME ${encoding-scheme}
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CO
NTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SA
VEPOINT NAME CANNOT BE REUSED
-882 SAVEPOINT DOES NOT EXIST
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECL
UDE THE SUCCESSFUL EXECUTION OF SUBSEQUENT SQL STATEMENTS
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND
REQUIRED
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${
reason-code}, TYPE OF RESOURCE ${resource-type}, AND RESOURCE NAME ${r
esource-name}
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOUR
CE NAME = ${resource-name} LIMIT = ${limit-amount1} CPU SECONDS (${lim
it-amount2} SERVICE UNITS) DERIVED FROM ${limit-source}
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISAB
LED DUE TO A PRIOR ERROR
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO
-REBIND OPERATION IS NOT ALLOWED
-909 THE OBJECT HAS BEEN DELETED
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TI
MEOUT. REASON ${reason-code}, TYPE OF RESOURCE ${resource-type}, AND R
ESOURCE NAME ${resource-name}
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE $
{reason-code}, TYPE OF RESOURCE ${resource-type}, AND RESOURCE NAME ${
resource-name}
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN
LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code},
TYPE ${resource-type}, NAME ${resource-name}
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${
reason-code}
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONM
ENT WAS NOT ESTABLISHED. THE PROGRAM SHOULD BE INVOKED UNDER THE DSN C
OMMAND
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WIT
H DATA CAPTURE CHANGES, BUT THE DATA CANNOT BE PROPAGATED
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR
NOT LISTED IN THE COMMUNICATIONS DATABASE
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRA
M
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A S
TATE THAT ALLOWS SQL OPERATIONS, REASON ${reason-code}.
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO
DB2. RC1= ${rc1} RC2= ${rc2}
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AN
D EXTERNAL CLAUSES
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS N
OT EQUAL TO THE NUMBER OF EXPECTED HOST VARIABLE PARAMETERS. ACTUAL NU
MBER ${sqldanum}, EXPECTED NUMBER ${opnum}
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GREC
P
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TY
PE ${object-type}
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-nam
e} IS NOT VALID.
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${
column-name} IS NOT A LOB COLUMN
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REF
ERENCED IN EXISTING VIEW OR MATERIALIZED QUERY TABLE DEFINITIONS
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THR
EE CHARACTERS ARE RESERVED FOR SYSTEM OBJECTS
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING
IDENTITY COLUMN ATTRIBUTES CLAUSE
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIAL
IZED QUERY TABLE, OR THE MATERIALIZED QUERY TABLE PROPERTY CANNOT BE A
LTERED. REASON CODE = ${reason-code}.
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMA
TION RETURNED: SECTION NUMBER : ${section-number} SQLCODE ${sqlerror},
SQLSTATE ${sqlstate}, AND MESSAGE TOKENS ${token-list}
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED T
HE ${option} OPTION WHICH IS NOT ALLOWED FOR THE TYPE OF ROUTINE
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAI
LED
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE US
ED AS SPECIFIED BECAUSE REASON ${reason}
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER
${position-number} FOR CURSOR ${cursor-name} OPENED BY STORED PROCEDU
RE ${procedure-name}
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTST
ANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT
FROM A TRIGGER, FROM A USER-DEFINED FUNCTION, OR FROM A GLOBAL TRANSAC
TION
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT S
ET RETURNED FOR CURSOR ${cursor} IS SCROLLABLE, BUT THE CURSOR IS NOT
POSITIONED BEFORE THE FIRST ROW
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT
THE CLIENT DOES NOT SUPPORT THIS
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT S
ET FOR CURSOR ${cursor} IS SCROLLABLE, BUT THE CLIENT DOES NOT SUPPORT
THIS
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT IN
VOLVES A HOP SITE
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TO
O LARGE FOR DRDA
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT
CONTAINING AN INSERT STATEMENT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND
SCALE THAT IS NOT AS LARGE AS THE EXISTING PRECISION AND SCALE
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT
THIS CHANGE IS DISALLOWED
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS
SPECIFIED
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLA
USE WAS SPECIFIED THAT IS VALID ONLY WITH ROWSET ACCESS
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH
AN INVALID SIGNATURE. THE ERROR IS AT OR NEAR PARAMETER ${number}. TH
E SIGNATURE IS ${signature}.
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE
TO MAP TO A SINGLE JAVA METHOD
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLO
YMENT DESCRIPTOR.
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression
}
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. RE
ASON CODE = ${reason-code}.
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL N
OT AFFECT THE SUCCESSFUL EXECUTION OF SUBSEQUENT COMMANDS OR SQL STATE
MENTS: REASON ${reason-code} (${sub-code})
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN
A CHAIN OF STATEMENTS
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL A
FFECT THE SUCCESSFUL EXECUTION OF SUBSEQUENT COMMANDS OR SQL STATEMENT
S: MANAGER ${manager} AT LEVEL ${level} NOT SUPPORTED ERROR
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATIO
N HAS BEEN DETECTED, THE CONVERSATION HAS BEEN DEALLOCATED. ORIGINAL S
QLCODE=${original-sqlcode} AND ORIGINAL SQLSTATE=${original-sqlstate}
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFEC
T THE SUCCESSFUL EXECUTION OF SUBSEQUENT COMMANDS OR SQL STATEMENTS. R
EASON ${reason-code} TYPE OF RESOURCE ${resource-type} RESOURCE NAME $
{resource-name} PRODUCT ID ${pppvvrrm} RDBNAME ${rdbname}
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NO
T ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-st
ring})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION.
INSERT PROCESSING IS TERMINATED
>>>>> sqlCodes V8 V9 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*/
/*<<< sqlCodes V8 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE,
OR ANY TABLE IDENTIFIED IN A FROM CLAUSE
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF
THE CURRENT ROW
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © RE
QUIRED BECAUSE AT LEAST ONE OF THE COLUMNS BEING DESCRIBED IS A DISTIN
CT TYPE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STR
ING CANNOT BE TRANSLATED. REASON ${reason-code}, CHARACTER ${code-poin
t}, HOST VARIABLE ${position-number}
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reas
on-code}). THE OPTIMIZATION HINTS ARE IGNORED.
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET $
{special-register}
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL
VALUES
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED IND
EX ${index-name} EXCEEDS THE LENGTH IMPOSED BY DB2
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW C
ACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAME
TER. THE SPECIAL REGISTER ’OPTIMIZATION HINT’ IS SET TO THE DEFAULT VA
LUE OF BLANKS.
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOL
ATION HAS BEEN DETECTED. ORIGINAL SQLCODE=${original-sqlcode} AND ORIG
INAL SQLSTATE=${original-sqlstate}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE
SESSION, NOT ${qualifier}
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION O
R A SCALAR FULLSELECT
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP
BY CLAUSE
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS I
NVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UP
DATE OR SET TRANSITION VARIABLE STATEMENT
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME A
ND A${n} AGGREGATE FUNCTION IN THE SELECT CLAUSE OR A COLUMN NAME IS C
ONTAINED IN THE SELECT CLAUSE BUT NOT IN THE GROUP BY CLAUSE
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION
THAT RESOLVES TO A LONG STRING
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN
4000 BYTES
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CAN
NOT BE ALTERED
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SY
STEM-MAINTAINED MATERIALIZED QUERY TABLE, OR TRANSITION TABLE FOR WHIC
H THE REQUESTED OPERATION IS NOT PERMITTED
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF
COLUMN ${column-name} INDICATES THAT IT CANNOT BE UPDATED
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${obj
ect-type1} RATHER THAN A(N) ${object-type2}
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECA
USE THE MVS TOD CLOCK IS BAD OR THE MVS PARMTZ IS OUT OF RANGE
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name.column-name
} ARE NOT COMPATIBLE WITH THE EXISTING COLUMN
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION
OR UNION ALL SPECIFIED
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE,
OR ANY TABLE IDENTIFIED IN A FROM CLAUSE, OR IS NOT A COLUMN OF THE T
RIGGERING TABLE OF A TRIGGER
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${
cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR
IS NOT DEFINED AS SCROLL
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT T
HAT IS LOCALE SENSITIVE WAS NOT FOUND
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIE
D MORE THAN ONCE IN THE LIST OF OBJECTS.
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS US
ED IN A DYNAMIC SQL STATEMENT OR A TRIGGER DEFINITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${r
eason-code}, CHARACTER ${code-point}, HOST VARIABLE ${position-number}
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE
TRANSLATED. REASON ${reason-code}, CHARACTER ${code-point}, POSITION
${position-number}
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNO
WN AT BIND TIME AND THE DIFFERENCE CANNOT BE RESOLVED BY TRANSLATION
-336 The decimal number is used in a context where the scale must be zer
o. This can occur when a decimal number is specified in a CREATE or AL
TER SEQUENCE statement for START WITH, INCREMENT BY, MINVALUE, MAXVALU
E, or RESTART WITH.
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND
MUST USE UNION ALL BECAUSE IT IS RECURSIVE
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA T
YPES OR LENGTHS FOR COLUMN ${column-name}
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUS
T BE THE UNION OF TWO OR MORE FULLSELECTS AND CANNOT INCLUDE COLUMN FU
NCTIONS, GROUP BY CLAUSE, HAVING CLAUSE, OR AN EXPLICIT JOIN INCLUDING
AN ON CLAUSE
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN
THIS CONTEXT
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS N
OT VALID IN THE CONTEXT IN WHICH IT OCCURS
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW I
D OR DISTINCT TYPE BASED ON A ROW ID
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE
IT IS OUT OF RANGE
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACT
ERS
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A U
NION OR A UNION ALL DO NOT HAVE COMPARABLE COLUMN DESCRIPTIONS
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF
COLUMNS
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_
ERROR OR IN A SIGNAL SQLSTATE STATEMENT
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE AR
GUMENTS WAS FOUND
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-
name}
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-
name} CONTAINS DATA TYPE ${type} WHICH IS NOT APPROPRIATE FOR AN EXTER
NAL FUNCTION WRITTEN IN THE GIVEN LANGUAGE
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNA
TED BY THE CURSOR CANNOT BE MODIFIED
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STAT
EMENT
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIN
D TIME FOR SECTION = ${sectno} PACKAGE = ${pkgname} CONSISTENCY TOKEN
= X'${contoken}'
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type}
TEMPORARY TABLE ${table} ${name}
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW W
ITH RID X'${rid-number}'
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT D
ETERMINISTIC OR HAS AN EXTERNAL ACTION
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SE
T ${special-register} STATEMENT
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED
254 CHARACTERS
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR RO
UTINE ${routine-name}
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${colu
mn-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STAT
EMENT IS IDENTICAL TO THE EXISTING NAME ${name} OF THE OBJECT TYPE ${o
bj-type}
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEME
NT
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FO
R A ${space} ${type} SPACE IN THE ${database} ${type} DATABASE
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRA
INT WITH SPECIFIED COLUMNS
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED
DATA SETS
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED I
N ASCENDING OR DESCENDING ORDER
-637 DUPLICATE ${keyword} KEYWORD
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STAT
EMENT
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN A
CTIVATED
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${
tspace-name} BECAUSE THE NUMBER OF PART SPECIFICATIONS IS NOT EQUAL TO
THE NUMBER OF PARTITIONS OF THE TABLE SPACE
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SP
ACE ${tspace-name}
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFO
RM TO THE DATA TYPE ${data-type} OF THE CORRESPONDING COLUMN ${column-
name}
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${tabl
e-name} (${index-name}) IS NOT DEFINED PROPERLY
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON T
HE DDL REGISTRATION TABLE ${table-name}
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REF
ERENCED IN EXISTING VIEW, MATERIALIZED QUERY TABLE, OR TRIGGER DEFINIT
IONS
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A R
OWID COLUMN
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TR
IGGERED SQL STATEMENT
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OP
TION GENERATED ALWAYS COLUMN ${column-name}
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX
SPACE ${indexspace-name} CONSTRAINS COLUMNS OF THE TABLE SO NO TWO ROW
S CAN CONTAIN DUPLICATE VALUES IN THOSE COLUMNS. RID OF EXISTING ROW I
S X${rid}
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION G
ENERATES A VALUE IN THE CURRENT SESSION FOR SEQUENCE ${sequence-name}
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED I
N THE SAME SQL STATEMENT
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCES
S IS NOT CONNECTED TO AN APPLICATION SERVER
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER
IS PENDING
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${
table-name} THAT WAS INSERTED BY AN INSERT STATEMENT WITHIN A SELECT S
TATEMENT
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE C
ORRESPONDING LENGTH OF THE PARTITIONING LIMIT KEY EXCEEDS THE SYSTEM L
IMIT
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name
} ${column} IS MIXED DATA, OR THE DATA TYPE OR LENGTH SPECIFIED DOES N
OT AGREE WITH THE EXISTING DATA TYPE OR LENGTH.
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED
OR IS NOT USABLE
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZER
O -${skel}
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS
SPECIFIED
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id}
AUTHORITY OPERATION IS NOT ALLOWED ON A TRIGGER PACKAGE ${package-nam
e}
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE T
HE TABLE SPACE OR DATABASE ALREADY CONTAINS A TABLE THAT IS REFERENCED
IN EXISTING VIEW DEFINITIONS
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN
WHICH IT WAS SPECIFIED
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHIC
H IS NOT A SYMMETRIC VIEW
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${ind
ex-name} IS NOT VALID
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLA
USE SPECIFIED ON CREATE OR ALTER FOR ${name} IS NOT VALID
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING
PREPARED OR EXECUTED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO
REASON ${reason-code} (${reason-string}).
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASO
N ${reason-code} (${reason-string})
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL TH
AT IS INCOMPATIBLE WITH THE CURRENT VALUE OF THE ENCODING BIND OPTION
OR SPECIAL REGISTER
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING
TO LOAD JAVA CLASS ${class-name} FROM JAR ${jar-name}. ORIGINAL EXCEPT
ION: ${exception-string}.
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT
SET OF AN INVALID CLASS. PARAMETER ${number} IS NOT A DB2 RESULT SET
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN
ID-${token} BUT THE REQUIRED EXPLAIN INFORMATION IS NOT ACCESSIBLE.
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-cod
e}.
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LO
CATION ${location} PRODUCT ID ${pppvvrr} REASON CODE ${reason-code} ($
{sub-code})
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED
DEALLOCATION OF THE CONVERSATION: REASON <${reason-code} (${sub-code}
)>
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER
WHICH CAUSED TERMINATION OF THE CONNETION: LOCATION ${location} PRODUC
T ID ${pppvvrr} REASON CODE ${reason-code} (${sub-code})
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT TH
E SUCCESSFUL EXECUTION OF SUBSEQUENT COMMANDS AND SQL STATEMENTS. REAS
ON <${reason-code}> TYPE OF RESOURCE <${resource-type}> RESOURCE NAME
<${resource-name}> PRODUCT ID <${pppvvrrm}> RDBNAME <${rdbname}>
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALI
D WHILE BIND PROCESS IN PROGRESS
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}
, FUNCTION=${func}, ERROR CODES=${rc1} ${rc2} ${rc3}
>>>>> sqlCodes V8 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*/
/*<<< sqlCodes V9 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE,
MERGED TABLE, OR ANY TABLE IDENTIFIED IN A FROM CLAUSE
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR THE SPEC
IFIED FETCH ORIENTATION OF THE CURRENT ROW OR ROWSET
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQU
IRED BECAUSE AT LEAST ONE OF THE COLUMNS BEING DESCRIBED IS A DISTINCT
TYPE
+252 A NON-ATOMIC ${statement} STATEMENT SUCCESSFULLY PROCESSED ALL REQU
ESTED ROWS, WITH ONE OR MORE WARNING CONDITIONS
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE OR PARAMETER BE
CAUSE THE STRING CANNOT BE CONVERTED FROM ${source-ccsid} TO ${target-
ccsid}. REASON ${reason-code}, POSITION ${position-number}
+354 A ROWSET FETCH STATEMENT MAY HAVE RETURNED ONE OR MORE ROWS OF DATA
. HOWEVER, ONE OR MORE WARNING CONDITIONS WERE ALSO ENCOUNTERED. USE T
HE GET DIAGNOSTICS STATEMENT FOR MORE INFORMATION REGARDING THE CONDIT
IONS THAT WERE ENCOUNTERED
+361 COMMAND WAS SUCCESSFUL BUT RESULTED IN THE FOLLOWING: ${msg-token}
+364 DECFLOAT EXCEPTION ${exception-type} HAS OCCURRED DURING ${operatio
n-type} OPERATION, POSITION ${position-number}
+385 ASSIGNMENT TO AN SQLSTATE OR SQLCODE VARIABLE IN AN SQL ROUTINE ${r
outine-name} MAY BE OVERWRITTEN AND DOES NOT ACTIVATE ANY HANDLER
+394 ALL USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELEC
TION
+395 A USER SPECIFIED OPTIMIZATION HINT IS INVALID (REASON CODE = ${reas
on-code})
+434 ${clause} IS A DEPRECATED CLAUSE
+438 APPLICATION RAISED WARNING WITH DIAGNOSTIC TEXT: ${text}
+440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE AR
GUMENTS WAS FOUND
+585 THE COLLECTION ${collection-id} APPEARS MORE THAN ONCE WHEN SETTING
THE ${special-register} SPECIAL REGISTER
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL
VALUES OR THE INDEX IS AN XML INDEX
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS SPECIFIED IN THE PARTIT
ION CLAUSE OF THE ${statement-name} STATEMENT EXCEEDS THE EXISTING INT
ERNAL LIMIT KEY LENGTH STORED IN CATALOG TABLE ${table-name}
+20002 THE ${clause} SPECIFICATION IS IGNORED FOR OBJECT ${object-name}
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAME
TER. THE SPECIAL REGISTER ’OPTIMIZATION HINT’ IS SET TO AN EMPTY STRIN
G.
+20141 TRUNCATION OF VALUE WITH LENGTH ${length} OCCURRED FOR ${hv-or-pa
rm-number}
+20187 ROLLBACK TO SAVEPOINT CAUSED A NOT LOGGED TABLE SPACE TO BE PLACE
D IN THE LPL
+20237 FETCH PRIOR ROWSET FOR CURSOR ${cursor-name} RETURNED A PARTIAL R
OWSET
+20245 NOT PADDED CLAUSE IS IGNORED FOR INDEXES CREATED ON AUXILIARY TAB
LES
+20270 OPTION NOT SPECIFIED FOLLOWING ALTER PARTITION CLAUSE
+20272 TABLE SPACE ${table-space-name} HAS BEEN CONVERTED TO USE TABLE-C
ONTROLLED PARTITIONING INSTEAD OF INDEX-CONTROLLED PARTITIONING, ADDIT
IONAL INFORMATION: ${old-limit-key-value}
+20348 THE PATH VALUE HAS BEEN TRUNCATED.
+20360 TRUSTED CONNECTION CAN NOT BE ESTABLISHED FOR SYSTEM AUTHID ${aut
horization-name}
+20365 A SIGNALING NAN WAS ENCOUNTERED, OR AN EXCEPTION OCCURRED IN AN A
RITHMETIC OPERATION OR FUNCTION INVOLVING A DECFLOAT.
+20367 OPTION ${clause} IS NOT SUPPORTED IN THE CONTEXT IN WHICH IT WAS
SPECIFIED
+20368 TRUSTED CONTEXT ${context-name} IS NO LONGER DEFINED TO BE USED B
Y SPECIFIC VALUES FOR ATTRIBUTE ${attribute-name}
+20371 THE ABILITY TO USE TRUSTED CONTEXT ${context-name} WAS REMOVED FR
OM SOME, BUT NOT ALL AUTHORIZATION IDS SPECIFIED IN THE STATEMENT.
+20378 A NON-ATOMIC ${statement} STATEMENT SUCCESSFULLY COMPLETED FOR SO
ME OF THE REQUESTED ROWS, POSSIBLY WITH WARNINGS, AND ONE OR MORE ERRO
RS, AND THE CURSOR CAN BE USED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOL
ATION HAS BEEN DETECTED. ORIGINAL SQLCODE=${original-sqlcode} AND ORIG
INAL SQLSTATE=${original-sqlstateError} SQL ${codes}
-011 COMMENT NOT CLOSED
-051 ${name} (${sqltype}) WAS PREVIOUSLY DECLARED OR REFERENCED
-056 AN SQLSTATE OR SQLCODE VARIABLE DECLARATION IS IN A NESTED COMPOUND
STATEMENT
-058 VALUE SPECIFIED ON RETURN STATEMENT MUST BE AN INTEGER
-078 PARAMETER NAMES MUST BE SPECIFIED FOR ROUTINE ${routine-name}
-079 QUALIFIER FOR OBJECT ${name} WAS SPECIFIED AS ${qualifier1} ${but}
${qualifier2} IS REQUIRED
-087 A NULL VALUE WAS SPECIFIED IN A CONTEXT WHERE A NULL IS NOT ALLOWED
-096 VARIABLE ${variable-name} DOES NOT EXIST OR IS NOT SUPPORTED BY THE
SERVER AND A DEFAULT VALUE WAS NOT PROVIDED
-101 THE STATEMENT IS TOO LONG OR TOO COMPLEX
-102 STRING CONSTANT IS TOO LONG. STRING BEGINS ${string}
-103 ${constant} IS AN INVALID NUMERIC CONSTANT
-110 INVALID HEXADECIMAL CONSTANT BEGINNING ${constant}
-112 THE OPERAND OF AN AGGREGATE FUNCTION INCLUDES AN AGGREGATE FUNCTION
, AN OLAP SPECIFICATION, OR A SCALAR FULLSELECT
-113 INVALID CHARACTER FOUND IN: ${string}, REASON CODE ${nnn}
-119 A COLUMN OR EXPRESSION IN A HAVING CLAUSE IS NOT VALID
-120 AN AGGREGATE FUNCTION OR OLAP SPECIFICATION IS NOT VALID IN THE CON
TEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UP
DATE OPERATION OR SET TRANSITION VARIABLE STATEMENT
-122 COLUMN OR EXPRESSION IN THE SELECT LIST IS NOT VALID
-127 DISTINCT IS SPECIFIED MORE THAN ONCE IN A SUBSELECT
-134 IMPROPER USE OF A STRING, LOB, OR XML VALUE
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH TOO LONG
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR OR SUBSTRING FUNCTION IS
OUT OF RANGE
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS OR
NOT FENCED EXTERNAL FUNCTION CANNOT BE ALTERED
-148 THE SOURCE TABLE ${source-name} CANNOT BE ALTERED, REASON ${reason-
code}
-150 THE OBJECT OF THE INSERT, DELETE, UPDATE, MERGE, OR TRUNCATE STATEM
ENT IS A VIEW, SYSTEM-MAINTAINED MATERIALIZED QUERY TABLE, OR TRANSITI
ON TABLE FOR WHICH THE REQUESTED OPERATION IS NOT PERMITTED
-151 THE UPDATE OPERATION IS INVALID BECAUSE THE CATALOG DESCRIPTION OF
COLUMN ${column-name} INDICATES THAT IT CANNOT BE UPDATED
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES AN ${objec
t-type} RATHER THAN AN ${expected-object-type}
-160 THE WITH CHECK OPTION CLAUSE IS NOT VALID FOR THE SPECIFIED VIEW
-187 A REFERENCE TO A CURRENT DATETIME SPECIAL REGISTER IS INVALID BECAU
SE THE MVS TOD CLOCK IS BAD OR THE MVS PARMTZ IS OUT OF RANGE
-189 CCSID ${ccsid} IS INVALID
-190 THE ATTRIBUTES SPECIFIED FOR THE COLUMN ${table-name.column-name} A
RE NOT COMPATIBLE WITH THE EXISTING COLUMN DEFINITION
-197 A QUALIFIED COLUMN NAME IS NOT ALLOWED IN THE ORDER BY CLAUSE WHEN
A SET OPERATOR IS ALSO SPECIFIED
-206 ${name} IS NOT VALID IN THE CONTEXT WHERE IT IS USED
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING CU
RSOR ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID FOR THE DECLARATION
OF THE CURSOR
-229 THE LOCALE ${locale} SPECIFIED IN A SET LC_CTYPE OR OTHER STATEMENT
THAT IS LOCALE SENSITIVE WAS NOT FOUND
-240 THE PARTITION CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIE
D MORE THAN ONCE IN THE LIST OF OBJECTS, OR THE NAME IS THE SAME AS AN
EXISTING OBJECT
-245 THE INVOCATION OF FUNCTION ${routine-name} IS AMBIGUOUS
-253 A NON-ATOMIC ${statement} STATEMENT SUCCESSFULLY COMPLETED FOR SOME
OF THE REQUESTED ROWS, POSSIBLY WITH WARNINGS, AND ONE OR MORE ERRORS
-254 A NON-ATOMIC ${statement} STATEMENT ATTEMPTED TO PROCESS MULTIPLE R
OWS OF DATA, BUT ERRORS OCCURRED
-312 VARIABLE ${variable-name} IS NOT DEFINED OR NOT USABLE
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE PROCESSED. REASON ${re
ason-code}, CHARACTER ${code-point}, HOST VARIABLE ${position-number}
-331 CHARACTER CONVERSION CANNOT BE PERFORMED BECAUSE A STRING, POSITION
${position-number}, CANNOT BE CONVERTED FROM ${source-ccsid} TO ${tar
get-ccsid}, REASON ${reason-code}
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNO
WN AT BIND TIME AND THE DIFFERENCE CANNOT BE RESOLVED BY CHARACTER CON
VERSION
-336 THE SCALE OF THE DECIMAL NUMBER MUST BE ZERO
-342 THE COMMON TABLE EXPRESSION ${name} MUST NOT USE SELECT DISTINCT AN
D MUST USE UNION ALL BECAUSE IT IS RECURSIVE
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA T
YPES OR LENGTHS OR CODE PAGE FOR COLUMN ${column-name}
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUS
T BE A UNION ALL AND MUST NOT INCLUDE AGGREGATE FUNCTIONS, GROUP BY CL
AUSE, HAVING CLAUSE, OR AN EXPLICIT JOIN INCLUDING AN ON CLAUSE
-348 ${sequence-expression} CANNOT BE SPECIFIED IN THIS CONTEXT
-350 ${column-name} WAS IMPLICITLY OR EXPLICITLY REFERENCED IN A CONTEXT
IN WHICH IT CANNOT BE USED
-353 FETCH IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HAS AN UNKNOWN
POSITION
-354 A ROWSET FETCH STATEMENT MAY HAVE RETURNED ONE OR MORE ROWS OF DATA
. HOWEVER, ONE OR MORE NON-TERMINATING ERROR CONDITIONS WERE ENCOUNTER
ED. USE THE GET DIAGNOSTICS STATEMENT FOR MORE INFORMATION REGARDING T
HE CONDITIONS THAT WERE ENCOUNTERED
-356 KEY EXPRESSION ${key-expr-num} IS NOT VALID, REASON CODE = ${reason
-code}
-372 ONLY ONE ROWID, IDENTITY, OR SECURITY LABEL COLUMN IS ALLOWED IN A
TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR COLUMN OR SQL VARIABLE ${name}
-374 THE CLAUSE ${clause} HAS NOT BEEN SPECIFIED IN THE CREATE OR ALTER
FUNCTION STATEMENT FOR LANGUAGE SQL FUNCTION ${function-name} BUT AN E
XAMINATION OF THE FUNCTION BODY REVEALS THAT IT SHOULD BE SPECIFIED
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS N
OT VALID IN THE CONTEXT WHERE IT IS USED
-397 GENERATED IS SPECIFIED AS PART OF A COLUMN DEFINITION, BUT IT IS NO
T VALID FOR THE DEFINITION OF THE COLUMN
-399 INVALID VALUE ROWID WAS SPECIFIED
-405 THE NUMERIC CONSTANT ${constant} CANNOT BE USED AS SPECIFIED BECAUS
E IT IS OUT OF RANGE
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET. TARGE
T NAME IS ${name}
-410 A NUMERIC VALUE ${value} IS TOO LONG, OR IT HAS A VALUE THAT IS NOT
WITHIN THE RANGE OF ITS DATA TYPE
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A S
ET OPERATOR ARE NOT COMPATIBLE
-416 AN OPERAND OF A SET OPERATOR CONTAINS A LONG STRING COLUMN
-421 THE OPERANDS OF A SET OPERATOR DO NOT HAVE THE SAME NUMBER OF COLUM
NS
-431 ROUTINE ${routine-name} (SPECIFIC NAME ${specific-name}) OF TYPE ${
routine-type} HAS BEEN INTERRUPTED BY THE USER
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN A RAISE_ERROR FUNCT
ION, RESIGNAL STATEMENT, OR SIGNAL STATEMENT
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE AR
GUMENTS WAS FOUND IN THE CURRENT PATH
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH FUNCTION ${function-name}
-443 ROUTINE ${routine-name} (SPECIFIC NAME ${specific-name}) HAS RETURN
ED AN ERROR SQLSTATE WITH DIAGNOSTIC TEXT ${msg-text}
-451 THE ${data-item} DEFINITION IN THE CREATE OR ALTER STATEMENT FOR ${
routine-name} CONTAINS DATA TYPE ${type} WHICH IS NOT SUPPORTED FOR TH
E TYPE AND LANGUAGE OF THE ROUTINE
-452 UNABLE TO ACCESS THE FILE REFERENCED BY HOST VARIABLE ${variable-po
sition}. REASON CODE: ${reason-code}
-504 CURSOR NAME ${cursor-name} IS NOT DECLARED
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE RESULT TABLE
DESIGNATED BY THE SELECT STATEMENT CANNOT BE MODIFIED
-516 THE DESCRIBE STATEMENT DOES NOT SPECIFY A PREPARED STATEMENT
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIN
D TIME FOR SECTION = ${sectno} PACKAGE = ${pkgname} CONSISTENCY TOKEN
= ${contoken}
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table-type} TE
MPORARY TABLE ${table-name}
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW W
ITH RID X ${rid-number}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS FOR
REQUESTED OPERATION
-554 AN AUTHORIZATION ID OR ROLE CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID OR ROLE CANNOT REVOKE A PRIVILEGE FROM ITSELF
-575 VIEW ${view-name} CANNOT BE REFERENCED
-583 THE USE OF FUNCTION OR EXPRESSION ${name} IS INVALID BECAUSE IT IS
NOT DETERMINISTIC OR HAS AN EXTERNAL ACTION
-584 INVALID USE OF NULL
-585 THE COLLECTION ${collection-id} APPEARS MORE THAN ONCE IN THE SET $
{special-register} STATEMENT
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED
2048 CHARACTERS
-590 NAME ${name} IS NOT UNIQUE IN THE CREATE OR ALTER FOR ROUTINE ${rou
tine-name}
-593 NOT NULL MUST BE SPECIFIED FOR ROWID (OR DISTINCT TYPE FOR ROWID) O
R ROW CHANGE TIMESTAMP COLUMN ${column-name}
-601 THE NAME (VERSION OR VOLUME SERIAL NUMBER) OF THE OBJECT TO BE DEFI
NED OR THE TARGET OF A RENAME STATEMENT IS IDENTICAL TO THE EXISTING N
AME (VERSION OR VOLUME SERIAL NUMBER) ${name} OF THE OBJECT TYPE ${obj
-type}
-602 TOO MANY COLUMNS OR KEY-EXPRESSIONS SPECIFIED IN A CREATE INDEX OR
ALTER INDEX STATEMENT
-612 ${identifier} IS A DUPLICATE NAME
-620 KEYWORD ${keyword} IN ${stmt-type} STATEMENT IS NOT PERMITTED FOR A
${space-type} SPACE IN THE ${database-type} DATABASE
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE CONSTRAINT
WITH SPECIFIED COLUMNS
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE TABLE SPACE OR INDEX HAS
USER-MANAGED DATA SETS
-636 RANGES SPECIFIED FOR PARTITION ${part-num} ARE NOT VALID
-637 DUPLICATE ${keyword} KEYWORD OR CLAUSE
-643 A CHECK CONSTRAINT OR THE VALUE OF AN EXPRESSION FOR A COLUMN OF AN
INDEX EXCEEDS THE MAXIMUM ALLOWABLE LENGTH KEY EXPRESSION
-644 INVALID VALUE SPECIFIED FOR KEYWORD OR CLAUSE ${keyword-or-clause}
IN STATEMENT ${stmt-type}
-647 BUFFERPOOL ${bp-name} FOR IMPLICIT OR EXPLICIT TABLESPACE OR INDEXS
PACE ${name} HAS NOT BEEN ACTIVATED
-661 ${object-type} ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE
SPACE ${tspace-name} BECAUSE THE NUMBER OF PARTITION SPECIFICATIONS I
S NOT EQUAL TO THE NUMBER OF PARTITIONS OF THE TABLE SPACE
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED, PARTITI
ON-BY-GROWTH OR RANGE-PARTITIONED UNIVERSAL TABLE SPACE ${tspace-name}
-665 THE PARTITION CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-676 THE PHYSICAL CHARACTERISTICS OF THE INDEX ARE INCOMPATIBLE WITH RES
PECT TO THE SPECIFIED STATEMENT. THE STATEMENT HAS FAILED. REASON ${re
ason-code}
-678 THE CONSTANT ${constant} SPECIFIED FOR THE INDEX LIMIT KEY MUST CON
FORM TO THE DATA TYPE ${data-type} OF THE CORRESPONDING COLUMN ${colum
n-name}
-684 THE LENGTH OF CONSTANT LIST BEGINNING ${string} IS TOO LONG
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${name
} IS NOT DEFINED PROPERLY
-694 THE SCHEMA STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING O
N THE DDL REGISTRATION TABLE ${table-name}
-695 INVALID VALUE ${seclabel} SPECIFIED FOR SECURITY LABEL COLUMN OF TA
BLE ${table-name}
-713 THE REPLACEMENT VALUE FOR ${special-register} IS INVALID
-748 AN INDEX ${index-name} ALREADY EXISTS ON AUXILIARY TABLE ${table-na
me}
-750 THE SOURCE TABLE ${table-name} CANNOT BE RENAMED BECAUSE IT IS REFE
RENCED IN EXISTING VIEW, MATERIALIZED QUERY TABLE, OR TRIGGER DEFINITI
ONS, IS A CLONE TABLE, OR HAS A CLONE TABLE DEFINED FOR IT
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A R
OWID, OR AN XML COLUMN UNLESS IT ALSO HAS A DOCID COLUMN
-773 CASE NOT FOUND FOR CASE STATEMENT
-776 USE OF CURSOR ${cursor-name} IS NOT VALID
-778 ENDING LABEL ${label} DOES NOT MATCH THE BEGINNING LABEL
-779 LABEL ${label} SPECIFIED ON A GOTO, ITERATE, OR LEAVE STATEMENT IS
NOT VALID
-780 UNDO SPECIFIED FOR A HANDLER
-781 CONDITION ${condition-name} IS NOT DEFINED OR THE DEFINITION IS NOT
IN SCOPE
-782 A CONDITION OR SQLSTATE ${value} SPECIFIED IS NOT VALID
-783 SELECT LIST FOR CURSOR ${cursor-name} IN FOR STATEMENT IS NOT VALID
. COLUMN ${column-name} IS NOT UNIQUE
-785 USE OF SQLCODE OR SQLSTATE IS NOT VALID
-787 RESIGNAL STATEMENT ISSUED OUTSIDE OF A HANDLER
-788 THE SAME ROW OF TARGET TABLE ${table-name} WAS IDENTIFIED MORE THAN
ONCE FOR AN UPDATE OPERATION OF THE MERGE STATEMENT
-789 THE DATA TYPE FOR THE VARIABLE ${name} IS NOT SUPPORTED IN THE SQL
ROUTINE
-797 THE TRIGGER ${trigger-name} IS DEFINED WITH AN UNSUPPORTED TRIGGERE
D SQL STATEMENT
-798 A VALUE CANNOT BE SPECIFIED FOR COLUMN ${column-name} WHICH IS DEFI
NED AS GENERATED ALWAYS
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX
SPACE ${indexspace-name} CONSTRAINS COLUMNS OF THE TABLE SO NO TWO ROW
S CAN CONTAIN DUPLICATE VALUES IN THOSE COLUMNS. RID OF EXISTING ROW I
S X ${rid}
-845 A PREVIOUS VALUE EXPRESSION CANNOT BE USED BEFORE THE NEXT VALUE EX
PRESSION GENERATES A VALUE IN THE CURRENT APPLICATION PROCESS FOR SEQU
ENCE ${sequence-name}
-873 THE STATEMENT REFERENCED DATA ENCODED WITH DIFFERENT ENCODING SCHEM
ES OR CCSIDS IN AN INVALID CONTEXT
-876 ${object} CANNOT BE CREATED OR ALTERED, REASON ${reason}
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCES
S IS NOT CONNECTED TO A SERVER
-907 AN ATTEMPT WAS MADE TO MODIFY THE TARGET TABLE, ${table-name}, OF T
HE MERGE STATEMENT BY CONSTRAINT OR TRIGGER ${name}
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH UNCOMMITTED CHAN
GES ARE PENDING
-951 OBJECT ${object-name} OBJECT TYPE ${object-type} IS IN USE AND CANN
OT BE THE TARGET OF THE SPECIFIED ALTER STATEMENT
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${
table-name} THAT WAS MODIFIED BY AN SQL DATA CHANGE STATEMENT WITHIN A
FROM CLAUSE
-992 PACKAGE ${package-name} CANNOT BE EXECUTED OR DEPLOYED ON LOCATION
${location-name}
-1403 THE USERNAME AND/OR PASSWORD SUPPLIED IS INCORRECT
-4302 JAVA STORED PROCEDURE OR USER-DEFINED FUNCTION ${routine-name} (SP
ECIFIC NAME ${specific-name}) HAS EXITED WITH AN EXCEPTION ${exception
-string}
-4701 THE NUMBER OF PARTITIONS, OR THE COMBINATION OF THE NUMBER OF TABL
E SPACE PARTITIONS AND THE CORRESPONDING LENGTH OF THE PARTITIONING LI
MIT KEY EXCEEDS THE SYSTEM LIMIT
-4702 THE MAXIMUM NUMBER OF ALTERS ALLOWED HAS BEEN EXCEEDED FOR ${objec
t-type}
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${colu
mn-name} IS MIXED DATA, OR THE DATA TYPE OR LENGTH SPECIFIED DOES NOT
AGREE WITH THE EXISTING DATA TYPE OR LENGTH
-4704 AN UNSUPPORTED DATA TYPE WAS ENCOUNTERED AS AN INCLUDE COLUMN
-4705 ${option} SPECIFIED ON ALTER PROCEDURE FOR PROCEDURE ${routinename
} IS NOT VALID
-4706 ALTER PROCEDURE STATEMENT CANNOT BE PROCESSED BECAUSE THE OPTIONS
IN EFFECT ARE NOT THE SAME AS THE ONES THAT WERE IN EFFECT (ENVID ${en
vid}) WHEN THE PROCEDURE OR VERSION WAS FIRST DEFINED
-4707 STATEMENT ${statement} IS NOT ALLOWED WHEN USING A TRUSTED CONNECT
ION
-4708 TABLE ${table-name} CANNOT BE DEFINED AS SPECIFIED IN THE ${statem
ent} STATEMENT IN A COMMON CRITERIA ENVIRONMENT
-4709 EXPLAIN MONITORED STMTS FAILED WITH REASON CODE = ${yyyyy}
-4710 EXCHANGE DATA STATEMENT SPECIFIED ${table1} ${and} ${table2} BUT T
HE TABLES DO NOT HAVE A DEFINED CLONE RELATIONSHIP
-5001 TABLE ${table-name} IS NOT VALID
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZER
O
-7008 ${object-name} NOT VALID FOR OPERATION (${reason-code}) -${skel}
-16000 AN XQUERY EXPRESSION CANNOT BE PROCESSED BECAUSE THE ${context-co
mponent} COMPONENT OF THE STATIC CONTEXT HAS NOT BEEN ASSIGNED. ERROR
QNAME = ${err}:XPST0001
-16001 AN XQUERY EXPRESSION STARTING WITH TOKEN ${token} CANNOT BE PROCE
SSED BECAUSE THE FOCUS COMPONENT OF THE DYNAMIC CONTEXT HAS NOT BEEN A
SSIGNED. ERROR QNAME = ${err}:XPDY0002
-16002 AN XQUERY EXPRESSION HAS AN UNEXPECTED TOKEN ${token} FOLLOWING $
{text}. EXPECTED TOKENS MAY INCLUDE: ${token-list}. ERROR QNAME= ERR:X
PST0003
-16003 AN EXPRESSION OF DATA TYPE ${value-type} CANNOT BE USED WHEN THE
DATA TYPE ${expected-type} IS EXPECTED IN THE CONTEXT. ERROR QNAME= ${
err}:XPTY0004
-16005 AN XQUERY EXPRESSION REFERENCES AN ELEMENT NAME, ATTRIBUTE NAME,
TYPE NAME, FUNCTION NAME, NAMESPACE PREFIX, OR VARIABLE NAME ${undefin
ed-name} THAT IS NOT DEFINED WITHIN THE STATIC CONTEXT. ERROR QNAME= E
RR:XPST0008
-16007
-16009 AN XQUERY FUNCTION NAMED ${function-name} WITH ${number-of-parms}
PARAMETERS IS NOT DEFINED IN THE STATIC CONTEXT. ERROR QNAME= ${err}:
XPST0017
-16011 THE RESULT OF AN INTERMEDIATE STEP EXPRESSION IN AN XQUERY PATH E
XPRESSION CONTAINS AN ATOMIC VALUE. ERROR QNAME = ${err}:XPTY0019
-16012 THE CONTEXT ITEM IN AN AXIS STEP MUST BE A NODE. ERROR QNAME = ${
err}:XPTY0020
-16015 AN ELEMENT CONSTRUCTOR CONTAINS AN ATTRIBUTE NODE NAMED ${attribu
te-name} THAT FOLLOWS AN XQUERY NODE THAT IS NOT AN ATTRIBUTE NODE. ER
ROR QNAME = ERR:XQTY0024
-16016 THE ATTRIBUTE NAME ${attribute-name} CANNOT BE USED MORE THAN ONC
E IN AN ELEMENT CONSTRUCTOR. ERROR QNAME = ${err}:XQTY0025
-16020 THE CONTEXT NODE IN A PATH EXPRESSION THAT BEGINS WITH AN INITIAL
?/? OR ?//? DOES NOT HAVE AN XQUERY DOCUMENT NODE ROOT. ERROR QNAME =
${err}:XPDY0050
-16022 OPERANDS OF TYPES ${xquery-data-types} ARE NOT VALID FOR OPERATOR
${operator-name} . ERROR QNAME = ${err}:XPTY0004
-16023 THE XQUERY PROLOG CANNOT CONTAIN MULTIPLE DECLARATIONS FOR THE SA
ME NAMESPACE PREFIX ${ns-prefix}. ERROR QNAME = ${err}:XQST0033
-16024 THE NAMESPACE PREFIX ${prefix-name} CANNOT BE REDECLARED OR CANNO
T BE BOUND TO THE SPECIFIED URI. ERROR QNAME = ${err}:XQST0070
-16031 XQUERY LANGUAGE FEATURE USING SYNTAX ${string} IS NOT SUPPORTED
-16032 THE STRING ${string} IS NOT A VALID URI. ERROR QNAME = ${err}:XQS
T0046
-16036 THE URI THAT IS SPECIFIED IN A NAMESPACE DECLARATION CANNOT BE A
ZERO-LENGTH STRING
-16046 A NUMERIC XQUERY EXPRESSION ATTEMPTED TO DIVIDE BY ZERO. ERROR QN
AME = ${err}:FOAR0001
-16047 AN XQUERY EXPRESSION RESULTED IN ARITHMETIC OVERFLOW OR UNDERFLOW
. ERROR QNAME= ${err}:FOAR0002
-16048 AN XQUERY PROLOG CANNOT CONTAIN MORE THAN ONE ${decl-type} DECLAR
ATION. ERROR QNAME = ${error-qname}
-16049 THE LEXICAL VALUE ${value} IS NOT VALID FOR THE ${type-name} DATA
TYPE IN THE FUNCTION OR CAST. ERROR QNAME= ${err}:FOCA0002
-16051 THE VALUE ${value} OF DATA TYPE ${source-type} IS OUT OF RANGE FO
R AN IMPLICIT OR EXPLICIT CAST TO TARGET DATA TYPE ${target-type}. ERR
OR QNAME = ${err}:${error-qname}
-16061 THE VALUE ${value} CANNOT BE CONSTRUCTED AS, OR CAST (USING AN IM
PLICIT OR EXPLICIT CAST) TO THE DATA TYPE ${data-type}. ERROR QNAME =
${err}:FORG0001
-16065 AN EMPTY SEQUENCE CANNOT BE CAST TO THE DATA TYPE ${data-type}, E
RROR QNAME = ${err}:FORG0006
-16066 THE ARGUMENT PASSED TO THE AGGREGATE FUNCTION ${function-name} IS
NOT VALID. ERROR QNAME = ${err}:FORG0006
-16075 THE SEQUENCE TO BE SERIALIZED CONTAINS AN ITEM THAT IS AN ATTRIBU
TE NODE. ERROR QNAME = ${err}:SENR0001
-16246 INCOMPLETE ANNOTATION MAPPING AT OR NEAR LINE ${lineno} IN XML SC
HEMA DOCUMENT ${uri}. REASON CODE = ${reason-code}.
-16247 SOURCE XML TYPE ${source-data-type} CANNOT BE MAPPED TO TARGET SQ
L TYPE ${target-data-type} IN THE ANNOTATION AT OR NEAR LINE ${lineno}
IN XML SCHEMA DOCUMENT ${uri}
-16248 UNKNOWN ANNOTATION ${annotation-name} AT OR NEAR LINE ${lineno} I
N XML SCHEMA DOCUMENT ${uri}
-16249 THE ${db2-xdb}:${expression} ANNOTATION ${expression} AT OR NEAR
LINE ${lineno} IN XML SCHEMA DOCUMENT ${uri} IS TOO LONG.
-16250 THE ${db2-xdb}:${defaultSQLSchema} WITH VALUE ${schema-name} AT O
R NEAR LINE ${lineno} IN XML SCHEMA DOCUMENT ${uri} CONFLICTS WITH ANO
THER ${db2-xdb}:${defaultSQLSchema} SPECIFIED IN ONE OF THE XML SCHEMA
DOCUMENTS WITHIN THE SAME XML SCHEMA.
-16251 DUPLICATE ANNOTATION DEFINED FOR ${object-name} AT OR NEAR ${loca
tion} IN XML SCHEMA DOCUMENT ${uri}
-16252 THE ${db2-xdb}:${rowSet} NAME ${rowset-name} SPECIFIED AT OR NEAR
LINE ${lineno} IN THE XML SCHEMA DOCUMENT ${uri} IS ALREADY ASSOCIATE
D WITH ANOTHER TABLE
-16253 THE ${db2-xdb}:${condition} ANNOTATION ${condition} AT OR NEAR LI
NE ${lineno} IN XML SCHEMA DOCUMENT ${uri} IS TOO LONG.
-16254 A ${db2-xdb}:${locationPath} ${locationpath} AT OR NEAR LINE ${li
neno} IN XML SCHEMA DOCUMENT ${uri} IS NOT VALID WITH REASON CODE ${re
ason-code}.
-16255 A ${db2-xdb}:${rowSet} VALUE ${rowset-name} USED AT OR NEAR LINE
${lineno} IN XML SCHEMA DOCUMENT ${uri} CONFLICTS WITH A ${db2-xdb}:${
table} ANNOTATION WITH THE SAME NAME.
-16257 XML SCHEMA FEATURE ${feature} SPECIFIED IS NOT SUPPORTED FOR DECO
MPOSITION.
-16258 THE XML SCHEMA CONTAINS A RECURSIVE ELEMENT WHICH IS AN UNSUPPORT
ED FEATURE FOR DECOMPOSITION. THE RECURSIVE ELEMENT IS IDENTIFIED AS $
{elementnamespace} : ${elementname} OF TYPE ${typenamespace} : ${typen
ame}.
-16259 INVALID MANY-TO-MANY MAPPINGS DETECTED IN XML SCHEMA DOCUMENT ${u
ri1} NEAR LINE ${lineno1} AND IN XML SCHEMA DOCUMENT ${uri2} NEAR LINE
${lineno2}.
-16260 XML SCHEMA ANNOTATIONS INCLUDE NO MAPPINGS TO ANY COLUMN OF ANY T
ABLE.
-16262 THE ANNOTATED XML SCHEMA HAS NO COLUMNS MAPPED FOR ROWSET ${rowse
tname}.
-16265 THE XML DOCUMENT CANNOT BE DECOMPOSED USING XML SCHEMA ${xsrobjec
t-name} WHICH IS NOT ENABLED OR IS INOPERATIVE FOR DECOMPOSITION.
-16266 AN SQL ERROR OCCURRED DURING DECOMPOSITION OF DOCUMENT ${docid} W
HILE ATTEMPTING TO INSERT DATA. INFORMATION RETURNED FOR THE ERROR INC
LUDES SQLCODE ${sqlcode}, SQLSTATE ${sqlstate}, AND MESSAGE TOKENS ${t
oken-list}.
-20019 THE RESULT TYPE RETURNED FROM THE FUNCTION BODY CANNOT BE ASSIGNE
D TO THE DATA TYPE DEFINED IN THE RETURNS CLAUSE
-20060 UNSUPPORTED DATA TYPE ${data-type} ENCOUNTERED IN SQL ${object-ty
pe} ${object-name}
-20072 ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORITY OPE
RATION IS NOT ALLOWED ON A ${package-type} PACKAGE ${package-name}
-20092 A TABLE OR VIEW WAS SPECIFIED IN THE LIKE CLAUSE, BUT THE OBJECT
CANNOT BE USED IN THIS CONTEXT
-20106 THE CCSID FOR THE TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAU
SE THE TABLE SPACE OR DATABASE ALREADY CONTAINS A TABLE THAT IS REFERE
NCED IN EXISTING VIEW, OR MATERIALIZED QUERY TABLE DEFINITIONS OR AN E
XTENDED INDEX
-20143 THE ENCRYPTION OR DECRYPTION FUNCTION FAILED, BECAUSE THE ENCRYPT
ION PASSWORD VALUE IS NOT SET
-20144 THE ENCRYPTION IS INVALID BECAUSE THE LENGTH OF THE PASSWORD WAS
LESS THAN 6 BYTES OR GREATER THAN 127 BYTES
-20146 THE DECRYPTION FAILED. THE DATA IS NOT ENCRYPTED
-20147 THE ENCRYPTION FUNCTION FAILED. MULTIPLE PASS ENCRYPTION IS NOT S
UPPORTED
-20165 AN SQL DATA CHANGE STATEMENT WITHIN A FROM CLAUSE IS NOT ALLOWED
IN THE CONTEXT IN WHICH IT WAS SPECIFIED
-20166 AN SQL DATA CHANGE STATEMENT WITHIN A SELECT SPECIFIED A VIEW ${v
iew-name} WHICH IS NOT A SYMMETRIC VIEW OR COULD NOT HAVE BEEN DEFINED
AS A SYMMETRIC VIEW
-20178 VIEW ${view-name} ALREADY HAS AN INSTEAD OF ${operation} TRIGGER
DEFINED
-20179 THE INSTEAD OF TRIGGER CANNOT BE CREATED BECAUSE THE VIEW ${view-
name} IS DEFINED USING THE WITH CHECK OPTION
-20182 PARTITIONING CLAUSE ${clause} ON ${stmt-type} STATEMENT FOR ${ind
ex-name} IS NOT VALID
-20183 THE PARTITIONED, ADD PARTITION, ADD PARTITIONING KEY, ALTER PARTI
TION, ROTATE PARTITION, OR PARTITION BY RANGE CLAUSE SPECIFIED ON CREA
TE OR ALTER FOR ${name} IS NOT VALID
-20186 A CLAUSE SPECIFIED FOR THE DYNAMIC SQL STATEMENT BEING PROCESSED
IS NOT VALID
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO
REASON ${reason-code-}(${reason-string}).
-20201 THE INSTALL, REPLACE, REMOVE, OR ALTER OF ${jar-name} FAILED DUE
TO REASON ${reason-code-}(${reason-string})
-20202 THE REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS PRECOMPILED A
T A LEVEL THAT IS INCOMPATIBLE WITH THE CURRENT VALUE OF THE ENCODING
BIND OPTION OR SPECIAL REGISTER
-20211 THE SPECIFICATION ORDER BY OR FETCH FIRST N ROWS ONLY IS INVALID
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING
TO LOAD JAVA CLASS ${class-name} FROM JAR ${jar-name}. ORIGINAL EXCEPT
ION: ${exception-string}
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT
SET, PARAMETER ${number}, THAT IS NOT VALID
-20223 THE ENCRYPT_TDES OR DECRYPT FUNCTION FAILED. ENCRYPTION FACILITY
NOT AVAILABLE ${return-code}, ${reason-code}
-20224 ENCRYPTED DATA THAT WAS ORIGINALLY A BINARY STRING CANNOT BE DECR
YPTED TO A CHARACTER STRING
-20232 CHARACTER CONVERSION FROM CCSID ${from-ccsid} TO ${to-ccsid} FAIL
ED WITH ERROR CODE ${error-code} FOR TABLE ${dbid.obid} COLUMN ${colum
n-number} REQUESTED BY ${csect-name}
-20235 THE COLUMN ${column-name} CANNOT BE ADDED OR ALTERED BECAUSE ${ta
ble-name} IS A MATERIALIZED QUERY TABLE
-20240 INVALID SPECIFICATION OF A SECURITY LABEL COLUMN ${column-name} R
EASON CODE ${reason-code}
-20243 THE VIEW ${view-name} IS THE TARGET IN THE MERGE STATEMENT, BUT I
S MISSING THE INSTEAD OF TRIGGER FOR THE ${operation} OPERATION.
-20248 ATTEMPTED TO EXPLAIN ALL CACHED STATEMENTS OR A CACHED STATEMENT
WITH STMTID OR STMTTOKEN ID-${token} BUT THE REQUIRED EXPLAIN INFORMAT
ION IS NOT ACCESSIBLE.
-20249 THE PACKAGE ${package-name} NEEDS TO BE REBOUND IN ORDER TO BE SU
CCESSFULLY EXECUTED (${token})
-20252 DIAGNOSTICS AREA FULL. NO MORE ERRORS CAN BE RECORDED FOR THE NOT
ATOMIC STATEMENT
-20257 FINAL TABLE IS NOT VALID WHEN THE TARGET VIEW ${view-name} OF THE
SQL DATA CHANGE STATEMENT IN A FULLSELECT HAS AN INSTEAD OF TRIGGER D
EFINED
-20258 INVALID USE OF INPUT SEQUENCE ORDERING
-20260 THE ASSIGNMENT CLAUSE OF THE UPDATE OPERATION AND THE VALUES CLAU
SE OF THE INSERT OPERATION MUST SPECIFY AT LEAST ONE COLUMN THAT IS NO
T AN INCLUDE COLUMN
-20264 FOR TABLE ${table-name}, ${primary-auth-id} WITH SECURITY LABEL $
{primary-auth-id-seclabel} IS NOT AUTHORIZED TO PERFORM ${operation} O
N A ROW WITH SECURITY LABEL ${row-seclabel}. THE RECORD IDENTIFIER (RI
D) OF THIS ROW IS ${rid-number}.
-20265 SECURITY LABEL IS ${reason} FOR ${primary-auth-id}
-20266 ALTER VIEW FOR ${view-name} FAILED
-20275 The XML NAME ${name} IS NOT VALID. REASON CODE = ${reason-code}
-20281 ${primary-auth-id} DOES NOT HAVE THE MLS WRITE-DOWN PRIVILEGE
-20283 A DYNAMIC CREATE STATEMENT CANNOT BE PROCESSED WHEN THE VALUE OF
CURRENT SCHEMA DIFFERS FROM CURRENT SQLID
-20286 DB2 CONVERTED STRING ${token-type} ${token} FROM ${from-ccsid} TO
${to-ccsid}, AND RESULTED IN SUBSTITUTION CHARACTERS
-20289 INVALID STRING UNIT ${unit} SPECIFIED FOR FUNCTION ${function-nam
e}
-20295 THE EXECUTION OF A BUILT IN FUNCTION ${function} RESULTED IN AN E
RROR REASON CODE ${reason-code}
-20304 INVALID INDEX DEFINITION INVOLVING AN XMLPATTERN CLAUSE OR A COLU
MN OF DATA TYPE XML. REASON CODE = ${reason-code}
-20305 AN XML VALUE CANNOT BE INSERTED OR UPDATED BECAUSE OF AN ERROR DE
TECTED WHEN INSERTING OR UPDATING THE INDEX IDENTIFIED BY ${index-id}
ON TABLE ${table-name}. REASON CODE = ${reason-code}
-20306 AN INDEX ON AN XML COLUMN CANNOT BE CREATED BECAUSE OF AN ERROR D
ETECTED WHEN INSERTING THE XML VALUES INTO THE INDEX. REASON CODE = ${
reason-code}
-20310 THE REMOVE OF ${jar-name1} FAILED, AS IT IS IN USE BY ${jar-name2
}
-20311 THE VALUE PROVIDED FOR THE NEW JAVA PATH IS ILLEGAL
-20312 THE ALTER OF JAR ${jar-id} FAILED BECAUSE THE SPECIFIED PATH REFE
RENCES ITSELF
-20313 DEBUG MODE OPTION FOR ROUTINE ${routine-name} CANNOT BE CHANGED
-20314 THE PARAMETER LIST DOES NOT MATCH THE PARAMETER LIST FOR ALL OTHE
R VERSIONS OF ROUTINE ${routine-name}
-20315 THE CURRENTLY ACTIVE VERSION FOR ROUTINE ${routine-name} (${type}
) CANNOT BE DROPPED
-20326 AN XML ELEMENT NAME, ATTRIBUTE NAME, NAMESPACE PREFIX OR URI ENDI
NG WITH ${string} EXCEEDS THE LIMIT OF 1000 BYTES
-20327 THE DEPTH OF AN XML DOCUMENT EXCEEDS THE LIMIT OF 128 LEVELS
-20328 THE DOCUMENT WITH TARGET NAMESPACE ${namespace} AND SCHEMA LOCATI
ON ${location} HAS ALREADY BEEN ADDED FOR THE XML SCHEMA IDENTIFIED BY
${schema} ${name}
-20329 THE COMPLETION CHECK FOR THE XML SCHEMA FAILED BECAUSE ONE OR MOR
E XML SCHEMA DOCUMENTS IS MISSING. ONE MISSING XML SCHEMA DOCUMENT IS
IDENTIFIED BY ${uri-type} AS ${uri}
-20330 THE ${xsrobject-type} IDENTIFIED BY XML ${uri-type1} ${uri1} AND
XML ${uri-type2} ${uri2} IS NOT FOUND IN THE XML SCHEMA REPOSITORY
-20331 THE XML COMMENT VALUE ${string} IS NOT VALID
-20332 THE XML PROCESSING INSTRUCTION VALUE ${string} IS NOT VALID
-20335 MORE THAN ONE ${xsrobject-type} EXISTS IDENTIFIED BY XML ${uri-ty
pe1} ${uri1} AND ${uri-type2} ${uri2} EXISTS IN THE XML SCHEMA REPOSIT
ORY.
-20339 XML SCHEMA ${name} IS NOT IN THE CORRECT STATE TO PERFORM OPERATI
ON ${operation}
-20340 XML SCHEMA ${xmlschema-name} INCLUDES AT LEAST ONE XML SCHEMA DOC
UMENT IN NAMESPACE ${namespace} THAT IS NOT CONNECTED TO THE OTHER XML
SCHEMA DOCUMENTS
-20345 THE XML VALUE IS NOT A WELL-FORMED DOCUMENT WITH A SINGLE ROOT EL
EMENT
-20353 AN OPERATION INVOLVING COMPARISON CANNOT USE OPERAND ${name} DEFI
NED AS DATA TYPE ${type-name}
-20354 INVALID SPECIFICATION OF A ROW CHANGE TIMESTAMP COLUMN FOR TABLE
${table-name}
-20355 THE STATEMENT COULD NOT BE PROCESSED BECAUSE ONE OR MORE IMPLICIT
LY CREATED OBJECTS ARE INVOLVED ${reason-code}
-20356 THE TABLE WITH DBID = ${dbid} AND OBID = ${obid} CANNOT BE TRUNCA
TED BECAUSE DELETE TRIGGERS EXIST FOR THE TABLE, OR THE TABLE IS THE P
ARENT TABLE IN A REFERENTIAL CONSTRAINT
-20361 AUTHORIZATION ID ${authorization-name} IS NOT DEFINED FOR THE TRU
STED CONTEXT ${context-name}
-20362 ATTRIBUTE ${attribute-name} WITH VALUE ${value} CANNOT BE DROPPED
BECAUSE IT IS NOT PART OF THE DEFINITION OF TRUSTED CONTEXT ${context
-name}
-20363 ATTRIBUTE ${attribute-name} WITH VALUE ${value} IS NOT A UNIQUE S
PECIFICATION FOR TRUSTED CONTEXT ${context-name}
-20365 A SIGNALING NAN WAS ENCOUNTERED, OR AN EXCEPTION OCCURRED IN AN A
RITHMETIC OPERATION OR FUNCTION INVOLVING A DECFLOAT
-20366 TABLE WITH DBID=${dbid.obid} AND OBID= ${obid} CANNOT BE TRUNCATE
D BECAUSE UNCOMMITTED UPDATES EXIST ON THE TABLE WITH 'IMMEDIATE' OPTI
ON SPECIFIED IN THE STATEMENT
-20369 AN ALTER TRUSTED CONTEXT STATEMENT FOR ${context-name} ATTEMPTED
TO REMOVE THE LAST CONNECTION TRUST ATTRIBUTE ASSOCIATED WITH THE TRUS
TED CONTEXT
-20372 THE SYSTEM AUTHID CLAUSE OF A CREATE OR ALTER TRUSTED CONTEXT STA
TEMENT FOR ${context-name} SPECIFIED ${authorization-name}, BUT ANOTHE
R TRUSTED CONTEXT IS ALREADY DEFINED FOR THAT AUTHORIZATION ID.
-20373 A CREATE OR ALTER TRUSTED CONTEXT STATEMENT SPECIFIED ${authoriza
tion-name} MORE THAN ONCE OR THE TRUSTED CONTEXT IS ALREADY DEFINED TO
BE USED BY THIS AUTHORIZATION ID OR PUBLIC.
-20374 AN ALTER TRUSTED CONTEXT STATEMENT FOR ${context-name} SPECIFIED
${authorization-name} BUT THE TRUSTED CONTEXT IS NOT CURRENTLY DEFINED
TO BE USED BY THIS AUTHORIZATION ID OR PUBLIC
-20377 AN ILLEGAL XML CHARACTER ${hex-char} WAS FOUND IN AN SQL/XML EXPR
ESSION OR FUNCTION ARGUMENT THAT BEGINS WITH STRING ${start-string}
-20380 ALTER INDEX WITH REGENERATE OPTION FOR ${index-name} FAILED. INFO
RMATION RETURNED: SQLCODE ${sqlcode}, SQLSTATE ${sqlstate}, MESSAGE TO
KENS ${token-list}
-20381 ALTER INDEX WITH REGENERATE OPTION IS NOT VALID FOR ${index-name}
-20382 CONTEXT ITEM CANNOT BE A SEQUENCE WITH MORE THAN ONE ITEM
-20398 ERROR ENCOUNTERED DURING XML PARSING AT LOCATION ${n} ${text}
-20399 XML PARSING OR VALIDATION ERROR ENCOUNTERED DURING XML SCHEMA VAL
IDATION AT LOCATION ${n} ${text}
-20400 XML SCHEMA ERROR ${n} ${text}
-20409 AN XML DOCUMENT OR CONSTRUCTED XML VALUE CONTAINS A COMBINATION O
F XML NODES THAT CAUSES AN INTERNAL IDENTIFIER LIMIT TO BE EXCEEDED
-20410 THE NUMBER OF CHILDREN NODES OF AN XML NODE IN AN XML VALUE HAS E
XCEEDED THE LIMIT NUMBER OF CHILDREN NODES
-20411 A FETCH CURRENT CONTINUE OPERATION WAS REQUESTED FOR ${cursor-nam
e} BUT THERE IS NO PRESERVED, TRUNCATED DATA TO RETURN
-20412 SERIALIZATION OF AN XML VALUE RESULTED IN CHARACTERS THAT COULD N
OT BE REPRESENTED IN THE TARGET ENCODING
-20422 A CREATE TABLE, OR DECLARE GLOBAL TEMPORARY TABLE STATEMENT FOR $
{table-name} ATTEMPTED TO CREATE A TABLE WITH ALL THE COLUMNS DEFINED
AS HIDDEN
-20433 AN UNTYPED PARAMETER MARKER WAS SPECIFIED, BUT AN ASSUMED DATA TY
PE CANNOT BE DETERMINED FROM ITS USE
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LO
CATION ${location} PRODUCT ID ${pppvvrr} REASON ${reason-code} (${sub-
code})
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED
DEALLOCATION OF THE CONVERSATION: REASON ${reason-code} (${sub-code})
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER
WHICH CAUSED TERMINATION OF THE CONNECTION: LOCATION ${location} PRODU
CT ID ${pppvvrr} REASON ${reason-code} (${sub-code})
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT TH
E SUCCESSFUL EXECUTION OF SUBSEQUENT COMMANDS AND SQL STATEMENTS. REAS
ON ${reason-code} TYPE OF RESOURCE ${resource-type} RESOURCE NAME ${re
source-name} PRODUCT ID ${pppvvrrm} RDBNAME ${rdbname}
-30050 ${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID
WHILE BIND PROCESS IN PROGRESS
-30081 ${prot} COMMUNICATIONS ERROR DETECTED. API=${api}, LOCATION=${loc
}, FUNCTION=${func}, ERROR CODES=${rc1} ${rc2} ${rc3}
>>>>> sqlCodes V9 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*/
}¢--- A540769.WK.REXX.O08(SQLDIA) cre=2008-10-14 mod=2008-10-14-11.54.33 F540769 ---
call errReset 'h'
call sqlConnect 'DBAF'
call sqlPrepare 1, 'select * from sysibm.systables'
dia = left('',32672)
num = 123
call sqlExec 'get diagnostics' ,
/* ':dia = db2_get_diagnostics_diagnostics ,' */ ,
':num = number'
say 'num' num 'dia' dia
call sqlDisconnect
exit
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure expose m.
parse arg ggSys, ggRetCon
call sqlIni
address tso "SUBCOM DSNREXX"
if rc <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
if ggSys = '-' then
return 0
return sqlExec("connect" ggSys, ggRetCon ,1)
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure expose m.
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
call address tso 'DSN SYSTEM('sys')'
rr = rc
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql 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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(SQLO) cre=2008-05-09 mod=2008-06-16-16.47.47 F540769 ---
/* copy sqlO begin ***************************************************
sql interface mit o und j Anbindung
***********************************************************************/
sqlOini: procedure expose m.
if m.sqlO.ini == 1 then
return
m.sqlO.ini = 1
call sqlIni
call envIni
call oDecMethods oNewClass("SqlType", "JRW"),
, "jOpen call sqlOpen substr(m, 8); m.m.jReading = 1",
, "jClose call sqlClose substr(m, 8)",
, "jRead return sqlFetch(substr(m, 8), var)"
call oDecMethods oNewClass("SqlLn", "SqlType"),
, "jRead return sqlFetchLn(substr(m, 8), var)"
return
endProcedure sqlOini
/*--- fetch all rows into stem st
from sql src using type ty and format fmt -----------------*/
sql2St: procedure expose m.
parse arg st, src, ty, fmt
cx = 49
call sql2Cursor cx, src, ty, fmt
call sqlOpen cx
do ix=1 by 1 while sqlFetch(cx, st'.'ix)
end
m.st.0 = ix-1
call sqlClose cx
return ix-1
endProcedure sql2St
/*--- prepare statement 's'cx and declare cursor 'c'cx from sql src
use or generate type ty and format fo ---------------------*/
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
call sqlPreDeclare cx, src, 1 /* with describe output */
call sqlGenType cx, ty
m.Sql.cx.FMT.0 = 0
m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
return
endProcedure sql2Cursor
/*--- return the type for sql cx -------------------------------------*/
sqlType: procedure expose m.
parse arg cx
return oGetTypePara('SQL.TY.'cx)
/*--- fetch cursor 'c'cx into destination dst
each column is formatted and assigned to m.dst.<colName> ---*/
sqlFetch: procedure expose m.
parse arg cx, dst
if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
return 0
if dst == '' then
return 1
fi = oFlds(sqlType(cx))
fo = m.sql.cx.fmt
do ix=1 to m.sql.cx.d.SQLD
f = m.fi.ix
if m.sql.cx.d.ix.sqlInd = 0 then
m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
else
m.dst.f = fmtS(m.sqlNull, m.fo.ix)
end
return 1
endProcedure sqlFetch
/*--- fetch cursor 'c'cx
put the formatted and concatenated columns into m.var
return 1 if a row fetched, 0 if not ------------------------*/
sqlFetchLn: procedure expose m.
parse arg cx, var
st = 'SQL.'cx'.FET'
if ^ sqlFetch(cx, st) then
return 0
m.var = oFldCat(sqlType(cx), st, m.sql.cx.fmt)
return 1
endProcedure sqlFetchLn
/*--- generate the type sql cx as specified in ty
use the information from the sqlDa -------------------------*/
sqlGenType: procedure expose m.
parse arg cx, ty
if ty == '*' | ty = '' then do
ff = ''
do ix=1 to m.sql.cx.d.sqlD
f1 = word(m.sql.cx.d.ix.sqlName, 1)
if f1 == '' then
f1 = 'COL'ix
ff = ff f1
end
ty = oFldOnly(ff, 'e')
end
call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
return ty
endProcedure sqlGenType
/*--- generate the format ff for a sql cx as specified in sp
use the information from the sqlDa -------------------------*/
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
if abbrev(sp, '=') then
return substr(sp, 2)
if sp = '' then
sp = '*st'
m.ff.0 = m.sql.cx.d.sqlD
m.ff.flds = oFlds(sqlType(cx))
if abbrev(sp, '*') then do
do ix=1 to m.ff.0
m.ff.ix = substr(sp, 2)
end
return ff
end
if abbrev(fmts, '=') then
m.Sql.cx.FMT = substr(fmts, 2)
defs = 'ir7 fr9 sl12 Tl26' sp
do wx = 1 to words(defs)
parse value word(defs, wx) with ty 2 fo
select
when ty = 'd' then t.384 = fo
when ty = 'f' then t.480 = fo'/f'
when ty = 'i' then t.496 = fo'/i'
when ty = 'n' then t.484 = fo'/n'
when ty = 's' then t.448 = fo
when ty = 't' then t.388 = fo
when ty = 'T' then t.392 = fo
otherwise call err 'bad type' ty 'for format' fo
end
end
if symbol('t.496') == 'VAR' then
t.500 = t.496
if symbol('t.448') == 'VAR' then do
t.452 = t.448
t.456 = t.448
t.464 = t.448
end
do wx = 1 to m.ff.0
ty = m.sql.cx.d.wx.sqlType
le = m.sql.cx.d.wx.sqlLen
withNulls = ty // 2
ty = ty - withNulls
if symbol('t.ty') <> 'VAR' then
call err 'sqlType' ty 'not supported'
parse var t.ty fo 2 fl '/' op
if op = 'i' then
if le = 2 then le = 6
else le = 12
else if op <> '' then
call err 'length for sqlType' ty 'op' op 'not implemented'
if fl = '=' then
fl = le
else if abbrev(fl, '<') then
fl = min(le, substr(fl, 2))
m.ff.wx = fo || fl
end
return ff
endProcedure sqlGenFmt
/*--- sql o interface ------------------------------------------------*/
/*--- return a reader for the givenn sql or std input ----------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
if ty = '' then
ty = '*'
if src == '' then
src = envCatStr(' ', 'sb')
call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
call oMutate 'SQL.TY.'cx, 'SqlType'
return 'SQL.TY.'cx
endProcedure sql2obj
/*--- write to std output the result columns of
the sql given in src or std input --------------------------*/
sql: procedure expose m.
parse arg cx, src, ty, fo
call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
return
endProcedure sql
/*--- write to std output the result lines of
the sql given in src or std input --------------------------*/
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
if fo = '' then
fo = '~'
squash = abbrev(fo, '~')
if ^ abbrev(fo, '=') then
fo = left(fo, squash) 'sl=' substr(fo, squash+1)
t = sql2Obj(cx, src, ty, fo)
if squash then do
call fmtFldSquashRw t, 'opCl'
return
end
m = 'SQL.LN.'cx
call oMutate m, 'SqlLn'
call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
call jWriteAll m.j.jOut, "r£", m
return
endProcedure sqlLn
/* copy sqlO end **************************************************/
}¢--- A540769.WK.REXX.O08(SRCLINE) cre=2008-04-14 mod=2008-04-14-15.26.15 F540769 ---
/* REXX ****/
say timing() '()' sourceline()
do i=1 to sourceline()
m.i = sourceline(i)
end
say timing() '()' sourceline()
say 1 m.1
say 7 m.7
say 15 m.15
say 773 length(m.773) m.773
exit
/* 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
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 *****************************************************/
/*??????????????????????????????????????????????????????????????????????
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
000 SUCCESSFUL EXECUTION
+012 THE UNQUALIFIED COLUMN NAME ${column-name} WAS INTERPRETED AS A CORRELATED
+098 A DYNAMIC SQL STATEMENT ENDS WITH A SEMICOLON.
+100 ROW NOT FOUND FOR FETCH, UPDATE OR DELETE, OR THE RESULT OF A QUERY IS AN E
+110 SQL UPDATE TO A DATA CAPTURE TABLE NOT SIGNALED TO ORIGINATING SUBSYSTEM
+111 THE SUBPAGES OPTION IS NOT SUPPORTED FOR TYPE 2 INDEXES
+117 THE NUMBER OF INSERT VALUES IS NOT THE SAME AS THE NUMBER OF OBJECT COLUMNS
+162 TABLESPACE ${database-name}.${tablespace-name} HAS BEEN PLACED IN CHECK PEN
+203 THE QUALIFIED COLUMN NAME ${column-name} WAS RESOLVED USING A NON-UNIQUE OR
+204 ${name} IS AN UNDEFINED NAME
+206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
+218 THE SQL STATEMENT REFERENCING A REMOTE OBJECT CANNOT BE EXPLAINED
+219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
+220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
+222 HOLE DETECTED USING CURSOR ${cursor-name}
+223 UPDATE HOLE DETECTED USING ${cursor-name}
+231 CURRENT POSITION OF CURSOR ${cursor-name} IS NOT VALID FOR FETCH OF THE CUR
+236 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+237 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE © REQUIRED B
+238 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} SQLVAR ENTRIES A
+239 SQLDA INCLUDES ${integer1} SQLVAR ENTRIES, BUT ${integer2} ARE REQUIRED FOR
+304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
+331 THE NULL VALUE HAS BEEN ASSIGNED TO A HOST VARIABLE BECAUSE THE STRING CANN
+335 DB2 CONVERTED A HOST VARIABLE, PARAMETER, OR COLUMN NUMBER ${var-num} ${var
+339 THE SQL STATEMENT HAS BEEN SUCCESSFULLY EXECUTED, BUT THERE MAY BE SOME CHA
+347 THE RECURSIVE COMMON TABLE EXPRESSION ${name} MAY CONTAIN AN INFINITE LOOP
+394 USER SPECIFIED OPTIMIZATION HINTS USED DURING ACCESS PATH SELECTION
+395 USER SPECIFIED OPTIMIZATION HINTS ARE INVALID (REASON CODE = ${reason-code}
+402 LOCATION ${location} IS UNKNOWN
+403 THE LOCAL OBJECT REFERENCED BY THE CREATE ALIAS STATEMENT DOES NOT EXIST
+434 OPTION ${keyword} IS A DEPRECATED FEATURE
+445 VALUE ${value} HAS BEEN TRUNCATED
+462 EXTERNAL FUNCTION OR PROCEDURE ${name} (SPECIFIC NAME ${specific-name}) HAS
+464 PROCEDURE ${proc} RETURNED ${num} QUERY RESULT SETS, WHICH EXCEEDS THE DEFI
+466 PROCEDURE ${proc} RETURNED ${num} QUERY RESULTS SETS
+494 NUMBER OF RESULT SETS IS GREATER THAN NUMBER OF LOCATORS
+495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
+535 THE RESULT OF THE POSITIONED UPDATE OR DELETE MAY DEPEND ON THE ORDER OF TH
+541 THE REFERENTIAL OR UNIQUE CONSTRAINT ${name} HAS BEEN IGNORED BECAUSE IT IS
+551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
+552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
+558 THE WITH GRANT OPTION IS IGNORED
+561 THE ALTER, INDEX, REFERENCES, AND TRIGGER PRIVILEGES CANNOT BE GRANTED PUBL
+562 A GRANT OF A PRIVILEGE WAS IGNORED BECAUSE THE GRANTEE ALREADY HAS THE PRIV
+585 THE COLLECTION ${collectoin-id} APPEARS MORE THAN ONCE IN THE SET ${special
+599 COMPARISON FUNCTIONS ARE NOT CREATED FOR A DISTINCT TYPE BASED ON A LONG ST
+610 A CREATE/ALTER ON OBJECT ${object-name} HAS PLACED OBJECT IN ${utility} PEN
+645 WHERE NOT NULL IS IGNORED BECAUSE THE INDEX KEY CANNOT CONTAIN NULL VALUES
+650 THE TABLE BEING CREATED OR ALTERED CANNOT BECOME A DEPENDENT TABLE
+653 TABLE ${table-name} IN PARTITIONED TABLESPACE ${tspace-name} IS NOT AVAILAB
+655 STOGROUP ${stogroup}_${name} HAS BOTH SPECIFIC AND NON-SPECIFIC VOLUME IDS.
+658 THE SUBPAGES VALUE IS IGNORED FOR THE CATALOG INDEX ${index-name}
+664 THE INTERNAL LENGTH OF THE LIMIT-KEY FIELDS FOR THE PARTITIONED INDEX ${ind
+738 DEFINITION CHANGE OF ${object} ${object}_${name} MAY REQUIRE SIMILAR CHANGE
+799 A SET STATEMENT REFERENCES A SPECIAL REGISTER THAT DOES NOT EXIST AT THE SE
+802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
+806 BIND ISOLATION LEVEL RR CONFLICTS WITH TABLESPACE LOCKSIZE PAGE OR LOCKSIZE
+807 THE RESULT OF DECIMAL MULTIPLICATION MAY CAUSE OVERFLOW
+863 THE CONNECTION WAS SUCCESSFUL BUT ONLY SBCS WILL BE SUPPORTED
+883 ROLLBACK TO SAVEPOINT OCCURED WHEN THERE WERE OPERATIONS THAT CANNOT BE UND
+2000 TYPE 1 INDEXES WITH SUBPAGES GREATER THAN 1 CANNOT BECOME GROUP BUFFER POO
+20002 THE GBPCACHE SPECIFICATION IS IGNORED, ${bpname} DOES NOT ALLOW CACHING
+20007 USE OF OPTIMIZATION HINTS IS DISALLOWED BY A DB2 SUBSYSTEM PARAMETER. THE
+20122 DEFINE NO OPTION IS NOT APPLICABLE IN THE CONTEXT SPECIFIED
+30100 OPERATION COMPLETED SUCCESSFULLY BUT A DISTRIBUTION PROTOCOL VIOLATION HA
-007 STATEMENT CONTAINS THE ILLEGAL CHARACTER ${character}
-010 THE STRING CONSTANT BEGINNING ${string} IS NOT TERMINATED
-016 ${token} REQUIRED
-029 INTO CLAUSE REQUIRED
-060 INVALID ${type} SPECIFICATION : ${spec}
-079 QUALIFIER FOR DECLARED GLOBAL TEMPORARY TABLE ${table-name} MUST BE SESSION
-084 UNACCEPTABLE SQL STATEMENT
-097 THE USE OF LONG VARCHAR OR LONG VARGRAPHIC IS NOT ALLOWED IN THIS CONTEXT
-102 LITERAL STRING IS TOO LONG. STRING BEGINS ${string}
-103 ${literal} IS AN INVALID NUMERIC LITERAL
-104 ILLEGAL SYMBOL ?${token}?. SOME SYMBOLS THAT MIGHT BE LEGAL ARE: ${token-li
-105 INVALID STRING
-107 THE NAME ${name} IS TOO LONG. MAXIMUM ALLOWABLE SIZE IS ${size}
-108 THE NAME ${name} IS QUALIFIED INCORRECTLY
-109 ${clause} CLAUSE IS NOT PERMITTED
-110 INVALID HEXADECIMAL LITERAL BEGINNING ${string}
-111 A COLUMN FUNCTION DOES NOT INCLUDE A COLUMN NAME
-112 THE OPERAND OF A AGGREGATE FUNCTION INCLUDES A AGGREGATE FUNCTION OR A SCAL
-113 INVALID CHARACTER FOUND IN ${string}, REASON CODE ${nnn}
-114 THE LOCATION NAME ${location} DOES NOT MATCH THE CURRENT SERVER
-115 A PREDICATE IS INVALID BECAUSE THE COMPARISON OPERATOR ${operator} IS FOLLO
-117 THE NUMBER OF VALUES ASSIGNED IS NOT THE SAME AS THE NUMBER OF SPECIFIED OR
-118 THE OBJECT TABLE OR VIEW OF THE DELETE OR UPDATE STATEMENT IS ALSO IDENTIFI
-119 A COLUMN IDENTIFIED IN A HAVING CLAUSE IS NOT INCLUDED IN THE GROUP BY CLAU
-120 AN AGGREGATE FUNCTION IS NOT VALID IN THE CONTEXT IN WHICH IT WAS INVOKED
-121 THE COLUMN ${name} IS IDENTIFIED MORE THAN ONCE IN THE INSERT OR UPDATE OR
-122 A SELECT STATEMENT WITH NO GROUP BY CLAUSE CONTAINS A COLUMN NAME AND A${n}
-123 THE PARAMETER IN POSITION ${n} IN THE FUNCTION ${name} MUST BE A CONSTANT O
-125 AN INTEGER IN THE ORDER BY CLAUSE DOES NOT IDENTIFY A COLUMN OF THE RESULT
-126 THE SELECT STATEMENT CONTAINS BOTH AN UPDATE CLAUSE AND AN ORDER BY CLAUSE
-128 INVALID USE OF NULL IN A PREDICATE
-129 THE STATEMENT CONTAINS TOO MANY TABLE NAMES
-130 THE ESCAPE CLAUSE CONSISTS OF MORE THAN ONE CHARACTER, OR THE STRING PATTER
-131 STATEMENT WITH LIKE PREDICATE HAS INCOMPATIBLE DATA TYPES
-132 AN OPERAND OF ${value} IS NOT VALID
-133 AN AGGREGATE FUNCTION IN A SUBQUERY OF A HAVING CLAUSE IS INVALID BECAUSE A
-134 IMPROPER USE OF LONG STRING COLUMN ${column-name} OR AN EXPRESSION THAT RES
-136 SORT CANNOT BE EXECUTED BECAUSE THE SORT KEY LENGTH IS GREATER THAN 4000 BY
-137 THE LENGTH RESULTING FROM ${operation} IS GREATER THAN ${maximum-length}
-138 THE SECOND OR THIRD ARGUMENT OF THE SUBSTR FUNCTION IS OUT OF RANGE
-142 THE SQL STATEMENT IS NOT SUPPORTED
-144 INVALID SECTION NUMBER ${number}
-147 ALTER FUNCTION ${function-name} FAILED BECAUSE SOURCE FUNCTIONS CANNOT BE A
-148 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED OR ALTERED
-150 THE OBJECT OF THE INSERT, DELETE, OR UPDATE STATEMENT IS A VIEW, SYSTEM-MAI
-151 THE UPDATE STATEMENT IS INVALID BECAUSE THE CATALOG DESCRIPTION OF COLUMN $
-152 THE DROP ${clause} CLAUSE IN THE ALTER STATEMENT IS INVALID BECAUSE ${const
-153 THE STATEMENT IS INVALID BECAUSE THE VIEW OR TABLE DEFINITION DOES NOT INCL
-154 THE STATEMENT FAILED BECAUSE VIEW OR TABLE DEFINITION IS NOT VALID
-156 THE STATEMENT DOES NOT IDENTIFY A TABLE
-157 ONLY A TABLE NAME CAN BE SPECIFIED IN A FOREIGN KEY CLAUSE. ${object-name}
-158 THE NUMBER OF COLUMNS SPECIFIED FOR THE VIEW OR TABLE IS NOT THE SAME AS TH
-159 THE STATEMENT REFERENCES ${object-name} WHICH IDENTIFIES A(N) ${object-type
-160 THE WITH CHECK OPTION CANNOT BE USED FOR THE SPECIFIED VIEW
-161 THE INSERT OR UPDATE IS NOT ALLOWED BECAUSE A RESULTING ROW DOES NOT SATISF
-164 ${auth-id1} DOES NOT HAVE THE PRIVILEGE TO CREATE A VIEW WITH QUALIFICATION
-170 THE NUMBER OF ARGUMENTS SPECIFIED FOR ${function-name} IS INVALID
-171 THE DATA TYPE, LENGTH, OR VALUE OF ARGUMENT ${nn} OF ${function-name} IS IN
-173 UR IS SPECIFIED ON THE WITH CLAUSE BUT THE CURSOR IS NOT READ-ONLY
-180 THE DATE, TIME, OR TIMESTAMP VALUE ${value} IS INVALID
-181 THE STRING REPRESENTATION OF A DATETIME VALUE IS NOT A VALID DATETIME VALUE
-182 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE IS INVALID
-183 AN ARITHMETIC OPERATION ON A DATE OR TIMESTAMP HAS A RESULT THAT IS NOT WIT
-184 AN ARITHMETIC EXPRESSION WITH A DATETIME VALUE CONTAINS A PARAMETER MARKER
-185 THE LOCAL FORMAT OPTION HAS BEEN USED WITH A DATE OR TIME AND NO LOCAL EXIT
-186 THE LOCAL DATE LENGTH OR LOCAL TIME LENGTH HAS BEEN INCREASED AND EXECUTING
-187 A REFERENCE TO A CURRENT DATE/TIME SPECIAL REGISTER IS INVALID BECAUSE THE
-188 THE STRING REPRESENTATION OF A NAME IS INVALID
-189 CCSID ${ccsid} IS UNKNOWN OR INVALID FOR THE DATA TYPE OR SUBTYPE
-190 THE ATTRIBUTES SPECIFIED FOR THE OF COLUMN ${table-name}.${column-name} ARE
-191 A STRING CANNOT BE USED BECAUSE IT IS INVALID MIXED DATA
-197 QUALIFIED COLUMN NAMES IN ORDER BY CLAUSE NOT PERMITTED WHEN UNION OR UNION
-198 THE OPERAND OF THE PREPARE OR EXECUTE IMMEDIATE STATEMENT IS BLANK OR EMPTY
-199 ILLEGAL USE OF KEYWORD ${keyword}. TOKEN ${token-list} WAS EXPECTED
-203 A REFERENCE TO COLUMN ${column-name} IS AMBIGUOUS
-204 ${name} IS AN UNDEFINED NAME
-205 ${column-name} IS NOT A COLUMN OF TABLE ${table-name}
-206 ${column-name} IS NOT A COLUMN OF AN INSERTED TABLE, UPDATED TABLE, OR ANY
-208 THE ORDER BY CLAUSE IS INVALID BECAUSE COLUMN ${name} IS NOT PART OF THE RE
-212 ${name} IS SPECIFIED MORE THAN ONCE IN THE REFERENCING CLAUSE OF A TRIGGER
-214 AN EXPRESSION IN THE FOLLOWING POSITION, OR STARTING WITH ${position-or-exp
-216 THE NUMBER OF ELEMENTS ON EACH SIDE OF A PREDICATE OPERATOR DOES NOT MATCH.
-219 THE REQUIRED EXPLANATION TABLE ${table-name} DOES NOT EXIST
-220 THE COLUMN ${column-name} IN EXPLANATION TABLE ${table-name} IS NOT DEFINED
-221 “SET OF OPTIONAL COLUMNS” IN EXPLANATION TABLE ${table-name} IS INCOMPLETE.
-222 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST A HOLE USING ${cursor-n
-223 AN UPDATE OR DELETE OPERATION WAS ATTEMPTED AGAINST AN UPDATE HOLE USING ${
-224 THE RESULT TABLE DOES NOT AGREE WITH THE BASE TABLE USING ${cursor-name}
-225 FETCH STATEMENT FOR ${cursor-name} IS NOT VALID BECAUSE THE CURSOR IS NOT D
-227 FETCH ${fetch-orientation} IS NOT ALLOWED, BECAUSE CURSOR ${cursor-name} HA
-228 FOR UPDATE CLAUSE SPECIFIED FOR READ-ONLY CURSOR ${cursor-name}
-229 THE LOCALE ${locale} SPECIFIED IN A SET LOCALE OR OTHER STATEMENT THAT IS L
-240 THE PART CLAUSE OF A LOCK TABLE STATEMENT IS INVALID
-242 THE OBJECT NAMED ${object-name} OF TYPE ${object-type} WAS SPECIFIED MORE T
-243 SENSITIVE CURSOR ${cursor-name} CANNOT BE DEFINED FOR THE SPECIFIED SELECT
-244 SENSITIVITY ${sensitivity} SPECIFIED ON THE FETCH IS NOT VALID FOR CURSOR $
-245 THE INVOCATION OF FUNCTION ROUTINE-NAME IS AMBIGUOUS
-246 STATEMENT USING CURSOR ${cursor-name} SPECIFIED NUMBER OF ROWS ${num-rows}
-247 A HOLE WAS DETECTED ON A MULTIPLE ROW FETCH STATEMENT USING CURSOR ${cursor
-248 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-249 DEFINITION OF ROWSET ACCESS FOR CURSOR ${cursor-name} IS INCONSISTENT WITH
-250 THE LOCAL LOCATION NAME IS NOT DEFINED WHEN PROCESSING A THREE-PART OBJECT
-251 TOKEN ${name} IS NOT VALID
-270 FUNCTION NOT SUPPORTED
-300 THE STRING CONTAINED IN HOST VARIABLE OR PARAMETER ${position-number} IS NO
-301 THE VALUE OF INPUT HOST VARIABLE OR PARAMETER NUMBER ${position-number} CAN
-302 THE VALUE OF INPUT VARIABLE OR PARAMETER NUMBER ${position-number} IS INVAL
-303 A VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position-number
-304 A VALUE WITH DATA TYPE ${data-type1} CANNOT BE ASSIGNED TO A HOST VARIABLE
-305 THE NULL VALUE CANNOT BE ASSIGNED TO OUTPUT HOST VARIABLE NUMBER ${position
-309 A PREDICATE IS INVALID BECAUSE A REFERENCED HOST VARIABLE HAS THE NULL VALU
-310 DECIMAL HOST VARIABLE OR PARAMETER ${number} CONTAINS NON-DECIMAL DATA
-311 THE LENGTH OF INPUT HOST VARIABLE NUMBER ${position-number} IS NEGATIVE OR
-312 ${variable-name} IS AN UNDEFINED OR UNUSABLE HOST VARIABLE OR IS USED IN A
-313 THE NUMBER OF HOST VARIABLES SPECIFIED IS NOT EQUAL TO THE NUMBER OF PARAME
-314 THE STATEMENT CONTAINS AN AMBIGUOUS HOST VARIABLE REFERENCE
-327 THE ROW CANNOT BE INSERTED BECAUSE IT IS OUTSIDE THE BOUND OF THE PARTITION
-330 A STRING CANNOT BE USED BECAUSE IT CANNOT BE TRANSLATED. REASON ${reason-co
-331 A STRING CANNOT BE ASSIGNED TO A HOST VARIABLE BECAUSE IT CANNOT BE TRANSLA
-332 CHARACTER CONVERSION BETWEEN CCSID ${from-ccsid} TO ${to-ccsid} REQUESTED B
-333 THE SUBTYPE OF A STRING VARIABLE IS NOT THE SAME AS THE SUBTYPE KNOWN AT BI
-336 The decimal number is used in a context where the scale must be zero. This
-338 AN ON CLAUSE IS INVALID
-339 THE SQL STATEMENT CANNOT BE EXECUTED FROM AN ASCII BASED DRDA APPLICATION R
-340 THE COMMON TABLE EXPRESSION ${name} HAS THE SAME IDENTIFIER AS ANOTHER OCCU
-341 A CYCLIC REFERENCE EXISTS BETWEEN THE COMMON TABLE EXPRESSIONS ${name1} AND
-342 THE COMMON TABLE EXPRESSION ${name} CANNOT USE SELECT DISTINCT AND MUST USE
-343 THE COLUMN NAMES ARE REQUIRED FOR THE RECURSIVE COMMON TABLE EXPRESSION ${n
-344 THE RECURSIVE COMMON TABLE EXPRESSION ${name} HAS MISMATCHED DATA TYPES OR
-345 THE FULLSELECT OF THE RECURSIVE COMMON TABLE EXPRESSION ${name} MUST BE THE
-346 AN INVALID REFERENCE TO COMMON TABLE EXPRESSION ${name} OCCURS IN THE FIRST
-348 ${sequence-expression} FOR ${sequence-name} CANNOT BE SPECIFIED IN THIS CON
-350 INVALID SPECIFICATION OF A LARGE OBJECT COLUMN
-351 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-352 AN UNSUPPORTED SQLTYPE WAS ENCOUNTERED IN POSITION ${position-number} OF TH
-355 A LOB COLUMN IS TOO LARGE TO BE LOGGED
-359 THE RANGE OF VALUES FOR THE IDENTITY COLUMN OR SEQUENCE IS EXHAUSTED
-372 ONLY ONE ROWID OR IDENTITY COLUMN IS ALLOWED IN A TABLE
-373 DEFAULT CANNOT BE SPECIFIED FOR IDENTITY COLUMN ${column-name}
-390 THE FUNCTION ${function-name}, SPECIFIC NAME ${specific-name}, IS NOT VALID
-392 SQLDA PROVIDED FOR CURSOR ${cursor} HAS BEEN CHANGED FROM THE PREVIOUS FETC
-393 THE CONDITION OR CONNECTION NUMBER IS INVALID
-396 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT DURING
-397 THE OPTION GENERATED IS SPECIFIED WITH A COLUMN THAT IS NOT A ROW ID OR DIS
-398 A LOCATOR WAS REQUESTED FOR HOST VARIABLE NUMBER ${position-number} BUT THE
-399 ATTEMPTED TO INSERT AN INVALID VALUE INTO A ROWID COLUMN
-400 THE CATALOG HAS THE MAXIMUM NUMBER OF USER DEFINED INDEXES
-401 THE OPERANDS OF AN ARITHMETIC OR COMPARISON OPERATION ARE NOT COMPARABLE
-402 AN ARITHMETIC FUNCTION OR OPERATOR ${arith-fop} IS APPLIED TO CHARACTER OR
-404 THE SQL STATEMENT SPECIFIES A STRING THAT IS TOO LONG
-405 THE NUMERIC LITERAL ${literal} CANNOT BE USED AS SPECIFIED BECAUSE IT IS OU
-406 A CALCULATED OR DERIVED NUMERIC VALUE IS NOT WITHIN THE RANGE OF ITS OBJECT
-407 AN UPDATE, INSERT, OR SET VALUE IS NULL, BUT THE OBJECT COLUMN ${column-nam
-408 THE VALUE IS NOT COMPATIBLE WITH THE DATA TYPE OF ITS TARGET
-409 INVALID OPERAND OF A COUNT FUNCTION
-410 THE FLOATING POINT LITERAL ${literal} CONTAINS MORE THAN 30 CHARACTERS
-411 CURRENT SQLID CANNOT BE USED IN A STATEMENT THAT REFERENCES REMOTE OBJECTS
-412 THE SELECT CLAUSE OF A SUBQUERY SPECIFIES MULTIPLE COLUMNS
-413 OVERFLOW OCCURRED DURING NUMERIC DATA TYPE CONVERSION
-414 A LIKE PREDICATE IS INVALID BECAUSE THE FIRST OPERAND IS NOT A STRING
-415 THE CORRESPONDING COLUMNS, ${column-number}, OF THE OPERANDS OF A UNION OR
-416 AN OPERAND OF A UNION CONTAINS A LONG STRING COLUMN
-417 A STATEMENT STRING TO BE PREPARED INCLUDES PARAMETER MARKERS AS THE OPERAND
-418 A STATEMENT STRING TO BE PREPARED CONTAINS AN INVALID USE OF PARAMETER MARK
-419 THE DECIMAL DIVIDE OPERATION IS INVALID BECAUSE THE RESULT WOULD HAVE A NEG
-420 THE VALUE OF A STRING ARGUMENT WAS NOT ACCEPTABLE TO THE ${function-name} F
-421 THE OPERANDS OF A UNION OR UNION ALL DO NOT HAVE THE SAME NUMBER OF COLUMNS
-423 INVALID VALUE FOR LOCATOR IN POSITION ${position-}#
-426 DYNAMIC COMMIT NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT ALL
-427 DYNAMIC ROLLBACK NOT VALID AT AN APPLICATION SERVER WHERE UPDATES ARE NOT A
-430 ${routine-type} ${routine-name} (SPECIFIC NAME ${specific-name}) HAS ABNORM
-433 VALUE ${value} IS TOO LONG
-435 AN INVALID SQLSTATE ${sqlstate} IS SPECIFIED IN THE FUNCTION RAISE_ERROR OR
-438 APPLICATION RAISED ERROR WITH DIAGNOSTIC TEXT: ${text}
-440 NO ${routine-type} BY THE NAME ${routine-name} HAVING COMPATIBLE ARGUMENTS
-441 INVALID USE OF ’DISTINCT’ OR ’ALL’ WITH SCALAR FUNCTION ${function-name}
-444 USER PROGRAM ${name} COULD NOT BE FOUND
-449 CREATE OR ALTER STATEMENT FOR FUNCTION OR PROCEDURE ${routine-name} CONTAIN
-450 USER-DEFINED FUNCTION OR STORED PROCEDURE ${name}, PARAMETER NUMBER ${parmn
-451 THE ${data-item} DEFINITION, IN THE CREATE FUNCTION FOR ${function-name} CO
-453 THERE IS A PROBLEM WITH THE RETURNS CLAUSE IN THE CREATE FUNCTION STATEMENT
-454 THE SIGNATURE PROVIDED IN THE CREATE FUNCTION STATEMENT FOR ${function-name
-455 IN CREATE FUNCTION FOR ${function-name}, THE SCHEMA NAME ${schema-name1} PR
-456 IN CREATE FUNCTION FOR ${function-name}, THE SPECIFIC NAME ${specific-name}
-457 A FUNCTION OR DISTINCT TYPE CANNOT BE CALLED ${name} SINCE IT IS RESERVED F
-458 IN A REFERENCE TO FUNCTION ${function-name} BY SIGNATURE, A MATCHING FUNCTI
-461 A VALUE WITH DATA TYPE ${source-data-type} CANNOT BE CAST TO TYPE ${target-
-469 SQL CALL STATEMENT MUST SPECIFY AN OUTPUT HOST VARIABLE FOR PARAMETER ${num
-470 SQL CALL STATEMENT SPECIFIED A NULL VALUE FOR INPUT PARAMETER ${number}, BU
-471 INVOCATION OF FUNCTION OR PROCEDURE ${name} FAILED DUE TO REASON ${rc}
-472 CURSOR ${cursor-name} WAS LEFT OPEN BY EXTERNAL FUNCTION ${function-name} (
-473 A USER DEFINED DATA TYPE CANNOT BE CALLED THE SAME NAME AS A SYSTEM PREDEFI
-475 THE RESULT TYPE ${type-1} OF THE SOURCE FUNCTION CANNOT BE CAST TO THE RETU
-476 REFERENCE TO FUNCTION ${function-name} WAS NAMED WITHOUT A SIGNATURE, BUT T
-478 DROP OR REVOKE ON OBJECT TYPE ${type1} CANNOT BE PROCESSED BECAUSE OBJECT $
-480 THE PROCEDURE ${procedure-name} HAS NOT YET BEEN CALLED
-482 THE PROCEDURE ${procedure-name} RETURNED NO LOCATORS
-483 IN CREATE FUNCTION FOR ${function-name} STATEMENT, THE NUMBER OF PARAMETERS
-487 ${object-type} ${object-name} ATTEMPTED TO EXECUTE AN SQL STATEMENT WHEN TH
-490 NUMBER ${number} DIRECTLY SPECIFIED IN AN SQL STATEMENT IS OUTSIDE THE RANG
-491 CREATE STATEMENT FOR USER-DEFINED FUNCTION ${function-name} MUST HAVE A RET
-492 THE CREATE FUNCTION FOR ${function-name} HAS A PROBLEM WITH PARAMETER NUMBE
-495 ESTIMATED PROCESSOR COST OF ${estimate-amount1} PROCESSOR SECONDS (${estima
-496 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT REFERENCES A RESULT SET THA
-497 THE MAXIMUM LIMIT OF INTERNAL IDENTIFIERS HAS BEEN EXCEEDED FOR DATABASE ${
-499 CURSOR ${cursor-name} HAS ALREADY BEEN ASSIGNED TO THIS OR ANOTHER RESULT S
-500 THE IDENTIFIED CURSOR WAS CLOSED WHEN THE CONNECTION WAS DESTROYED
-501 THE CURSOR IDENTIFIED IN A FETCH OR CLOSE STATEMENT IS NOT OPEN
-502 THE CURSOR IDENTIFIED IN AN OPEN STATEMENT IS ALREADY OPEN
-503 A COLUMN CANNOT BE UPDATED BECAUSE IT IS NOT IDENTIFIED IN THE UPDATE CLAUS
-504 THE CURSOR NAME ${cursor-name} IS NOT DEFINED
-507 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT OPEN
-508 THE CURSOR IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT POSITIONED O
-509 THE TABLE IDENTIFIED IN THE UPDATE OR DELETE STATEMENT IS NOT THE SAME TABL
-510 THE TABLE DESIGNATED BY THE CURSOR OF THE UPDATE OR DELETE STATEMENT CANNOT
-511 THE FOR UPDATE CLAUSE CANNOT BE SPECIFIED BECAUSE THE TABLE DESIGNATED BY T
-512 STATEMENT REFERENCE TO REMOTE OBJECT IS INVALID
-513 THE ALIAS ${alias-name} MUST NOT BE DEFINED ON ANOTHER LOCAL OR REMOTE ALIA
-514 THE CURSOR ${cursor-name} IS NOT IN A PREPARED STATE
-516 THE DESCRIBE FOR STATIC STATEMENT DOES NOT IDENTIFY A PREPARED STATEMENT
-517 CURSOR ${cursor-name} CANNOT BE USED BECAUSE ITS STATEMENT NAME DOES NOT ID
-518 THE EXECUTE STATEMENT DOES NOT IDENTIFY A VALID PREPARED STATEMENT
-519 THE PREPARE STATEMENT IDENTIFIES THE SELECT STATEMENT OF THE OPENED CURSOR
-525 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS IN ERROR AT BIND TIME F
-526 THE REQUESTED OPERATION OR USAGE DOES NOT APPLY TO ${table} ${type} TEMPORA
-530 THE INSERT OR UPDATE VALUE OF FOREIGN KEY ${constraint-name} IS INVALID
-531 PARENT KEY IN A PARENT ROW CANNOT BE UPDATED BECAUSE IT HAS ONE OR MORE DEP
-532 THE RELATIONSHIP ${constraint-name} RESTRICTS THE DELETION OF ROW WITH RID
-533 INVALID MULTIPLE-ROW INSERT
-534 THE PRIMARY KEY CANNOT BE UPDATED BECAUSE OF MULTIPLE-ROW UPDATE
-536 THE DELETE STATEMENT IS INVALID BECAUSE TABLE ${table-name} CAN BE AFFECTED
-537 THE PRIMARY KEY, FOREIGN KEY, UNIQUE, OR PARTITIONING KEY CLAUSE IDENTIFIES
-538 FOREIGN KEY ${name} DOES NOT CONFORM TO THE DESCRIPTION OF A PARENT KEY OF
-539 TABLE ${table-name} DOES NOT HAVE A PRIMARY KEY
-540 THE DEFINITION OF TABLE ${table-name} IS INCOMPLETE BECAUSE IT LACKS A PRIM
-542 ${column-name} CANNOT BE A COLUMN OF A PRIMARY KEY, A UNIQUE CONSTRAINT, OR
-543 A ROW IN A PARENT TABLE CANNOT BE DELETED BECAUSE THE CHECK CONSTRAINT ${ch
-544 THE CHECK CONSTRAINT SPECIFIED IN THE ALTER TABLE STATEMENT CANNOT BE ADDED
-545 THE REQUESTED OPERATION IS NOT ALLOWED BECAUSE A ROW DOES NOT SATISFY THE C
-546 THE CHECK CONSTRAINT ${constraint-name} IS INVALID
-548 A CHECK CONSTRAINT THAT IS DEFINED WITH ${column-name} IS INVALID
-549 THE ${statement} STATEMENT IS NOT ALLOWED FOR ${object}_${type1} ${object}_
-551 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation} ON
-552 ${auth-id} DOES NOT HAVE THE PRIVILEGE TO PERFORM OPERATION ${operation}
-553 ${auth-id} SPECIFIED IS NOT ONE OF THE VALID AUTHORIZATION IDS
-554 AN AUTHORIZATION ID CANNOT GRANT A PRIVILEGE TO ITSELF
-555 AN AUTHORIZATION ID CANNOT REVOKE A PRIVILEGE FROM ITSELF
-556 ${authid2} CANNOT HAVE THE ${privilege} PRIVILEGE ${on}_${object} REVOKED B
-557 INCONSISTENT GRANT/REVOKE KEYWORD ${keyword}. PERMITTED KEYWORDS ARE ${keyw
-558 INVALID CLAUSE OR COMBINATION OF CLAUSES ON A GRANT OR REVOKE
-559 ALL AUTHORIZATION FUNCTIONS HAVE BEEN DISABLED
-567 ${bind-type} AUTHORIZATION ERROR USING ${auth-id} AUTHORITY PACKAGE = ${pac
-571 THE STATEMENT WOULD RESULT IN A MULTIPLE SITE UPDATE
-573 TABLE ${table-name} DOES NOT HAVE A UNIQUE KEY WITH THE SPECIFIED COLUMN NA
-574 THE SPECIFIED DEFAULT VALUE OR IDENTITY ATTRIBUTE VALUE CONFLICTS WITH THE
-577 ${object-type} ${object-name} ATTEMPTED TO MODIFY DATA WHEN THE DEFINITION
-579 ${object-type} ${object-name} ATTEMPTED TO READ DATA WHEN THE DEFINITION OF
-580 THE RESULT-EXPRESSIONS OF A CASE EXPRESSION CANNOT ALL BE NULL
-581 THE DATA TYPES OF THE RESULT-EXPRESSIONS OF A CASE EXPRESSION ARE NOT COMPA
-582 THE SEARCH-CONDITION IN A SEARCHED-WHEN-CLAUSE CANNOT BE A QUANTIFIED PREDI
-583 THE USE OF FUNCTION ${function-name} IS INVALID BECAUSE IT IS NOT DETERMINI
-585 THE COLLECTION ID ${collection-id} APPEARS MORE THAN ONCE IN THE SET ${spec
-586 THE TOTAL LENGTH OF THE CURRENT PATH SPECIAL REGISTER CANNOT EXCEED 254 CHA
-587 A LIST OF ${item-references} ARE NOT IN THE SAME FAMILY
-589 A POSITIONED DELETE OR UPDATE STATEMENT FOR CURSOR ${cursor-name} SPECIFIED
-590 PARAMETER NAME ${parameter-name} IS NOT UNIQUE IN THE CREATE FOR ROUTINE ${
-592 NOT AUTHORIZED TO CREATE FUNCTIONS OR PROCEDURES IN WLM ENVIRONMENT ${env-n
-593 NOT NULL MUST BE SPECIFIED FOR ROWID OR DISTINCT TYPE COLUMN ${column-name}
-594 ATTEMPT TO CREATE A NULLABLE ROWID OR DISTINCT TYPE COLUMN ${column-name}
-601 THE NAME OF THE OBJECT TO BE CREATED OR THE TARGET OF A RENAME STATEMENT IS
-602 TOO MANY COLUMNS SPECIFIED IN A CREATE INDEX OR ALTER INDEX STATEMENT
-603 A UNIQUE INDEX CANNOT BE CREATED BECAUSE THE TABLE CONTAINS ROWS WHICH ARE
-604 A DATA TYPE DEFINITION SPECIFIES AN INVALID LENGTH, PRECISION, OR SCALE ATT
-607 OPERATION OR OPTION ${operation} IS NOT DEFINED FOR THIS OBJECT
-611 ONLY LOCKMAX 0 CAN BE SPECIFIED WHEN THE LOCK SIZE OF THE TABLESPACE IS TAB
-612 ${column-name} IS A DUPLICATE COLUMN NAME
-613 THE PRIMARY KEY OR A UNIQUE CONSTRAINT IS TOO LONG OR HAS TOO MANY COLUMNS
-614 THE INDEX CANNOT BE CREATED OR ALTERED, OR THE LENGTH OF A COLUMN CANNOT BE
-615 ${operation-type} IS NOT ALLOWED ON A PACKAGE IN USE
-616 ${obj-type1} ${obj-name1} CANNOT BE DROPPED BECAUSE IT IS REFERENCED BY ${o
-617 A TYPE 1 INDEX IS NOT VALID FOR TABLE ${table-name}
-618 OPERATION ${operation} IS NOT ALLOWED ON SYSTEM DATABASES
-619 OPERATION DISALLOWED BECAUSE THE DATABASE IS NOT STOPPED
-620 KEYWORD ${keyword} IN ${stmt} ${type} STATEMENT IS NOT PERMITTED FOR A ${sp
-621 DUPLICATE DBID ${dbid} WAS DETECTED AND PREVIOUSLY ASSIGNED TO ${database-n
-622 FOR MIXED DATA IS INVALID BECAUSE THE MIXED DATA INSTALL OPTION IS NO
-623 A CLUSTERING INDEX ALREADY EXISTS ON TABLE ${table-name}
-624 TABLE ${table-name} ALREADY HAS A PRIMARY KEY OR UNIQUE KEY CONSTRAINT WITH
-625 TABLE ${table-name} DOES NOT HAVE AN INDEX TO ENFORCE THE UNIQUENESS OF THE
-626 THE ALTER STATEMENT IS NOT EXECUTABLE BECAUSE THE PAGE SET IS NOT STOPPED
-627 THE ALTER STATEMENT IS INVALID BECAUSE THE PAGESET HAS USER-MANAGED DATA SE
-628 THE CLAUSES ARE MUTUALLY EXCLUSIVE
-629 SET NULL CANNOT BE SPECIFIED BECAUSE FOREIGN KEY ${name} CANNOT CONTAIN NUL
-630 THE WHERE NOT NULL SPECIFICATION IS INVALID FOR TYPE 1 INDEXES
-631 FOREIGN KEY ${name} IS TOO LONG OR HAS TOO MANY COLUMNS
-632 THE TABLE CANNOT BE DEFINED AS A DEPENDENT OF ${table-name} BECAUSE OF DELE
-633 THE DELETE RULE MUST BE ${delete-rule}
-634 THE DELETE RULE MUST NOT BE CASCADE
-635 THE DELETE RULES CANNOT BE DIFFERENT OR CANNOT BE SET NULL
-636 THE PARTITIONING KEYS FOR PARTITION ${part-num} ARE NOT SPECIFIED IN ASCEND
-637 DUPLICATE ${keyword} KEYWORD
-638 TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN DEFINITION IS MISSING
-639 A NULLABLE COLUMN OF A FOREIGN KEY WITH A DELETE RULE OF SET NULL CANNOT BE
-640 LOCKSIZE ROW CANNOT BE SPECIFIED BECAUSE TABLE IN THIS TABLESPACE HAS TYPE
-643 CHECK CONSTRAINT EXCEEDS MAXIMUM ALLOWABLE LENGTH
-644 INVALID VALUE SPECIFIED FOR KEYWORD ${keyword} IN ${stmt-type} STATEMENT
-646 TABLE ${table-name} CANNOT BE CREATED IN SPECIFIED TABLE SPACE ${table-spac
-647 BUFFERPOOL ${bp-name} CANNOT BE SPECIFIED BECAUSE IT HAS NOT BEEN ACTIVATED
-650 THE ALTER STATEMENT CANNOT BE EXECUTED, REASON ${reason}
-651 TABLE DESCRIPTION EXCEEDS MAXIMUM SIZE OF OBJECT DESCRIPTOR.
-652 VIOLATION OF INSTALLATION DEFINED EDIT OR VALIDATION PROCEDURE ${proc-name}
-653 TABLE ${table-name} IN PARTITIONED TABLE SPACE ${tspace-name} IS NOT AVAILA
-655 THE CREATE OR ALTER STOGROUP IS INVALID BECAUSE THE STORAGE GROUP WOULD HAV
-658 A ${object-type} CANNOT BE DROPPED USING THE ${statement} STATEMENT
-660 INDEX ${index-name} CANNOT BE CREATED OR ALTERED ON PARTITIONED TABLE SPACE
-661 INDEX ${index-name} CANNOT BE CREATED ON PARTITIONED TABLE SPACE ${tspace-n
-662 A PARTITIONED INDEX CANNOT BE CREATED ON A NON-PARTITIONED TABLE SPACE ${ts
-663 THE NUMBER OF KEY LIMIT VALUES IS EITHER ZERO, OR GREATER THAN THE NUMBER O
-665 THE PART CLAUSE OF AN ALTER STATEMENT IS OMITTED OR INVALID
-666 ${stmt-verb} ${object} CANNOT BE EXECUTED BECAUSE ${function} IS IN PROGRES
-667 THE CLUSTERING INDEX FOR A PARTITIONED TABLE SPACE CANNOT BE EXPLICITLY DRO
-668 THE COLUMN CANNOT BE ADDED TO THE TABLE BECAUSE THE TABLE HAS AN EDIT PROCE
-669 THE OBJECT CANNOT BE EXPLICITLY DROPPED. REASON ${reason-code}
-670 THE RECORD LENGTH OF THE TABLE EXCEEDS THE PAGE SIZE LIMIT
-671 THE BUFFERPOOL ATTRIBUTE OF THE TABLE SPACE CANNOT BE ALTERED AS SPECIFIED
-672 OPERATION DROP NOT ALLOWED ON TABLE ${table}_${name}
-676 ONLY A 4K PAGE BUFFERPOOL CAN BE USED FOR AN INDEX
-677 INSUFFICIENT VIRTUAL STORAGE FOR BUFFERPOOL EXPANSION
-678 THE LITERAL ${literal} SPECIFIED FOR THE INDEX LIMIT KEY MUST CONFORM TO TH
-679 THE OBJECT ${name} CANNOT BE CREATED BECAUSE A DROP IS PENDING ON THE OBJEC
-680 TOO MANY COLUMNS SPECIFIED FOR A TABLE, VIEW OR TABLE FUNCTION
-681 COLUMN ${column-name} IN VIOLATION OF INSTALLATION DEFINED FIELD PROCEDURE.
-682 FIELD PROCEDURE ${procedure-name} COULD NOT BE LOADED
-683 THE SPECIFICATION FOR COLUMN, DISTINCT TYPE, FUNCTION, OR PROCEDURE ${data-
-684 THE LENGTH OF LITERAL LIST BEGINNING ${string} IS TOO LONG
-685 INVALID FIELD TYPE, ${column-name}
-686 COLUMN DEFINED WITH A FIELD PROCEDURE CAN NOT COMPARE WITH ANOTHER COLUMN W
-687 FIELD TYPES INCOMPARABLE
-688 INCORRECT DATA RETURNED FROM FIELD PROCEDURE, ${column-name}, ${msgno}
-689 TOO MANY COLUMNS DEFINED FOR A DEPENDENT TABLE
-690 THE STATEMENT IS REJECTED BY DATA DEFINITION CONTROL SUPPORT. REASON ${reas
-691 THE REQUIRED REGISTRATION TABLE ${table-name} DOES NOT EXIST
-692 THE REQUIRED UNIQUE INDEX ${index-name} FOR DDL REGISTRATION TABLE ${table-
-693 THE COLUMN ${column-name} IN DDL REGISTRATION TABLE OR INDEX ${table-name}
-694 THE DDL STATEMENT CANNOT BE EXECUTED BECAUSE A DROP IS PENDING ON THE DDL R
-696 THE DEFINITION OF TRIGGER ${trigger-name} INCLUDES AN INVALID USE OF CORREL
-697 OLD OR NEW CORRELATION NAMES ARE NOT ALLOWED IN A TRIGGER DEFINED WITH THE
-713 THE REPLACEMENT VALUE ${value} FOR ${special-register} IS INVALID
-715 PROGRAM ${program-name} WITH MARK ${release-dependency-mark} FAILED BECAUSE
-716 PROGRAM ${program-name} PRECOMPILED WITH INCORRECT LEVEL FOR THIS RELEASE
-717 ${bind-type} FOR ${object-type} ${object-name} WITH MARK ${release-dependen
-718 REBIND OF PACKAGE ${package-name} FAILED BECAUSE IBMREQD OF ${ibmreqd} IS I
-719 BIND ADD ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} ALREADY E
-720 BIND ERROR, ATTEMPTING TO REPLACE PACKAGE = ${package}_${name} WITH VERSION
-721 BIND ERROR FOR PACKAGE = ${pkg-id} CONTOKEN = ${contoken}’X IS NOT UNIQUE S
-722 ${bind-type} ERROR USING ${auth-id} AUTHORITY PACKAGE ${package-name} DOES
-723 AN ERROR OCCURRED IN A TRIGGERED SQL STATEMENT IN ${trigger-name}. INFORMAT
-724 THE ACTIVATION OF THE ${object-type} OBJECT ${object-name} WOULD EXCEED THE
-725 THE SPECIAL REGISTER ${register} AT LOCATION ${location} WAS SUPPLIED AN IN
-726 BIND ERROR ATTEMPTING TO REPLACE PACKAGE = ${package-name}. THERE ARE ENABL
-728 DATA TYPE ${data-type} IS NOT ALLOWED IN DB2 PRIVATE PROTOCOL PROCESSING
-729 A STORED PROCEDURE SPECIFYING COMMIT ON RETURN CANNOT BE THE TARGET OF A NE
-730 THE PARENT OF A TABLE IN A READ-ONLY SHARED DATABASE MUST ALSO BE A TABLE I
-731 USER-DEFINED DATASET ${dsname} MUST BE DEFINED WITH SHAREOPTIONS(1,3)
-732 THE DATABASE IS DEFINED ON THIS SUBSYSTEM WITH THE ROSHARE READ ATTRIBUTE B
-733 THE DESCRIPTION OF A TABLE SPACE, INDEX SPACE, OR TABLE IN A ROSHARE READ D
-734 THE ROSHARE ATTRIBUTE OF A DATABASE CANNOT BE ALTERED FROM ROSHARE READ
-735 DATABASE ${dbid} CANNOT BE ACCESSED BECAUSE IT IS NO LONGER A SHARED DATABA
-736 INVALID OBID ${obid} SPECIFIED
-737 IMPLICIT TABLE SPACE NOT ALLOWED
-739 CREATE OR ALTER FUNCTION ${function-name} FAILED BECAUSE FUNCTIONS CANNOT M
-740 FUNCTION ${name} IS DEFINED WITH THE OPTION MODIFIES SQL DATA WHICH IS NOT
-741 A ${database-type} DATABASE IS ALREADY DEFINED FOR MEMBER ${member-name}
-742 DSNDB07 IS THE IMPLICIT WORK FILE DATABASE
-746 THE SQL STATEMENT IN AN EXTERNAL FUNCTION, TRIGGER, OR IN STORED PROCEDURE
-747 TABLE ${table-name} IS NOT AVAILABLE UNTIL THE AUXILIARY TABLES AND INDEXES
-748 AN INDEX ALREADY EXISTS ON AUXILIARY TABLE ${table-name}
-750 THE SOURCE TABLE ${source-name} CANNOT BE RENAMED BECAUSE IT IS REFERENCED
-751 ${object-type} ${object-name} (SPECIFIC NAME ${specific} ${name}) ATTEMPTED
-752 THE CONNECT STATEMENT IS INVALID BECAUSE THE PROCESS IS NOT IN THE CONNECTA
-763 INVALID TABLE SPACE NAME ${table-space-name}
-764 A LOB TABLE SPACE AND ITS ASSOCIATED BASE TABLE SPACE MUST BE IN THE SAME D
-765 TABLE IS NOT COMPATIBLE WITH DATABASE
-766 THE OBJECT OF A STATEMENT IS AN AUXILIARY TABLE FOR WHICH THE REQUESTED OPE
-767 MISSING OR INVALID COLUMN SPECIFICATION FOR INDEX ${index-name}
-768 AN AUXILIARY TABLE ALREADY EXISTS FOR THE SPECIFIED COLUMN OR PARTITION
-769 SPECIFICATION OF CREATE AUX TABLE DOES NOT MATCH THE CHARACTERISTICS OF THE
-770 TABLE ${table-name} CANNOT HAVE A LOB COLUMN UNLESS IT ALSO HAS A ROWID COL
-771 INVALID SPECIFICATION OF A ROWID COLUMN
-772 ATTEMPTED TO CAST AN INVALID VALUE TO A ROW ID TYPE
-797 ATTEMPT ${to} CREATE TRIGGER ${trigger-name} WITH AN UNSUPPORTED TRIGGERED
-798 YOU CANNOT INSERT A VALUE INTO A COLUMN THAT IS DEFINED WITH THE OPTION GEN
-802 EXCEPTION ERROR ${exception-type} HAS OCCURRED DURING ${operation-type} OPE
-803 AN INSERTED OR UPDATED VALUE IS INVALID BECAUSE THE INDEX IN INDEX SPACE ${
-804 AN ERROR WAS FOUND IN THE APPLICATION PROGRAM INPUT PARAMETERS FOR THE SQL
-805 DBRM OR PACKAGE NAME ${location-name}.${collection-id}.${dbrm-name}.${consi
-807 ACCESS DENIED: PACKAGE ${package-name} IS NOT ENABLED FOR ACCESS FROM ${con
-808 THE CONNECT STATEMENT IS NOT CONSISTENT WITH THE FIRST CONNECT STATEMENT
-811 THE RESULT OF AN EMBEDDED SELECT STATEMENT OR A SUBSELECT IN THE SET CLAUSE
-812 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE A BLANK COLLECTION-ID WAS FOU
-815 A GROUP BY OR HAVING CLAUSE IS IMPLICITLY OR EXPLICITLY SPECIFIED IN A SUBS
-817 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE STATEMENT WILL RESULT IN A
-818 THE PRECOMPILER-GENERATED TIMESTAMP ${x} IN THE LOAD MODULE IS DIFFERENT FR
-819 THE VIEW CANNOT BE PROCESSED BECAUSE THE LENGTH OF ITS PARSE TREE IN THE CA
-820 THE SQL STATEMENT CANNOT BE PROCESSED BECAUSE ${catalog-table} CONTAINS A V
-822 THE SQLDA CONTAINS AN INVALID DATA ADDRESS OR INDICATOR VARIABLE ADDRESS
-840 TOO MANY ITEMS RETURNED IN A SELECT OR INSERT LIST
-842 A CONNECTION TO ${location-name} ALREADY EXISTS
-843 THE SET CONNECTION OR RELEASE STATEMENT MUST SPECIFY AN EXISTING CONNECTION
-845 A PREVVAL EXPRESSION CANNOT BE USED BEFORE THE NEXTVAL EXPRESSION GENERATES
-846 INVALID SPECIFICATION OF AN IDENTITY COLUMN OR SEQUENCE OBJECT ${object}_${
-867 INVALID SPECIFICATION OF A ROWID COLUMN
-870 THE NUMBER OF HOST VARIABLES IN THE STATEMENT IS NOT EQUAL TO THE NUMBER OF
-872 A VALID CCSID HAS NOT YET BEEN SPECIFIED FOR THIS SUBSYSTEM
-873 DATA ENCODED WITH DIFFERENT ENCODING SCHEMES CANNOT BE REFERENCED IN THE SA
-874 THE ENCODING SCHEME SPECIFIED FOR THE ${object-type} MUST BE THE SAME AS TH
-875 ${operand} CANNOT BE USED WITH THE ASCII DATA REFERENCED
-876 '${object}' CANNOT BE CREATED, REASON '${reason}'
-877 CCSID ASCII OR CCSID UNICODE IS NOT ALLOWED FOR THIS DATABASE OR TABLE SPAC
-878 THE PLAN_TABLE USED FOR EXPLAIN CANNOT BE ASCII OR UNICODE
-879 CREATE ${or} ALTER STATEMENT FOR ${obj-name} CANNOT DEFINE A COLUMN, DISTIN
-880 SAVEPOINT ${savepoint-name} DOES NOT EXIST OR IS INVALID IN THIS CONTEXT
-881 A SAVEPOINT WITH NAME ${savepoint-name} ALREADY EXISTS, BUT THIS SAVEPOINT
-882 SAVEPOINT DOES NOT EXIST
-900 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THE APPLICATION PROCESS IS NOT
-901 UNSUCCESSFUL EXECUTION CAUSED BY A SYSTEM ERROR THAT DOES NOT PRECLUDE THE
-902 POINTER TO THE ESSENTIAL CONTROL BLOCK (CT/RDA) HAS VALUE 0, REBIND REQUIRE
-904 UNSUCCESSFUL EXECUTION CAUSED BY AN UNAVAILABLE RESOURCE. REASON ${reason-c
-905 UNSUCCESSFUL EXECUTION DUE TO RESOURCE LIMIT BEING EXCEEDED, RESOURCE NAME
-906 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE THIS FUNCTION IS DISABLED DUE
-908 ${bind-type} ERROR USING ${auth-id} AUTHORITY. BIND, REBIND OR AUTO-REBIND
-909 THE OBJECT HAS BEEN DELETED
-910 THE SQL STATEMENT CANNOT ACCESS AN OBJECT ON WHICH A DROP OR ALTER IS PENDI
-911 THE CURRENT UNIT OF WORK HAS BEEN ROLLED BACK DUE TO DEADLOCK OR TIMEOUT. R
-913 UNSUCCESSFUL EXECUTION CAUSED BY DEADLOCK OR TIMEOUT. REASON CODE ${reason-
-917 BIND PACKAGE FAILED
-918 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE A CONNECTION HAS BEEN LOST
-919 A ROLLBACK OPERATION IS REQUIRED
-922 AUTHORIZATION FAILURE: ${error-type} ERROR. REASON ${reason-code}
-923 CONNECTION NOT ESTABLISHED: DB2 ${condition} REASON ${reason-code}, TYPE ${
-924 DB2 CONNECTION INTERNAL ERROR, ${function-code}, ${return-code}, ${reason-c
-925 COMMIT NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-926 ROLLBACK NOT VALID IN IMS, CICS OR RRSAF ENVIRONMENT
-927 THE LANGUAGE INTERFACE (LI) WAS CALLED WHEN THE CONNECTING ENVIRONMENT WAS
-929 FAILURE IN A DATA CAPTURE EXIT: ${token}
-939 ROLLBACK REQUIRED DUE TO UNREQUESTED ROLLBACK OF A REMOTE SERVER
-947 THE SQL STATEMENT FAILED BECAUSE IT WILL CHANGE A TABLE DEFINED WITH DATA C
-948 DISTRIBUTED OPERATION IS INVALID
-950 THE LOCATION NAME SPECIFIED IN THE CONNECT STATEMENT IS INVALID OR NOT LIST
-952 PROCESSING WAS INTERRUPTED BY A CANCEL REQUEST FROM A CLIENT PROGRAM
-965 STORED PROCEDURE OR FUNCTION ${name} TERMINATED ABNORMALLY
-981 THE SQL STATEMENT FAILED BECAUSE THE RRSAF CONNECTION IS NOT IN A STATE THA
-989 AFTER TRIGGER ${trigger-name} ATTEMPTED TO MODIFY A ROW IN TABLE ${table-na
-991 CALL ATTACH WAS UNABLE TO ESTABLISH AN IMPLICIT CONNECT OR OPEN TO DB2. RC1
-1403 THE USERNAME AND/OR PASSQWORD SUPPLIED IS INCORRECT
-1760 CREATE PROCEDURE FOR ${procedure-name} MUST HAVE VALID LANGUAGE AND EXTERN
-2001 THE NUMBER OF HOST VARIABLE PARAMETERS FOR A STORED PROCEDURE IS NOT EQUAL
-4700 ATTEMPT TO USE NEW FUNCTION BEFORE NEW FUNCTION MODE
-4701 :THE COMBINATION OF THE NUMBER OF TABLE SPACE PARTITIONS AND THE CORRESPON
-4702 TABLE HAS HAD THE MAXIMUM NUMBER OF ALTERS ALLOWED
-4703 THE ALTER TABLE STATEMENT CANNOT BE EXECUTED BECAUSE COLUMN ${name} ${colu
-5011 HOST STRUCTURE ARRAY ${host-structure-array} IS EITHER NOT DEFINED OR IS N
-5012 HOST VARIABLE ${host-variable} IS NOT EXACT NUMERIC WITH SCALE ZERO -${ske
-20003 GBPCACHE NONE CANNOT BE SPECIFIED FOR TABLESPACE OR INDEX IN GRECP
-20004 8K ${or} 16K BUFFERPOOL PAGESIZE INVALID FOR A WORKFILE OBJECT
-20005 THE INTERNAL ID LIMIT OF ${limit} HAS BEEN EXCEEDED FOR OBJECT TYPE ${obj
-20006 LOBS CANNOT BE SPECIFIED AS PARAMETERS WHEN NO WLM ENVIRONMENT IS SPECIFI
-20008 UNSUPPORTED OPTION ${keyword} SPECIFIED
-20058 THE FULLSELECT SPECIFIED FOR MATERIALIZED QUERY TABLE ${table-name} IS NO
-20070 AUXILIARY TABLE ${table-name} CANNOT BE CREATED BECAUSE COLUMN ${column-n
-20071 WLM ENVIRONMENT NAME MUST BE SPECIFIED ${function-name}
-20072 ${csect-name} ${bind-type} ${bind-subtype} ERROR USING ${auth-id} AUTHORI
-20073 THE FUNCTION ${function-name} CANNOT BE ALTERED BECAUSE IT IS REFERENCED
-20074 THE OBJECT ${object-name} CANNOT BE CREATED BECAUSE THE FIRST THREE CHARA
-20091 A VIEW NAME WAS SPECIFIED AFTER LIKE IN ADDITION TO THE INCLUDING IDENTIT
-20092 A VIEW WAS SPECIFIED FOR LIKE BUT IT INCLUDES A ROWID COLUMN
-20093 THE TABLE ${table-name} CANNOT BE CONVERTED TO OR FROM A MATERIALIZED QUE
-20100 AN ERROR OCCURRED WHEN BINDING A TRIGGERED SQL STATEMENT. INFORMATION RET
-20101 THE FUNCTION ${function} FAILED WITH REASON ${rc}
-20102 CREATE OR ALTER STATEMENT FOR ROUTINE ${routine-name} SPECIFIED THE ${opt
-20104 AN ATTEMPT TO ALTER A CCSID FROM ${from-ccsid} TO ${to-ccsid} FAILED
-20106 THE CCSID FOR TABLE SPACE OR DATABASE CANNOT BE CHANGED BECAUSE THE TABLE
-20107 HOST VARIABLE OR PARAMETER NUMBER ${position-number} CANNOT BE USED AS SP
-20108 A RESULT SET CONTAINS AN UNSUPPORTED DATA TYPE IN POSITION NUMBER ${posit
-20110 CANNOT IMPLICITLY CONNECT TO A REMOTE SITE WITH A SAVEPOINT OUTSTANDING
-20111 CANNOT ISSUE SAVEPOINT, RELEASE SAVEPOINT, ROLLBACK TO SAVEPOINT FROM A T
-20123 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET RETUR
-20124 OPEN CURSOR ${cursor} FAILED BECAUSE THE CURSOR IS SCROLLABLE BUT THE CLI
-20125 CALL TO STORED PROCEDURE ${procedure} FAILED BECAUSE THE RESULT SET FOR C
-20126 CURSOR ${cursor} IS DEFINED AS SCROLLABLE, BUT THE ENVIRONMENT INVOLVES A
-20127 VALUE SPECIFIED ON FETCH STATEMENT FOR ABSOLUTE OR RELATIVE IS TOO LARGE
-20129 LOCAL SPECIAL REGISTER IS NOT VALID AS USED
-20142 SEQUENCE ${sequence-name} CANNOT BE USED AS SPECIFIED
-20163 HEXADECIMAL CONSTANT GX IS NOT ALLOWED
-20164 SENSITIVE CURSOR ${cursor-name} IS DEFINED FOR A SELECT STATEMENT CONTAIN
-20165 INSERT STATEMENT WITHIN A SELECT IS NOT ALLOWED IN THE CONTEXT IN WHICH I
-20166 INSERT STATEMENT WITHIN A SELECT SPECIFIED VIEW ${view-name} WHICH IS NOT
-20174 ALTER TABLE STATEMENT FOR ${table-name} SPECIFIED A PRECISION AND SCALE T
-20177 SET DATA TYPE CLAUSE ON ALTER TABLE SPECIFIED FLOATING POINT, BUT THIS CH
-20180 COLUMN ${column-name} IN TABLE ${table-name} CANNOT BE ALTERED AS SPECIFI
-20181 COLUMN CANNOT BE ADDED TO INDEX ${index-name}
-20182 ${values} PARTITIONING CLAUSE ON ${stmt-type} STATEMENT FOR ${index-name}
-20183 THE PARITIONED, ADD PART, ADD PARTITIONING KEY, OR ALTER PART CLAUSE SPEC
-20185 CURSOR ${cursor-name} IS NOT DEFINED TO ACCESS ROWSETS, BUT A CLAUSE WAS
-20186 A CLAUSE WAS SPECIFIED THAT IS NOT VALID FOR THE STATEMENT BEING PREPARED
-20200 THE INSTALL OR REPLACE OF ${jar-id} WITH URL ${url} FAILED DUE TO REASON
-20201 THE INSTALL, REPLACE OR REMOVE OF ${jar-name} FAILED DUE TO REASON ${reas
-20202 THE REPLACE OR REMOVE OF ${jar-name} FAILED AS ${class} IS IN USE
-20203 USER-DEFINED FUNCTION OR PROCEDURE ${name} HAS A JAVA METHOD WITH AN INVA
-20204 THE USER-DEFINED FUNCTION OR PROCEDURE ${routine-name} WAS UNABLE TO MAP
-20207 THE INSTALL OR REMOVE OF ${jar-name} SPECIFIED THE USE OF A DEPLOYMENT DE
-20210 THE SQL STATEMENT CANNOT BE EXECUTED BECAUSE IT WAS AT A LEVEL THAT IS IN
-20212 USER-DEFINED ROUTINE ${name} ENCOUNTERED AN EXCEPTION ATTEMPTING TO LOAD
-20213 STORED PROCEDURE ${procedure-name} HAS RETURNED A DYNAMIC RESULT SET OF A
-20227 REQUIRED CLAUSE IS MISSING FOR ARGUMENT ${number} OF ${expression}
-20248 ATTEMPTED TO EXPLAIN A CACHED STATEMENT WITH STMTID OR STMTTOKEN ID-${tok
-20275 The XML NAME ${xml-name} IS NOT VALID. REASON CODE = ${reason-code}.
-20276 The XML NAMESPACE PREFIX ${xml-namespace-prefix} IS NOT VALID. REASON COD
-30000 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL NOT AFFEC
-30002 THE SQL STATEMENT CANNOT BE EXECUTED DUE TO A PRIOR CONDITION IN A CHAIN
-30005 EXECUTION FAILED BECAUSE FUNCTION NOT SUPPORTED BY THE SERVER: LOCATION $
-30020 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT CAUSED DEALLOC
-30021 EXECUTION FAILED DUE TO A DISTRIBUTION PROTOCOL ERROR THAT WILL AFFECT TH
-30025 EXECUTION FAILED BECAUSE FUNCTION IS NOT SUPPORTED BY THE SERVER WHICH CA
-30030 COMMIT REQUEST WAS UNSUCCESSFUL, A DISTRIBUTION PROTOCOL VIOLATION HAS BE
-30040 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL NOT AFFECT THE SU
-30041 EXECUTION FAILED DUE TO UNAVAILABLE RESOURCES THAT WILL AFFECT THE SUCCES
-30050 <${command-or-SQL-statement-type} COMMAND OR SQL STATEMENT INVALID WHILE
-30051 BIND PROCESS WITH SPECIFIED PACKAGE NAME AND CONSISTENCY TOKEN NOT ACTIVE
-30052 PROGRAM PREPARATION ASSUMPTIONS ARE INCORRECT
-30053 OWNER AUTHORIZATION FAILURE
-30060 RDB AUTHORIZATION FAILURE
-30061 RDB NOT FOUND
-30070 ${command} COMMAND NOT SUPPORTED ERROR
-30071 ${object-type} OBJECT NOT SUPPORTED ERROR
-30072 ${parameter} ${subcode} PARAMETER NOT SUPPORTED ERROR
-30073 ${parameter} ${subcode} PARAMETER VALUE NOT SUPPORTED ERROR
-30074 REPLY MESSAGE WITH ${codepoint} (${svrcod}) NOT SUPPORTED ERROR
-30080 COMMUNICATION ERROR ${code} (${subcode})
-30081 ${prot} COMMUNICATION ERROR DETECTED. API=${api}, LOCATION=${loc}, FUNCTI
-30082 CONNECTION FAILED FOR SECURITY REASON ${reason-code} (${reason-string})
-30090 REMOTE OPERATION INVALID FOR APPLICATION EXECUTION ENVIRONMENT
-30104 ERROR IN BIND OPTION ${option} AND BIND VALUE ${value}.
-30105 BIND OPTION ${option1} IS NOT ALLOWED WITH BIND OPTION ${option2}
-30106 INVALID INPUT DATA DETECTED FOR A MULTIPLE ROW INSERT OPERATION. INSERT P
??????????????????????????????????????????????????????????????????????*/
}¢--- A540769.WK.REXX.O08(SRCLI2) cre=2008-04-14 mod=2008-04-14-15.13.52 F540769 ---
/* REXX ****/
say timing() '***'
call srcLine
say timing() '*** after srcLine'
call readDsn 'A540769.WK.REXX(SRCLINE)', m.
say timing() '*** after read' m.0
r = encode(1, m.0)
say timing() '*** after encode' length(r) left(r, 500)
interpret r
say timing() '*** after interpret' 1 n.1
m = m.0
say timing() '*** after interpret' m n.m
exit
encode: procedure expose m.
parse arg f, t
if f >= t then
return 'n.'f '=' quote(strip(m.f))';'
mm = (f+t) % 2
return encode(f, mm) encode(mm+1, t)
else if f+1 = t then
return strip(m.f)
do y=1 to m.0
r = r 'n.'y '=' quote(strip(m.y))';'
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 -------------------------------------------*/
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 = '' & ^ abbrev(disp, 'SYSO') then
return 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 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
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(SRT) cre=2008-06-20 mod=2008-06-23-15.21.36 F540769 ---
call sortTest
/* copy sort begin ****************************************************/
sort: procedure expose m.
parse arg i, o
call sort1 i, 1, m.i.0, o, 1, sort.work, 1
m.o.0 = m.i.0
return
endProcedure sort
sort1: procedure expose m.
parse arg i, i0, le, o, o0, w, w1
if le <= 1 then do
if le = 1 then
m.o.o0 = m.i.i0
return
end
h = (le + 1) % 2
call sort1 i, i0, h, o, o0+le-h, w, w1
call sort1 i, i0+h, le-h, w, w1, o, o0
call sortMerge o, o0+le-h, o0+le, w, w1, w1+le-h, o, o0
return
endProcedure sort1
sortMerge: procedure expose m.
parse arg l, l0, le, r, r0, re, o, o0
do while l0 < le & r0 < re
if m.l.l0 <<= m.r.r0 then do
m.o.o0 = m.l.l0
l0 = l0 + 1
end
else do
m.o.o0 = m.r.r0
r0 = r0 + 1
end
o0 = o0 + 1
end
do while l0 < le
m.o.o0 = m.l.l0
l0 = l0 + 1
o0 = o0 + 1
end
do while r0 < re
m.o.o0 = m.r.r0
r0 = r0 + 1
o0 = o0 + 1
end
return
endProcedure sortWork
sortTest: procedure expose m.
m.i.1 = eins
m.i.2 = zwei
m.i.3 = drei
m.i.4 = vier
m.i.5 = fuenf
m.i.6 = sechs
m.i.7 = sieben
m.i.8 = acht
m.i.9 = neun
m.i.10 = zehn
m.i.11 = elf
m.i.12 = zwoelf
m.i.13 = dreizehn
m.i.14 = vierzehn
m.i.15 = 1
m.i.16 = 2
m.i.17 = 3
m.i.18 = 4
m.i.19 = 4
m.i.20 = 3
m.i.21 = 2
m.i.22 = 1
m.i.23 = 0
m.i.24 = 1
yy = 27
do while yy > 0
do x = 0 to yy
m.i.0 = x
call sort i, o
m = ''
la = ''
if x <> m.o.0 then
call err 'size mismatch' x '<>' m.o.0
do y=1 to m.o.0
m = m m.o.y
if ^ (la << m.o.y) then
call err 'sort mismatch' yy x y '^' la '<<' m.o.y
end
end
say 'sort' yy m
do x = 2 to yy
x1 = x-1
m.i.x1 = m.i.x
end
yy = yy-1
end
endProcedure sortTest
im = (ie + ib) % 2
bs = 'SORT.'nx
ms = 'SORT.' || (nx+1)
call sort1 nx+2, bs, i, ib, im
call sort1 nx+2, ms, i, im, ie
bx = 1
bz = 1 + im - ib
mx = 1
mz = 1 + ie - im
ox = 0
do while bx < bz & mx < mz
bk = m.bs.bx
mk = m.ms.mx
ox = ox+1
if m.bk <= m.mk then do
m.o.ox = bk
bx = bx + 1
end
else do
m.o.ox = mk
mx = mx + 1
end
end
do bx=bx to bz-1
ox = ox + 1
m.o.ox = m.bs.bx
end
do mx=mx to mz-1
ox = ox + 1
m.o.ox = m.ms.mx
end
return
endProcedure sort1
/* copy sort end ****************************************************/
}¢--- A540769.WK.REXX.O08(SV) cre=2006-05-29 mod=2008-05-20-17.52.03 F540769 ---
/* 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
trace ?R
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(3000)' ,
'space(100, 1000) block(30040) mgmtclas(s005y000)'
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(s005y000) 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(T) cre=2009-09-18 mod=2009-09-18-09.16.37 A540769 ----
/* copy sqlO begin ***************************************************
sql interface mit o und j Anbindung
***********************************************************************/
sqlOini: procedure expose m.
if m.sqlO.ini == 1 then
return
m.sqlO.ini = 1
call sqlIni
call envIni
call oDecMethods oNewClass("SqlType", "JRW"),
, "jOpen call sqlOpen substr(m, 8); m.m.jReading = 1",
, "jClose call sqlClose substr(m, 8)",
, "jRead return sqlFetch(substr(m, 8), var)"
call oDecMethods oNewClass("SqlLn", "SqlType"),
, "jRead return sqlFetchLn(substr(m, 8), var)"
return
endProcedure sqlOini
/*--- fetch all rows into stem st
from sql src using type ty and format fmt -----------------*/
sql2St: procedure expose m.
parse arg st, src, ty, fmt
cx = 49
call sql2Cursor cx, src, ty, fmt
call sqlOpen cx
do ix=1 by 1 while sqlFetch(cx, st'.'ix)
end
m.st.0 = ix-1
call sqlClose cx
return ix-1
endProcedure sql2St
/*--- prepare statement 's'cx and declare cursor 'c'cx from sql src
use or generate type ty and format fo ---------------------*/
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
call sqlPreDeclare cx, src, 1 /* with describe output */
call sqlGenType cx, ty
m.Sql.cx.FMT.0 = 0
m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
return
endProcedure sql2Cursor
/*--- return the type for sql cx -------------------------------------*/
sqlType: procedure expose m.
parse arg cx
return oGetTypePara('SQL.TY.'cx)
/*--- fetch cursor 'c'cx into destination dst
each column is formatted and assigned to m.dst.<colName> ---*/
sqlFetch: procedure expose m.
parse arg cx, dst
if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
return 0
if dst == '' then
return 1
fi = oFlds(sqlType(cx))
fo = m.sql.cx.fmt
do ix=1 to m.sql.cx.d.SQLD
f = m.fi.ix
if m.sql.cx.d.ix.sqlInd = 0 then
m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
else
m.dst.f = fmtS(m.sqlNull, m.fo.ix)
end
return 1
endProcedure sqlFetch
/*--- fetch cursor 'c'cx
put the formatted and concatenated columns into m.var
return 1 if a row fetched, 0 if not ------------------------*/
sqlFetchLn: procedure expose m.
parse arg cx, var
st = 'SQL.'cx'.FET'
if ^ sqlFetch(cx, st) then
return 0
m.var = oFldCat(sqlType(cx), st, m.sql.cx.fmt)
return 1
endProcedure sqlFetchLn
/*--- generate the type sql cx as specified in ty
use the information from the sqlDa -------------------------*/
sqlGenType: procedure expose m.
parse arg cx, ty
if ty == '*' | ty = '' then do
ff = ''
do ix=1 to m.sql.cx.d.sqlD
f1 = word(m.sql.cx.d.ix.sqlName, 1)
if f1 == '' then
f1 = 'COL'ix
ff = ff f1
end
ty = oFldOnly(ff, 'e')
end
call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
return ty
endProcedure sqlGenType
/*--- generate the format ff for a sql cx as specified in sp
use the information from the sqlDa -------------------------*/
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
if abbrev(sp, '=') then
return substr(sp, 2)
if sp = '' then
sp = '*st'
m.ff.0 = m.sql.cx.d.sqlD
m.ff.flds = oFlds(sqlType(cx))
if abbrev(sp, '*') then do
do ix=1 to m.ff.0
m.ff.ix = substr(sp, 2)
end
return ff
end
if abbrev(fmts, '=') then
m.Sql.cx.FMT = substr(fmts, 2)
defs = 'ir7 fr9 sl12 Tl26' sp
do wx = 1 to words(defs)
parse value word(defs, wx) with ty 2 fo
select
when ty = 'd' then t.384 = fo
when ty = 'f' then t.480 = fo'/f'
when ty = 'i' then t.496 = fo'/i'
when ty = 'n' then t.484 = fo'/n'
when ty = 's' then t.448 = fo
when ty = 't' then t.388 = fo
when ty = 'T' then t.392 = fo
otherwise call err 'bad type' ty 'for format' fo
end
end
if symbol('t.496') == 'VAR' then
t.500 = t.496
if symbol('t.448') == 'VAR' then do
t.452 = t.448
t.456 = t.448
t.464 = t.448
end
do wx = 1 to m.ff.0
ty = m.sql.cx.d.wx.sqlType
le = m.sql.cx.d.wx.sqlLen
withNulls = ty // 2
ty = ty - withNulls
if symbol('t.ty') <> 'VAR' then
call err 'sqlType' ty 'not supported'
parse var t.ty fo 2 fl '/' op
if op = 'i' then
if le = 2 then le = 6
else le = 12
else if op <> '' then
call err 'length for sqlType' ty 'op' op 'not implemented'
if fl = '=' then
fl = le
else if abbrev(fl, '<') then
fl = min(le, substr(fl, 2))
m.ff.wx = fo || fl
end
return ff
endProcedure sqlGenFmt
/*--- sql o interface ------------------------------------------------*/
/*--- return a reader for the givenn sql or std input ----------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
if ty = '' then
ty = '*'
if src == '' then
src = envCatStr(' ', 'sb')
call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
call oMutate 'SQL.TY.'cx, 'SqlType'
return 'SQL.TY.'cx
endProcedure sql2obj
/*--- write to std output the result columns of
the sql given in src or std input --------------------------*/
sql: procedure expose m.
parse arg cx, src, ty, fo
call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
return
endProcedure sql
/*--- write to std output the result lines of
the sql given in src or std input --------------------------*/
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
if fo = '' then
fo = '~'
squash = abbrev(fo, '~')
if ^ abbrev(fo, '=') then
fo = left(fo, squash) 'sl=' substr(fo, squash+1)
t = sql2Obj(cx, src, ty, fo)
if squash then do
call fmtFldSquashRw t, 'opCl'
return
end
m = 'SQL.LN.'cx
call oMutate m, 'SqlLn'
call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
call jWriteAll m.j.jOut, "r£", m
return
endProcedure sqlLn
/* copy sqlO end **************************************************/
}¢--- A540769.WK.REXX.O08(TESTBIND) cre=2008-08-18 mod=2008-08-18-11.53.53 F540769 ---
call bind_rebind 'REBIND PACKAGE(DB.DBWK1.(DB2J000003))'
exit
Bind_Rebind:
parse arg bindOpts
'NEWSTACK'
/********************************************************************/
/* QUEUE "DSNE T(123)" contains tracing options */
/********************************************************************/
queue "DSNE"
queue BINDOPTS
queue "END"
x = outtrap('bindmsg.')
ADDRESS ATTCHMVS "DSNESM71" /* call "pre" bind */
bind_rc = rc /* set rc to DSNESM71 call */
x = outtrap('OFF')
'DELSTACK'
say 'bind rc' bind_rc D2X(ABS(bind_rc)) 'msgs' bindmsg.0
do x=1 to bindmsg.0
say bindmsg.x
end
return
}¢--- A540769.WK.REXX.O08(TESTISP) cre=2007-03-27 mod=2007-03-27-13.58.41 F540769 ---
/* rexx */
call lmmTest 'wk.rexx(*test*)'
exit
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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
m.dsnAlloc.dsn = ''
if left(spec, 1) = '=' then
return strip(substr(spec, 2))
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 to 3
w = word(spec, wx)
if w = '.' then do
wx = wx + 1
leave
end
if w = '' then
leave
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if m.dsnAlloc.dsn = '' then
m.dsnAlloc.dsn = dsn2jcl(w, addPref)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if m.dsnAlloc.dsn <> '' then
disp = disp "dsn('"m.dsnAlloc.dsn"')"
call adrTso 'alloc dd('dd')' disp subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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 ****************************************************/
}¢--- A540769.WK.REXX.O08(TESTM) cre=2007-01-11 mod=2007-01-11-15.40.35 F540769 ---
/*--- test -----------------------------------------------------------*/
r1 = mRoot(, 'r1', 'rootEins')
r2 = mRoot(, 'r2', 'rootZwei')
call mShow mPar(r2)
call mAdd r1, 'added:mAdd'
call mAdd r1, 'added:mAdd2'
call mAddKy r1, 'mAddKy', 'added:mAddKy a'
call mAddKy r1, 'mAddKy', 'added:mAddKy b'
call mAddK1 r1, 'mAddK1', 'added:mAddK1'
/* call mAddK1 r1, 'mAddK1', 'added:mAddK2' */
r11 = mAddKy(r1, 'mAddKy', 'added:mAddKy')
say '*** show2'
call mShow mPar(r2)
say 'r1¢mAddKy!' mAtK1(r1, 'mAddKy')
say 'r1¢mAddK1!' mAtK1(r1, 'mAddK1')':' mVaAtK1(r1, 'mAddK1')
call mAddK1 r11, 1, 111
call mAddK1 r11, 2, 112
call mAddK1 r11, 3, 113
call mAddK1 r11, 4, 114
call mPut r11, 3, 'drei put'
call mPut r11, 5, 'fuenf put'
say 'r11¢2!' mVaAtK1(r11, 2) '¢4!' mVaAtK1(r11, 4)
say '*** show3'
call mShow mPar(r2)
say 'mAddTree root2, root1'
call mAddTree r2, r1
r23 = mAtSq(r2, 3)
say 'mAddTree' r23', root1'
call mAddTree r23, r1
say '*** show4'
call mShow mPar(r2)
call mShowNd r2
call mShowNd r23
r23i = mAtK1(r23, 'mAddK1')
call mShowNd r23i
say 'mRemCh r2'
call mRemCh r2
call mShowNd r2
call mShowNd r23
call mShowNd r23i
say '*** show5'
call mShow mPar(r2)
exit
/* copy m begin ********************************************************
stem and tree handling
***********************************************************************/
/*--- increase m.m and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg m, delta
if delta = '' then
m.m = m.m + 1
else
m.m = m.m + delta
return m.m
endProcedure mInc
/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
parse arg m, delta
if symbol('m.m') <> 'VAR' then
m.m = 0
return mInc(m)
endProcedure mIncD
/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
parse arg m
return m.mKey.m
endProcedure mKy
/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
parse arg m
if symbol('m.m.0') == 'VAR' then
return m.m.0
else
return 0
endProcedure mSize
/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg m
dx = lastPos('.', m)
if dx <= 1 then
return ''
else
return left(m, dx - 1)
endProcedure mPar
/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg m, Ky, val
if m == '' then
m = 'mRoot.' || mIncD('mRoot.0')
m.m = val
m.mKey.m = Ky
m.m.0 = 0
return m
endProcedure mRoot
/*--- add one or several values to stem m.m --------------------------*/
mAdd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
end
m.m.0 = ix
return m'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSeq: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
dx = mSize(dst)
do sx = begX to endX
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return dst
endProcedure mAddSeq
/*--- add one value to the stem m.m ----------------------------------*/
mAddNd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
m.m.ix.0 = 0
end
m.m.0 = ix
return m'.'ix
endProcedure mAddNd
/*--- add one Ky value pair to stem m.m -----------------------------*/
mAddKy: procedure expose m.
parse arg m, Ky, val
nn = mAddNd(m, val)
m.mKey.nn = Ky
return nn
endProcedure mAddKy
/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
parse arg m, ky, val
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
call err 'duplicate Ky' ky 'for node' m
nn = mAddNd(m, val)
m.mKey.nn = ky
m.mIndex.m.mKey.ky = nn
return nn
endProcedure mAddK1
/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg m, Ky, val
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
m.ch = val
return ch
end
else do
return mAddK1(m, Ky, val)
end
return
endProcedure mPut
/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg m, ky
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
return m.mIndex.m.mKey.ky
else
return ''
endProcedure mAtK1
/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg m, Ky
if symbol('m.mIndex.m.mKey.Ky') ^== 'VAR' then
call err 'no Ky' Ky 'at node' m
ch = m.mIndex.m.mKey.Ky
return m.ch
endProcedure mVaAtK1
/*--- return the value of the first defined ky in the list of nodes
def if ky isn't defined ---------------------------------------*/
mFirst: procedure expose m.
parse arg Ky, def
do ax=3 to arg()
m = arg(ax)
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
return m.ch
end
end
return def
endProcedure mFirst
/*--- return the child at sequenceNo seq of node m -------------------*/
mAtSq: procedure expose m.
parse arg m, seq
if symbol('m.m.seq') ^== 'VAR' then
return ''
else
return m'.'seq
endProcedure mAtSq
/*--- remove all or all after nwSz children --------------------------*/
mRemCh: procedure expose m.
parse arg pa, nwSz
if nwSz = '' then
nwSz = 0
do cx=nwSz+1 to mSize(pa)
ch = pa'.'cx
call mRemCh ch
ky = m.mKey.ch
drop m.mIndex.pa.mKey.ky m.mKey.ch m.ch m.ch.0
end
m.pa.0 = nwSz
return pa
endProcedure mRemCh
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mAddTree: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
do sx=begX to endX
sCh = src'.'sx
if symbol('m.mKey.sCh') ^= 'VAR' then do
dCh = mAddNd(dst, m.sCh)
end
else do
ky = m.mKey.sCh
if symbol('m.mIndex.src.mKey.ky') ^= 'VAR' then
dCh = mAddKy(dst, ky, m.sCh)
else
dCh = mAddK1(dst, ky, m.sCh)
end
call mAddTree dCh, sCh
end
return dst
endProcedure mAddTree
/*--- show from one node everything that is defined) -----------------*/
mShowNd: procedure expose m.
parse arg m
pa = mPar(m)
t = 'node' m 'pa='pa
if symbol('m.m') == 'VAR' then
t = t 'va='m.m
if symbol('m.m.0') == 'VAR' then
t = t 'size='m.m.0
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
t = t 'ky='ky
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t = t 'index='m.mIndex.pa.mKey.ky
end
say t
return
endProcedure mShowNd
/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg m, lv
if lv = '' then
lv = 0
t = left('', lv)m
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
pa = mPar(m)
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t= t ky '>'
else
t= t ky '='
end
say t strip(m.m, 't')
do cx=1 to mSize(m)
call mShow mAtSq(m, cx), lv+1
end
return
endProcedure treeShow
/* copy m end *********************************************************/
}¢--- A540769.WK.REXX.O08(TIMETOD) cre=2006-11-24 mod=2006-11-28-10.17.45 F540769 ---
con = x2c('17F6AC7307C07544') 00010002
tod = con2tod(con) 00020000
say 'con' c2x(con) 'tod' c2x(tod) 'tst' tod2tst(tod) 00030002
ts = '2006-12-24-15.21.03.987689' 00040002
tod = tst2tod(ts) 00050002
say ts '-> tst2tod ->' c2x(tod) 00060002
t2 = tod2tst(tod) 00070002
say t2 '<- tod2tst <-' c2x(tod) 00080002
tod = '17B6EA0B0EADABE5'x 00090002
t2 = tod2tst(tod) 00100002
say t2 '<- tod2tst <-' c2x(tod) 00110002
to2 = tst2tod(t2) 00120002
say t2 '-> tst2tod ->' c2x(to2) 00130002
exit 00140000
/*--- conversion from tod clock value to timestamp ---------------------00150002
tod is utc ( = sommerzeit -2h, winterzeit -1h 00160002
und LeapSekunden können auch noch differieren|) 00170002
-------------- BLSUXTOD siehe Z/OS V1R7.0 MVS IPCS CUSTOMIZATION -----*/00180002
tod2Tst: procedure 00190002
parse arg tod 00200002
tst = left('', 26, '?') 00210002
address linkpgm "BLSUXTOD tod tst" 00220002
/* returns format MO/DD/YYYY HH:MM:SS.FFFFFF 00230002
but we want YYYY-Mo-DD-HH.MM.SS.FFFFFF (db2 tst) */ 00240002
parse var tst mo '/' dd '/' yyyy hh ':' mm ':' ss '.' ffffff 00250002
return yyyy'-'mo'-'dd'-'hh'.'mm'.'ss'.'ffffff 00260002
endProcedure tod2Tst 00270002
00280002
/*--- conversion from tst to tod clock value (stck) ------------------*/00290002
tst2tod: procedure 00300002
/* we get YYYY-Mo-DD-HH.MM.SS.FFFFFF (db2 tst) 00310002
but need MO/DD/YYYY HH:MM:SS.FFFFFF */ 00320002
parse arg yyyy '-' mo '-' dd '-' hh '.' mm '.' ss '.' ffffff 00330002
tst = mo'/'dd'/'yyyy hh':'mm':'ss'.'ffffff 00340002
tod = left('', 8, '?') 00350002
address linkPgm "BLSUXTID tst tod" 00360002
return tod 00370002
endProcedure tst2Tod 00380002
00390002
/* --- convert a db2 conToken to a TOD (stck) value --------------------00400002
Take the conttoken and split it into two 4 bytes halves. 00410002
second half needs (Shift Left Single) by 3 bits ---> = partB 00420002
--- Shift (left half || partB) again by 3 bits ---------------------*/00430002
con2tod: procedure 00440002
parse arg con 00450002
bi = left(x2b(c2x(con)), 64, 0) 00460002
return x2c(b2x(substr(bi, 4, 29) || substr(bi, 36, 29) || '000000'))00470002
endProcedure con2Tod 00480002
}¢--- A540769.WK.REXX.O08(TO01) cre=2007-04-13 mod=2007-05-07-15.12.27 F540769 ---
/* rexx ***************************************************************
***********************************************************************/
skels = '~wk.skels'
call readDsn skels'(TO01LOAD)', j.
jcList = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
call lmdBegin aaa, 'SAVR24.TO01.S24.**.UPU'
o = 0
tb = 0
jb = 0
do while lmdNext(aaa, d.)
do d=1 to d.0
tb = tb + 1
if tb // 30 = 1 then do
jb = jb + 1
jc = substr(jcList, jb, 1)
say 'job' jb jc 'tb' tb d.d
do j=1 to j.0
o = o + 1
o.o = chg(j.j, '@', jc)
end
end
call readDsn d.d, e.
do e=1 to e.0
cx = pos("LOG NO", e.e)
if cx < 1 then do
o = o + 1
o.o = e.e
end
else do
o = o + 1
o.o = left(e.e, cx-1) ,
'RESUME NO REPLACE COPYDDN(TCOPYD) LOG NO'
o = o + 1
o.o = ' ',
'STATISTICS TABLE(ALL) INDEX(ALL) UPDATE ALL'
o = o + 1
o.o = ' ENFORCE NO'
end
end
end
end
call lmdEnd aaa
say 'total jobs' jb 'tb' tb
call writeDsn skels'(TO01LoGE)', o., o, 1
exit
jobHead:
return
endSubroutine jobHead
if 0 then
call wslDsns
if 0 then
call makeJobs skels'(xmit#pta)', skels'(zglxmit)'
if 0 then
call makeClon skels'(clon#pta)', skels'(zglclon)'
if 1 then
call rmMembers DSN.DBA.DBOF.WSL
exit
wslList: procedure expose m.
parse arg dsn
call readDsn dsn, m.wsl.
wx = 0
do sx = 1 to m.wsl.0
sl = m.wsl.sx
if left(sl, 1) = '*' then
say 'ignoring' strip(sl, 't')
else do
wx = wx+1
m.wx.name = substr(sl, 1, 8)
m.wx.auft = substr(sl, 19, 2)
m.wx.rz = substr(sl, 24, 1)
m.wx.tim = substr(sl, 38, 5)
m.wx.mask = word(substr(sl, 50, 5), 1)
/* say m.wx.name 'auft' m.wx.auft 'rz' m.wx.rz 'um' m.wx.tim */
end
end
m.0 = wx
say m.0 'WSLs' form m.wsl.0 'lines from' dsn
return
endProcedure wlsList
wslDsns: procedure expose m.
pds = 'DSN.DBA.DBTF.WSL'
pre = 'DSN.DBA.'
suf = '.IFF'
do wx=1 to m.0
say m.wx.name sysDsn("'"pds"("strip(m.wx.name)")'")
fn = pre || overlay('Q', m.wx.name, 8) || suf
say fn sysDsn("'"fn"'")
end
return
endProcedure wslDsns
makeJobs: procedure expose m.
parse arg iDs, oDs
call readDsn iDs, j.
do ex=1 to j.0 while pos('EXEC', j.ex) < 4
end
say 'exec' ex strip(left(j.ex, 72), 't')
o = 0
do wx=1 to m.0
if m.wx.rz = '' then do
say 'ignoring' m.wx.name 'rz' m.wx.rz 'tim' m.wx.tim
iterate
end
do j=1 to ex-1
o = o + 1
o.o = chg(j.j, '???', left(m.wx.name, 7))
end
do r=2 to 4
if pos(r, m.wx.rz) < 1 then
iterate
do j=ex to j.0
o = o + 1
o.o = chg(j.j, '???', left(m.wx.name, 7), '|', r)
end
end
end
call writeDsn oDs, o., o, 1
return
endProcedure makeJobs
makeClon: procedure expose m.
parse arg iDs, oDs
call readDsn iDs, j.
o = 0
do wx=1 to m.0
isOld = translate(substr(m.wx.name, 8, 1), 'YN', 'CW')
isNew = translate(substr(m.wx.name, 8, 1), 'NY', 'CW')
say m.wx.name '==> isNew' isNew 'isOld' isOld
if ^ (isNew == 'Y' | isNew == 'N') then
call err 'isNew not Y or N but' isNew 'wsl' m.wx.name
do j=1 to j.0
if left(j.j, 3) = '---' then do
if isNew == 'Y' then
j.j = substr(j.j, 4)
else
iterate
end
o = o + 1
o.o = chg(j.j, '????', m.wx.name,
, '???', left(m.wx.name, 7) ,
, '¢', isNew,
, '!', isOld,
, '+++', m.wx.mask)
end
end
call writeDsn oDs, o., o, 1
return
endProcedure makeClon
rmMembers: procedure expose m.
parse arg dsn
mm = ''
do wx=1 to m.0
mm = mm m.wx.name
end
say 'remove from' dsn
say mm
parse upper pull an 2 .
if an ^== 'R' then
call err 'not removing answer was' an
call lmmRmMbr "'"dsn"'", mm
return
endProcedure makeClon
chg: procedure
parse arg text 73 over
do ax=2 by 2 to arg()
ol = arg(ax)
ne = arg(ax+1)
cx = 1
do forever
cx = pos(ol, text, cx)
if cx < 1 then
leave
text = left(text, cx-1) || ne ,
|| substr(text, cx + length(ol))
cx = cx + length(ne)
end
end
return strip(text, 't')
endProcedure chg
err:
call errA arg(1), 1
endSubroutine err
/* rexx */
call lmmTest
exit
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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
m.dsnAlloc.dsn = ''
if left(spec, 1) = '=' then
return strip(substr(spec, 2))
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 to 3
w = word(spec, wx)
if w = '.' then do
wx = wx + 1
leave
end
if w = '' then
leave
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if m.dsnAlloc.dsn = '' then
m.dsnAlloc.dsn = dsn2jcl(w, addPref)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if m.dsnAlloc.dsn <> '' then
disp = disp "dsn('"m.dsnAlloc.dsn"')"
call adrTso 'alloc dd('dd')' disp subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(TREE) cre=2006-11-03 mod=2006-11-03-12.20.34 F540769 ---
/* copy tree begin ****************************************************/
treeCopy: procedure expose m.
parse arg m, nx
if nx > length(m.treeCopy.m.src) then
qx = length(m.treeCopy.m.src)
else
qx = nx - 1
dst = m.treeCopy.m.dest
if dst ^= '' & m.treeCopy.m.read then do
v = left(m.treeCopy.m.src, qx)
if v ^= '' then
call treeAdd dst, , v
end
m.treeCopy.m.src = overlay('', m.treeCopy.m.src, 1, qx)
return
endProcedure treeCopy
treeCopyDest: procedure expose m.
parse arg m, nx, dst
call treeCopy m, nx
m.treeCopy.m.dest = dst
return
endProcedure treeCopyDest
treeCopyRead: procedure expose m.
parse arg m, rdr, var
if m.treeCopy.m.read then
call treeCopy m, 1 + length(m.treeCopy.m.src)
m.treeCopy.m.read = ooRead(rdr, var)
if m.treeCopy.m.read then
m.treeCopy.m.src = m.var
return m.treeCopy.m.read
endProcedure treeCopyRead
treeCopyOpen: procedure expose m.
parse arg m, rdr, keep
call ooDefRead m, 'res = treeCopyRead("'m'", "'rdr'", var);'
if key ^== 1 then do
m.treeCopy.m.read = 0
m.treeCopy.m.dest = ''
end
return m
endProcedure treeCopyOpen
treeRoot: procedure expose m.
parse arg ro, ky, va
if ro == '' then
ro = ooNew()
m.ro = va
m.ro.key = ky
m.ro.0 = 0
return ro
endProcedure treeRoot
treeAdd: procedure expose m.
parse arg pa, ky, va
if ky ^== '' & symbol('m.pa.index.ky') == 'VAR' then
call err 'add existing key' ky 'to node' pa
cx = m.pa.0 + 1
m.pa.0 = cx
m.pa.cx.0 = 0
m.pa.cx = va
m.pa.cx.key = ky
if ky ^== '' then
m.pa.index.ky = pa'.'cx
return pa'.'cx
endProcedure treeAdd
treePut: procedure expose m.
parse arg pa, ky, va
if symbol('m.pa.index.ky') == 'VAR' then do
ch = m.pa.index.ky
m.ch = va
end
else do
call treeAdd pa, ky, va
end
return
endProcedure treePut
treeGetCh: procedure expose m.
parse arg pa, ky
if symbol('m.pa.index.ky') ^== 'VAR' then
return ''
return m.pa.index.ky
endProcedure treeGetChild
treeGetVa: procedure expose m.
parse arg pa, ky
if symbol('m.pa.index.ky') ^== 'VAR' then
return ''
ch = m.pa.index.ky
return m.ch
endProcedure treeGetVa
treeGetChNo: procedure expose m.
parse arg pa, no
if symbol('m.pa.no') ^== 'VAR' then
return ''
return pa'.'ch
endProcedure treeGetChNo
treeRemoveCh: procedure expose m.
parse arg pa, rmPar
do cx=1 to m.pa.0
ky = m.pa.cx.key
drop m.pa.index.ky
call treeRemoveCh pa'.'cx, 1
end
m.pa.0 = 0
if rmPar = 1 then do
drop m.pa m.pa.key m.pa.0
end
return
endProcedure treeRemoveCh
treeShow: procedure expose m.
parse arg nd, lv
if lv = '' then
lv = 0
say left('', lv)nd m.nd.key'='strip(m.nd, 't')
if symbol('m.nd.0') == 'VAR' then do
do cx=1 to m.nd.0
call treeShow nd'.'cx, lv+1
end
end
return
endProcedure treeShow
/* copy tree end ****************************************************/
}¢--- A540769.WK.REXX.O08(TREE2) cre=2007-01-12 mod=2007-01-12-11.01.08 F540769 ---
treeRoot: procedure expose m.
parse arg ro, ky, va
if ro == '' then
ro = ooNew()
m.ro = va
m.ro.key = ky
m.ro.0 = 0
return ro
endProcedure treeRoot
treeAdd: procedure expose m.
parse arg pa, ky, va
cx = m.pa.0 + 1
m.pa.0 = cx
m.pa.cx.0 = 0
m.pa.cx = va
m.pa.cx.key = ky
return pa'.'cx
endProcedure treeAdd
mAddK1: procedure expose m.
parse arg pa, ky, va
if symbol('m.pa.index.ky') == 'VAR' then
call err 'add existing key' ky 'to node' pa
ch = treeAdd(pa, ky, va)
m.pa.index.ky = ch
return ch
endProcedure mAddK1
mPut: procedure expose m.
parse arg pa, ky, va
if symbol('m.pa.index.ky') == 'VAR' then do
ch = m.pa.index.ky
m.ch = va
end
else do
call mAddK1 pa, ky, va
end
return
endProcedure mPut
mAtK1: procedure expose m.
parse arg pa, ky
if symbol('m.pa.index.ky') ^== 'VAR' then
return ''
return m.pa.index.ky
endProcedure treeGetChild
mKy: procedure expose m.
parse arg nd
return m.nd.key
endProcedure mKy
mPar: procedure expose m.
parse arg nd
return left(nd, lastPos('.', nd) - 1)
endProcedure mPar
mVaAtK1: procedure expose m.
parse arg pa, ky
if symbol('m.pa.index.ky') ^== 'VAR' then
call err 'undefined key' ky 'for parent' pa
ch = m.pa.index.ky
return m.ch
endProcedure mVaAtK1
mFirst: procedure expose m.
parse arg ky, def
do ax=3 to arg()
pa = arg(ax)
if symbol('m.pa.index.ky') == 'VAR' then do
ch = m.pa.index.ky
return m.ch
end
end
return def
endProcedure mFirst
mAtSq: procedure expose m.
parse arg pa, no
if symbol('m.pa.no') ^== 'VAR' then
call err 'bad childNo' no 'for parent' pa
return pa'.'no
endProcedure mAtSq
mSize: procedure expose m.
parse arg nd
return m.nd.0
endProcedure mSize
mRemCh: procedure expose m.
parse arg pa, rmPar
do cx=1 to m.pa.0
ky = m.pa.cx.key
drop m.pa.index.ky
call mRemCh pa'.'cx, 1
end
m.pa.0 = 0
if rmPar = 1 then do
drop m.pa m.pa.key m.pa.0
end
return
endProcedure mRemCh
treeDeepCopy: procedure expose m.
parse arg dst, src, rm
if rm ^== 0 then
call mRemCh dst
do sx=1 to m.src.0
ky = m.src.sx.key
if symbol('m.src.index.ky') == 'VAR' then
ch = mAddK1(dst, ky, m.src.sx)
else
ch = treeAdd(dst, ky, m.src.sx)
call treeDeepCopy ch, src'.'sx, 0
end
return dst
endProcedure treeDeepCopy
mShow: procedure expose m.
parse arg nd, lv
if lv = '' then
lv = 0
say left('', lv)nd m.nd.key'='strip(m.nd, 't')
if symbol('m.nd.0') == 'VAR' then do
do cx=1 to m.nd.0
call mShow nd'.'cx, lv+1
end
end
return
endProcedure mShow
/* copy tree end ****************************************************/
}¢--- A540769.WK.REXX.O08(TSOTESC) cre=2008-08-18 mod=2008-08-18-11.01.41 F540769 ---
/* rexx ***************************************************************/
say 'start tsoTesC'
parse arg a
say ' arg' a
address Tso 'alloc dd(tst1) reuse sysout'
say 'adress tso rc' rc
address Tso 'free dd(tst1)'
say 'adress tso rc' rc
say 'calling tso' IKJEFT01 tsoTest a
call IKJEFT01 tsoTest a
say 'after call tso rc' rc
exit
/* 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(s005y000) 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(TSOTEST) cre=2008-08-18 mod=2008-08-18-10.44.08 F540769 ---
/* rexx ***************************************************************/
say 'start tsoTest'
parse arg a
say ' arg' a
call adrTso 'alloc dd(tst1) reuse sysout'
a.1 = 'tsoTest' date() time()
a.2 = 'arg' a
call writeDD tst1, a., 2
call writeDDend tst1
call adrTso 'free dd(tst1)'
exit
/* 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(s005y000) 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(TST) cre=2007-07-03 mod=2007-11-13-18.22.07 F540769 ---
call errReset h
if adrEdit('macro (mArgs) NOPROCESS', '*') == 0 then
exit editMacro(mArgs)
if 1 then
call tstAll
if 1 then
call tstComp
exit
call compIni
call tstCompComp
exit
call tstCompPrimary
call tstCompDataIO
call tstTotal
call tstAll
exit
call tstEnv
call tstAll
editMacro: procedure expose m.
parse upper arg mArgs
call adrIsp 'control errors return'
pc = adrEdit("process dest range Q", 0 4 8 12 16)
if pc = 4 | pc = 12 | pc = 16 then do
say 'bitte Bereich mit q oder qq auswaehlen'
return 4
end
call adrEdit "(rFi) = lineNum .zFrange"
call adrEdit "(rLa) = lineNum .zLrange"
if pc = 0 then
call adrEdit "(dst) = lineNum .zDest"
else
dst = rLa
/* say 'range' c1 'rc' pc':' rFi '-' rLa 'after' dst */
call compIni
call envIni
i = jBuf()
o = jBuf()
call jOpen i, 'w'
do lx=rFi to rLa
call adrEdit "(li) = line" lx
call jWrite i, li
end
cmp = comp(i)
if pos('D', mArgs) > 0 then
ty = 'd'
else
ty = 's'
call errReset 'h', 'call compErrHandler ggTxt, ggStem,' rFi',' rLa
r = compile(cmp, ty)
call errReset 'h', 'call runErrHandler ggTxt, ggStem,' ,
quote(o)',' dst
call envPush env('>£', o)
call oRun r
call envPop
lab = lineBefSt(dst+1, , o'.BUF')
return 0
endProcedure editMacro
compErrHandler: procedure expose m.
parse arg ggTxt, ggStem, rFi, rLa
call errReset 'h'
say 'compErr' ggTxt
say 'compErr' m.ggstem.0 m.ggstem.1
say 'compErr' m.ggstem.0 m.ggstem.2
parse var m.ggStem.2 "pos " pos " in line " lin":"
say "line" lin "pos" pos'.' 'rFi' rFi
lab = lineBef((rFi+lin), 'msgline', right('*', pos), ggTxt)
if ggStem ^== '' then
call lineBefSt lab, 'msgLine', ggStem
exit 0
endSubroutine compErrHandler
lineBefCmd: procedure
parse arg wh
if datatype(wh, 'n') then do
if adrEdit("label" wh "= .a", 0 8 12) ^= 12 then
return 'line_before .a ='
else
return 'line_after .zl ='
end
else if left(wh, 1) == '.' then
return 'line_before' wh '='
else
return wh
endProcedure lineBefCmd
lineBef: procedure
parse arg wh, type
cmd = lineBefCmd(wh)
do ax=3 to arg()
li = arg(ax)
call adrEdit cmd type "(li)", 0 4
end
return cmd
endProcedure lineBef
lineBefSt: procedure expose m.
parse arg wh, type, st
cmd = lineBefCmd(wh)
do ax=1 to m.st.0
li = m.st.ax
call adrEdit cmd type "(li)", 0 4
end
return cmd
endProcedure lineBefSt
runErrHandler: procedure expose m.
parse arg ggTxt, ggStem, so, dst
call errReset 'h'
say 'run error' ggTxt
lab = lineBefSt(dst+1, , so'.BUF')
say 'lab' lab
call lineBef lab, msgline, '*** error:' ggTxt
if ggStem ^== '' then
call lineBefSt lab, msgline, ggSt
exit 0
endSubroutine runErrHandler
/* tstComp +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
/*************
abc
efg
abc efg $@{ call err 'wie gehts' 'dir heute' $}
abc efg asdf
**************
abc
efg
abc efg
*************/
out eins
out zwei
out eins
out eins
out zwei
out zwei
out eins
out zwei
out eins
out zwei
tstComp: procedure expose m.
call compIni
call tstCompDataConst
call tstCompDataVars
call tstCompShell
call tstCompPrimary
call tstCompStmt
call tstCompDataIO
call tstCompPipe
call tstCompRedir
call tstCompComp
call tstTotal
return
endProcedure tstComp
tstCompRun: procedure expose m.
parse arg type cnt
src = jBuf()
call jOpen src, 'w'
do sx=2 to arg()
call jWrite src, arg(sx)
end
cmp = comp(src)
call jOut 'compile' type',' (sx-2) 'lines:' arg(2)
r = compile(cmp, type)
say "compiled: >>>>" r "<<<<" m.r.code
call jOut "run without input"
call mCut 'T.IN', 0
call oRun r
if cnt == 3 then do
call jOut "run with 3 inputs"
call mAdd 'T.IN', "eins zwei drei", "zehn elf zwoelf?",
, "zwanzig 21 22 23 24 ... 29|"
m.t.inIx = 0
call oRun r
end
return
endProcedure tstCompRun
tstCompDataConst: procedure expose m.
call tst t, 'tstCompDataConst',
, "compile d, 8 lines: Lline one, $** asdf",
, "run without input",
, " Lline one, ",
, "line two.",
, "line threecontinued on 4",
, "line five fortsetzung",
, "line six fortsetzung"
call tstCompRun 'd' ,
, ' Lline one, $** asdf',
, 'line two.',
, 'line three$*+ bla bla' ,
, 'continued on 4',
, 'line five $*( und so',
, 'weiter $abc $? $''$*)'' $"$*)" und weiter $*) fortsetzung',
, 'line six $*( und $*( $** $*( so',
, 'weiter $abc $? $*)'' $"$*)" und weiter $*) fortsetzung'
call tstEnd t
return
endProcedure tstCompDataComm
tstCompDataVars: procedure expose m.
call tst t, 'tstCompDataVars',
, "compile d, 4 lines: Lline one, $** asdf",
, "run without input",
, " Lline one, ",
, "lline zwei output",
, "lline 3 ",
, "variable v1 = valueV1 ${v1}= valueV1| "
call tstCompRun 'd' ,
, ' Lline one, $** asdf',
, ' $$ lline zwei output',
, 'lline 3 $=v1= valueV1 ' ,
, 'variable v1 = $v1 $"${v1}=" ${ v1 }| '
call tstEnd t
return
endProcedure tstCompDataVars
tstCompShell: procedure expose m.
call tst t, 'tstCompShell',
, "compile s, 9 lines: $$ Lline one, $** asdf",
, "run without input",
, "Lline one,",
, "lline zwei output",
, "v1 = valueV1 ${v1}= valueV1|",
, "REXX JOUT L5 CONTINUED L6 CONTINUED L7",
, "L8 ONE",
, "L9 END"
call tstCompRun 's' ,
, ' $$ Lline one, $** asdf',
, ' $$ lline zwei output',
, ' $=v1= valueV1 ' ,
, '$$ v1 = $v1 $"${v1}=" ${ v1 }| ' ,
, 'call jOut rexx jout l5, ' ,
, ' continued l6 , ' ,
, ' continued l7 ' ,
, 'call jOut l8 one ' ,
, 'call jOut l9 end'
call tstEnd t
return
endProcedure tstCompDataVars
tstCompPrimary: procedure expose m.
call tst t, 'tstCompPrimary',
, "compile d, 11 lines: Strings $""$""""$""""""""$"""""" $'$'",
|| "'$''''$'''",
, "run without input",
, "Strings $""$""""$"" $'$''$'",
, "rexx 3*5 = 15",
, "data line three line four bis hier",
, "shell line five line six bis hier",
, "var get v1 value Eins, v1 value Eins ",
, "var isDef v1 1, v2 0 ",
, "jIn eof 1",
, "var read >1 0 rr undefined",
, "jIn eof 2",
, "var read >2 0 rr undefined",
, "run with 3 inputs",
, "Strings $""$""""$"" $'$''$'",
, "rexx 3*5 = 15",
, "data line three line four bis hier",
, "shell line five line six bis hier",
, "var get v1 value Eins, v1 value Eins "
call mAdd t.cmp,
, "var isDef v1 1, v2 0 ",
, "<jIn 1< eins zwei drei",
, "var read >1 1 rr eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "var read >2 1 rr zehn elf zwoelf?"
call envRemove 'v2'
call tstCompRun 'd' 3 ,
, 'Strings $"$""$""""$"""' "$'$''$''''$'''",
, 'rexx 3*5 = $( 3 * 5 $)',
, 'data $-¢ line three',
, 'line four $! bis hier',
, 'shell $-{ $$ line five',
, '$$ line six $} bis hier',
, '$= v1 = value Eins $=rr=undefined',
, 'var get v1 $v1, v1 ${ v1 } ',
, 'var isDef v1 ${? v$( 1 * 1 + 0 $) }, v2 ${?v2 } ',
, 'var read >1 ${> rr} rr $rr' ,
, 'var read >2 ${> rr} rr $rr'
call tstEnd t
return
endProcedure tstCompPrimary
tstCompStmt: procedure expose m.
call tst t, 'tstCompStmt1',
, "compile s, 8 lines: $= v1 = value eins $= v2 £ 3*5*7 ",
, "run without input",
, "data v1 value eins v2 105",
, "eins",
, "zwei",
, "drei",
, "vier",
, "fuenf",
, "elf",
, "zwoelf dreiZ ",
, "vierZ ",
, "fuenfZ",
, "lang v1 value eins v2 945",
, "oRun ouput 1"
call envPut 'oRun', oRunner('call jOut "oRun ouput" (1*1)')
call envRemove 'v2'
call tstCompRun 's' ,
, '$= v1 = value eins $= v2 £ 3*5*7 ',
, '$$ data v1 $v1 v2 ${ v2 }',
, '$$eins $@{$$ zwei $$ drei ',
, ' $@{ $} $@{ $@{ $$vier $} $} $} $$fuenf',
, '$$elf $@¢ zwoelf dreiZ ',
, ' $@¢ $! $@¢ $@¢ vierZ $! $! $! $$fuenfZ',
, '$£ "lang v1" $v1 "v2" ${v2}*9',
, '$@run $oRun'
call tstEnd t
call tst t, 'tstCompStmt2',
, "compile s, 1 lines: $@for qq $$ loop qq $qq",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "loop qq eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "loop qq zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "loop qq zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4"
call tstCompRun 's' 3 ,
, '$@for qq $$ loop qq $qq'
call tstEnd t
return
endProcedure tstCompStmt
tstCompDataIO: procedure expose m.
call tst t, 'tstCompDataHereData',
, "compile d, 13 lines: herdata $<<stop ",
, "run without input",
, " herdata ",
, "heredata 1 $x",
, "heredata 2 $y",
, "nach heredata",
, " herdata ¢ ",
, "heredata 1 xValue",
, "heredata 2 yValueY",
, "nach heredata ¢",
, " herdata { ",
, "HEREDATA 1 xValue",
, "heredata 2 yValueY",
, "nach heredata {"
call tstCompRun 'd' ,
, ' herdata $<<stop ',
, 'heredata 1 $x',
, 'heredata 2 $y',
, 'stop $$ nach heredata',
, ' herdata ¢ $<<¢stop ',
, '$=x=xValue$=y=yValueY',
, 'heredata 1 $x',
, 'heredata 2 $y',
, 'stop $$ nach heredata ¢',
, ' herdata { $<<{st',
, 'call jOut heredata 1 $x',
, '$$heredata 2 $y',
, 'st $$ nach heredata {'
call tstEnd t
dsn = tstDsn('lib37', 'r')'(readInp)'
call mAdd mCut(abc, 0), 'readInp line 1', 'readInp line 2'
call writeDsn dsn '::f37', m.abc., ,1
call envPut 'dsn', dsn
call tst t, 'tstCompDataIO',
, "compile d, 4 lines: input 1 $<$dsn ::fb ",
, "run without input",
, " input 1 ",
, "readInp line 1 ",
, "readInp line 2 ",
, " nach dsn input und nochmals mit & ",
, "readInp line 1 ",
, "readInp line 2 ",
, " und schluiss."
call tstCompRun 'd' ,
, ' input 1 $<$dsn ::fb ',
, ' nach dsn input und nochmals mit & ' ,
, ' $<&dsn('dsn2jcl(dsn)') dd(xyz)',
, ' und schluiss.'
call tstEnd t
return
endProcedure tstCompDataIO
tstCompPipe: procedure expose m.
call tst t, 'tstCompPipe1',
, "compile s, 1 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "(1 eins zwei drei 1)",
, "<jIn 2< zehn elf zwoelf?",
, "(1 zehn elf zwoelf? 1)",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "(1 zwanzig 21 22 23 24 ... 29| 1)",
, "jIn eof 4"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"'
call tstEnd t
call tst t, 'tstCompPipe2',
, "compile s, 2 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "¢2 (1 eins zwei drei 1) 2!",
, "¢2 (1 zehn elf zwoelf? 1) 2!",
, "¢2 (1 zwanzig 21 22 23 24 ... 29| 1) 2!"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $¨ call envPreSuf "¢2 ", " 2!"'
call tstEnd t
call tst t, 'tstCompPipe3',
, "compile s, 3 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "<3 ¢2 (1 eins zwei drei 1) 2! 3>",
, "<3 ¢2 (1 zehn elf zwoelf? 1) 2! 3>",
, "<3 ¢2 (1 zwanzig 21 22 23 24 ... 29| 1) 2! 3>"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $¨ call envPreSuf "¢2 ", " 2!"',
, ' $¨ call envPreSuf "<3 ", " 3>"'
call tstEnd t
call tst t, 'tstCompPipe4',
, "compile s, 7 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "<3 ¢222 ¢221 ¢21 ¢20 (1 eins zwei drei 1) 20! 21! 221! 222",
|| "! 3>",
, "<3 ¢222 ¢221 ¢21 ¢20 (1 zehn elf zwoelf? 1) 20! 21! 221! 22",
|| "2! 3>",
, "<3 ¢222 ¢221 ¢21 ¢20 (1 zwanzig 21 22 23 24 ... 29| 1) 20!",
|| " 21! 221! 222! 3>"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $¨ $@{ call envPreSuf "¢20 ", " 20!"',
, ' $¨ call envPreSuf "¢21 ", " 21!"',
, ' $¨ $@{ call envPreSuf "¢221 ", " 221!"',
, ' $¨ call envPreSuf "¢222 ", " 222!"',
, '$} $} ',
, ' $¨ call envPreSuf "<3 ", " 3>"'
call tstEnd t
return
endProcedure tstCompPipe
tstCompRedir: procedure expose m.
call tst t, 'tstCompRedir',
, "compile s, 5 lines: $>#eins $@for vv $$<$vv> $; ",
, "run without input",
, "jIn eof 1",
, "output eins ",
, "output piped zwei ",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "output eins <eins zwei drei> <zehn elf zwoelf?> <zwanzig 2",
|| "1 22 23 24 ... 29|>",
, "output piped zwei ab<eins zwei drei>yz ab<zehn elf zwoelf?",
|| ">yz ab<zwanzig 21 22 23 24 ... 29|>yz"
dsn = tstDsn('libvb', 'r')'(redir1)'
call envPut 'dsn', dsn
call tstCompRun 's' 3 ,
, ' $>#eins $@for vv $$<$vv> $; ',
, ' $$ output eins $-{$<#eins$}$; ',
, ' $@for ww $$b${ww}y ',
, ' $> $dsn ::v $¨ call envPreSuf "a", "z" $<# eins',
, '$;$$ output piped zwei $-{$<$dsn$} '
call tstEnd t
return
endProcedure tstCompRedir
tstCompComp: procedure expose m.
call tst t, 'tstCompCompShell',
, "compile s, 5 lines: $$compiling shell $; $= rrr = $-cmpShe",
|| "ll $<<aaa",
, "run without input",
, "compiling shell",
, "running einmal",
, "RUN 1 COMPILED einmal",
, "jIn eof 1",
, "running zweimal",
, "RUN 1 COMPILED zweimal",
, "jIn eof 2",
, "run with 3 inputs",
, "compiling shell",
, "running einmal",
, "RUN 1 COMPILED einmal",
, "<jIn 1< eins zwei drei",
, "compRun eins zwei dreieinmal"
call mAdd t'.CMP',
, "<jIn 2< zehn elf zwoelf?",
, "compRun zehn elf zwoelf?einmal",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "compRun zwanzig 21 22 23 24 ... 29|einmal",
, "jIn eof 4",
, "running zweimal",
, "RUN 1 COMPILED zweimal",
, "jIn eof 5"
call tstCompRun 's' 3 ,
, "$$compiling shell $; $= rrr = $-cmpShell $<<aaa",
, "call jOut run 1*1*1 compiled $cc; $@for v $$ compRun $v$cc",
, "aaa $;",
, "$=cc=einmal $$ running $cc $@run $rrr",
, "$=cc=zweimal $$ running $cc $@run $rrr"
call tstEnd t
call tst t, 'tstCompCompData',
, "compile s, 5 lines: $$compiling data $; $= rrr = $-cmpData",
|| " $<<aaa",
, "run without input",
, "compiling data",
, "running einmal",
, "call jOut run 1*1*1 compiled einmal",
, "running zweimal",
, "call jOut run 1*1*1 compiled zweimal",
, "run with 3 inputs",
, "compiling data",
, "running einmal",
, "call jOut run 1*1*1 compiled einmal",
, "running zweimal",
, "call jOut run 1*1*1 compiled zweimal"
call tstCompRun 's' 3 ,
, "$$compiling data $; $= rrr = $-cmpData $<<aaa",
, "call jOut run 1*1*1 compiled $cc",
, "aaa $;",
, "$=cc=einmal $$ running $cc $@run $rrr",
, "$=cc=zweimal $$ running $cc $@run $rrr"
call tstEnd t
return
endProcedure tstCompComp
/* tstAAA ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
tstAll: procedure expose m.
call tstM
call tstMap
call tstMapVia
call tstScan
call tstO
call tstJsay
call tstJ
call tstCat
call tstEnv
call tstEnvCat
call tstEnvBar
call tstEnvVars
call tstCatDsn
call tstTotal
return
endProcedure tstAll
tstTstSay: procedure
call tst x, 'test eins', "test eins einzige testZeile"
call tstOut x, "test eins einzige testZeile"
call tstEnd x
call tst x, 'test zwei', "zwei 1. testZeile",
, "zwei 2. und letsdfazte testZeile"
call tstOut x, "zwei 1. testZeile"
call tstOut x, "zwei 2. und letzte testZeile"
call tstEnd x
call tst y, 'test drei',
, "drei 1. testZeile",
, "drei 2. tEstZeile",
, "drei 3. testZeile test line drei ganz lang 1 ",
|| " ...line drei ganz lang 2 ",
|| " ...line drei ganz lang 3 .",
|| "..line drei ganz lang 4 und schluss."
call tstOut y, 'drei 1. testZeile'
call tstOut y, 'drei 2. testZeile'
call tstOut y, 'drei 3. testZeile',
'test line drei ganz lang 1 ',
' ...line drei ganz lang 2 ',
' ...line drei ganz lang 3 ',
' ...line drei ganz lang 4 und schluss.'
call tstEnd y
call tstTotal
endProcedure tstTstSay
tstM: procedure
call tst t, 'tstM',
, "symbol m.b LIT",
, "mDefIfNot 1 0 m.b 1",
, "mInc b 2 m.b 2",
, "symbol m.a LIT",
, "mAdd a A.2",
, "mAdd a A.3",
, "m.a: 3: 1=eins 2=zwei 3=drei 4=M.A.4",
, "m.c: 5: 1=c vor AddSt a 2=eins 3=zwei",
, " 4=drei 5=c nach addSt a 6=M.C.6"
call tstOut t, 'symbol m.b' symbol('m.b')
call tstOut t, 'mDefIfNot' mDefIfNot(b, 1) mDefIfNot(b, 2) 'm.b' m.b
call tstOut t, 'mInc b' mInc(b) 'm.b' m.b
call tstOut t, 'symbol m.a' symbol('m.a')
call tstOut t, 'mAdd a' mAdd(mCut(a, 0), 'eins', 'zwei')
call tstOut t, 'mAdd a' mAdd(a, 'drei')
call tstOut t, 'm.a:' m.a.0': 1='m.a.1 '2='m.a.2 '3='m.a.3 '4='m.a.4
call mAdd mCut(c, 0), 'c vor AddSt a'
call mAddSt c, a
call mAdd c, 'c nach addSt a'
call tstOut t, 'm.c:' m.c.0': 1='m.c.1 '2='m.c.2 '3='m.c.3
call tstOut t, ' 4='m.c.4 '5='m.c.5 '6='m.c.6
call tstEnd t
return
endProcedure tstM
tstMap: procedure expose m.
m = mapNew('K')
ky = mapKeys(m)
say '***mapNew' m 'keys' ky
call tst t, 'tstMap',
, "map "m": zwei --> 2",
, "map "m": Zwei is not defined",
, "map stem "ky" 4",
, "map "m": eins --> 1",
, "map "m": zwei --> 2",
, "map "m": drei --> 3",
, "map "m": vier --> 4",
, "*** err: duplicate key in mAdd("m", eins, 1)",
, "map "m": zwei is not defined",
, "q 2 zwei drei",
, "map stem Q 2",
, "map Q: zwei --> 2Q",
, "map Q: drei --> 3Q",
, "map stem "m" 3",
, "map "m": eins --> 1",
, "map "m": zwei --> 2PUT",
, "map "m": vier --> 4PUT",
, "*** err: duplicate key in mAdd("m", zwei, 2ADDDUP)"
call mapAdd m, 'eins', 1
call mapAdd m, 'zwei', 2
call mapAdd m, 'drei', 3
call mapAdd m, 'vier', 4
call tstMapShow m, 'zwei'
call tstMapShow m, 'Zwei'
call tstMapShowSt m, mapKeys(m)
call mapAdd m, 'eins', 1
call mapReset m, '='
call tstMapShow m, 'zwei'
call mapAdd m, 'eins', 1
call mapAdd m, 'zwei', 2
call mapPut m, 'zwei', 2Put
call mapPut m, 'vier', 4Put
call mapReset q, '='
call mapAdd q, 'zwei', 2q
call mapAdd q, 'drei', 3q
call tstOut t, 'q' m.q.0 m.q.1 m.q.2
call tstMapShowSt q, mapKeys(q)
call tstMapShowSt m, mapKeys(m)
call mapAdd m, 'zwei', 2addDup
call tstEnd t
return
endProcedure tstMap
tstMapVia: procedure expose m.
call tst t, 'tstMap',
, "map M: K --> A",
, "mapVia(m, K) A",
, "*** err: missing m.A at 3 in mapVia(M, K*)",
, "mapVia(m, K*) M.A",
, "mapVia(m, K*) valAt m.a",
, "mapVia(m, K*) valAt m.a",
, "*** err: missing m.A.aB at 5 in mapVia(M, K*aB)",
, "mapVia(m, K*aB) M.A.aB",
, "mapVia(m, K*aB) valAt m.A.aB",
, "*** err: missing m.valAt m.a at 4 in mapVia(M, K**)",
, "mapVia(m, K**) M.valAt m.a",
, "mapVia(m, K**) valAt m.valAt m.a",
, "mapVia(m, K**F) valAt m.valAt m.a.F"
drop m.a.
call mapReset m
call mapAdd m, k, a
call tstMapShow m, k
call tstOut t, 'mapVia(m, K) ' mapVia(m, 'K')
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
m.a = 'valAt m.a'
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
call tstOut t, 'mapVia(m, K*aB) ' mapVia(m, 'K*aB')
u='A.aB'
m.u = 'valAt m.'u
call tstOut t, 'mapVia(m, K*aB) ' mapVia(m, 'K*aB')
call tstOut t, 'mapVia(m, K**) ' mapVia(m, 'K**')
u= m.a
m.u = 'valAt m.'u
m.u.f = 'valAt m.'u'.F'
call tstOut t, 'mapVia(m, K**) ' mapVia(m, 'K**')
call tstOut t, 'mapVia(m, K**F) ' mapVia(m, 'K**F')
call tstEnd t
return
endProcedure tstMapVia
tstMapShow: procedure expose m.
parse arg a, key
if mapHasKey(a, key) then
call tstOut t, 'map' a':' key '-->' mapGet(a, key)
else
call tstOut t, 'map' a':' key 'is not defined'
return
endProcedure tstMapShow
tstMapShowSt: procedure expose m.
parse arg a, st
call tstOut t, 'map stem' st m.st.0
do wx=1 to m.st.0
call tstMapShow a, m.st.wx
end
return
endProcedure tstMapShow
tstJsay: procedure expose m.
call jIni
call jOut 'out eins'
call jOut 'out zwei jIn' jIn(vv) 'vv='vv
vv = 'value'
call jOut 'out drei jIn' jIn(vv) 'vv='vv 'Schluss'
return
endProcedure tstJsay
tstJ: procedure expose m.
call jIni
oldJin = m.j.jIn
oldJOut = m.j.jOut
m.j.jIn = t
m.j.jOut = t
b = jOpen(jBuf(), 'w')
call tst t, "tstJ",
, "out eins",
, "<jIn 1< tst in line 1 eins ,",
, "1 jIn() tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "2 jIn() tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "3 jIn() tst in line 3 drei |",
, "jIn eof 4",
, "jIn() 3 reads vv VV",
, "line buf line one",
, "line buf line two",
, "line buf line three",
, "line buf line four",
, "*** err: jWrite(" || b", buf line four) but not ope",
|| "ned w"
call jOut 'out eins'
do lx=1 by 1 while jIn(var)
call jOut lx 'jIn()' m.var
end
call jOut 'jIn()' (lx-1) 'reads vv' vv
call jWrite b, 'buf line one'
call mAdd m.b.stem, 'buf line two', 'buf line three'
call jWrite b, 'buf line four'
call jOpen b, 'r'
do while (jRead(b, line))
call jOut 'line' m.line
end
call jWrite b, 'buf line four'
call jClose b
call tstEnd t
return
endProcedure tstJ
tstCat: procedure expose m.
call catIni
call tst t, "tstCat",
, "catRead 1 line 1",
, "catRead 2 line 2",
, "catRead 3 line 3",
, "appRead 1 line 1",
, "appRead 2 line 2",
, "appRead 3 append 4",
, "appRead 4 append 5",
, "appRead 5 line 3"
i = cat('£', jBuf('line 1', 'line 2'), '£', jBuf('line 3'))
call jOpen i, 'r'
do lx=1 by 1 while jRead(i, v)
call tstOut t, 'catRead' lx m.v
end
call jOpen i, 'a'
call jWrite i, 'append 4'
call jWrite i, 'append 5'
call jOpen i, 'r'
do lx=1 by 1 while jRead(i, v)
call tstOut t, 'appRead' lx m.v
end
call tstEnd t
return
endProcedure tstCat
tstCatDsn: procedure expose m.
call catIni
call tst t, "tstCatDsn",
, "write read 0 last 10 vor anfang",
, "write read 1 last 80 links1 1 und rechts | .",
, "write read 2 last 80 liinks2 2 und rechts | .",
, "write read 5 last 80 links5 5 rechts5",
, "write read 99 last 80 links99 99 rechts",
, "write read 100 last 80 links100 100 rechts",
, "write read 101 last 80 links101 101 rechts",
, "write read 999 last 80 links999 999 rechts",
, "write read 1000 last 80 links1000 1000 rechts",
, "write read 1001 last 80 links1001 1001 rechts",
, "write read 2109 last 80 links2109 2109 rechts",
, "out > eins 1 ",
|| " ",
, "out > eins 2 schluss. ",
|| " ",
, "buf eins",
, "buf zwei",
, "buf drei",
, "out > zwei mit einer einzigen Zeile ",
|| " ",
, " links1 1 und rechts | . ",
|| " "
pds = tstDsn('lib', 'r')
call tstCatDsnWr pds, 0, ' links0', ' und rechts | . '
call tstCatDsnWr pds, 1, ' links1', ' und rechts | . '
call tstCatDsnWr pds, 2, 'liinks2', ' und rechts | . '
call tstCatDsnWr pds, 5, 'links5', 'rechts5'
call tstCatDsnWr pds, 99, 'links99', 'rechts'
call tstCatDsnWr pds, 100, 'links100', 'rechts'
call tstCatDsnWr pds, 101, 'links101', 'rechts'
call tstCatDsnWr pds, 999, 'links999', 'rechts'
call tstCatDsnWr pds, 1000, 'links1000', 'rechts'
call tstCatDsnWr pds, 1001, 'links1001', 'rechts'
call tstCatDsnWr pds, 2109, 'links2109', 'rechts'
pd2 = tstDsn('li2', 'r')
call envPush env('>', pd2'(eins) ::F')
call jOut 'out > eins 1'
call jOut 'out > eins 2 schluss.'
call envPop
call envPush env('>', pd2'(zwei) ::F')
call jOut 'out > zwei mit einer einzigen Zeile'
call envPop
b = jBuf("buf eins", "buf zwei", "buf drei")
call envPush env('<+', pd2'(eins) ::F', '+£', b,
,'+£', jBuf(), '+', pd2'(zwei)',
,'+', pds'(WR0)','', pds'(wr1)')
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstCatDsn
tstCatDsnWR: procedure expose m.
parse arg dsn, num, le, ri
io = catDsn(dsn'(wr'num') ::F')
call jOpen io, 'w'
do x = 1 to num
call jWrite io, le x ri
end
if num > 100 then
call catDsnReset io, dsn'(wr'num') ::F'
call jOpen io, 'r'
m.vv = 'vor anfang'
do x = 1 to num
if ^ jRead(io, vv) then
call err x 'not jRead'
else if m.vv <> le x ri then
call err x 'read mismatch' m.vv
end
if jRead(io, vv) then
call err x 'jRead'
if jRead(io, vv) then
call err x'+1 jRead'
call jClose io
call tstOut t, 'write read' num 'last' length(m.vv) strip(m.vv,'t')
return
endProcedure tstCatDsnRW
tstEnv: procedure expose m.
call envIni
c = jBuf()
call tst t, "tstEnv",
, "before envPush",
, "after envPop",
, "*** err: jWrite("c", write nach pop) but not op",
|| "ened w",
, "<jIn 1< tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "jIn eof 4",
, "before readWrite 2 c --> std",
, "before readWrite 1 b --> c",
, "b line eins",
, "b zwei |",
, "nach readWrite 1 b --> c",
, "add nach pop",
, "after push c only",
, "tst in line 1 eins ,",
, "tst in line 2 zwei ; "
call mAdd t'.CMP',
, "tst in line 3 drei |",
, "nach readWrite 2 c --> std",
, "*** err: jWrite("c", ) but not opened w"
call jOut 'before envPush'
b = jBuf("b line eins", "b zwei |")
call envPush env('<£', b, '>£', c)
call jOut 'before readWrite 1 b --> c'
call envReadWrite
call jOut 'nach readWrite 1 b --> c'
call envPop
call jOut 'after envPop'
call jWrite c, 'write nach pop'
call mAdd c'.BUF', 'add nach pop'
call envPush env('>>£', c)
call jOut 'after push c only'
call envReadWrite
call envPop
call envPush env('<£', c)
call jOut 'before readWrite 2 c --> std'
call envReadWrite
call jOut 'nach readWrite 2 c --> std'
call envPop
call jWrite c
call tstEnd t
return
endProcedure tstEnv
tstEnvCat: procedure expose m.
call tst t, "tstEnvCat",
, "c1 contents",
, "c1 line eins |",
, "before readWrite 1 b* --> c*",
, "b1 line eins|",
, "b2 line eins",
, "b2 zwei |",
, "after readWrite 1 b* --> c*",
, "c2 contents",
, "c2 line eins |"
b0= jBuf()
b0= jBuf()
b1= jBuf("b1 line eins|")
b2 = jBuf("b2 line eins", "b2 zwei |")
c1 = jBuf("c1 line eins |")
c2 = jBuf("c2 line eins |")
call envPush env('<+£', b0, '<+£', b1, '<£', b2,
,'>>+£', c1, '<£', c2)
call jOut 'before readWrite 1 b* --> c*'
call envReadWrite
call jOut 'after readWrite 1 b* --> c*'
call envPop
call envPush env('<£', c1)
call jOut 'c1 contents'
call envReadWrite
call envPop
call envPush env('<£', c2)
call jOut 'c2 contents'
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstEnv
tstEnvBar: procedure expose m.
call tst t, 'tstEnvBar',
, "+0 vor envBarBegin",
, "<jIn 1< tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "jIn eof 4",
, "+7 nach envBarLast",
, "¢7 +6 nach envBar 7!",
, "¢7 +2 nach envBar 7!",
, "¢7 +4 nach nested envBarLast 7!",
, "¢7 (4 +3 nach nested envBarBegin 4) 7!",
, "¢7 (4 (3 +1 nach envBarBegin 3) 4) 7!",
, "¢7 (4 (3 tst in line 1 eins , 3) 4) 7!",
, "¢7 (4 (3 tst in line 2 zwei ; 3) 4) 7!",
, "¢7 (4 (3 tst in line 3 drei | 3) 4) 7!",
, "¢7 (4 (3 +1 nach readWrite vor envBar 3) 4) 7!",
, "¢7 (4 +3 nach preSuf vor nested envBarLast 4) 7!",
, "¢7 +4 nach preSuf vor nested envBarEnd 7!"
call mAdd t.cmp,
, "¢7 +5 nach nested envBarEnd vor envBar 7!",
, "¢7 +6 nach readWrite vor envBarLast 7!",
, "+7 nach readWrite vor envBarEnd",
, "+8 nach envBarEnd"
call jOut '+0 vor envBarBegin'
call envBarBegin
call jOut '+1 nach envBarBegin'
call envReadWrite
call jOut '+1 nach readWrite vor envBar'
call envBar
call jOut '+2 nach envBar'
call envBarBegin
call jOut '+3 nach nested envBarBegin'
call envPreSuf '(3 ', ' 3)'
call jOut '+3 nach preSuf vor nested envBarLast'
call envBarLast
call jOut '+4 nach nested envBarLast'
call envPreSuf '(4 ', ' 4)'
call jOut '+4 nach preSuf vor nested envBarEnd'
call envBarEnd
call jOut '+5 nach nested envBarEnd vor envBar'
call envBar
call jOut '+6 nach envBar'
call envReadWrite
call jOut '+6 nach readWrite vor envBarLast'
call envBarLast
call jOut '+7 nach envBarLast'
call envPreSuf '¢7 ', ' 7!'
call jOut '+7 nach readWrite vor envBarEnd'
call envBarEnd
call jOut '+8 nach envBarEnd'
call tstEnd t
return
endProcedure tstEnvBar
tstEnvVars: procedure expose m.
call tst t, "tstEnvVars",
, "put v1 value eins",
, "v1 hasKey 1 get value eins",
, "v2 hasKey 0",
, "via v1.fld via value",
, "one to theBur",
, "two to theBuf"
put1 = envPut('v1', 'value eins')
call tstOut t, 'put v1' put1
call tstOut t, 'v1 hasKey' envHasKey('v1') 'get' envGet('v1')
call tstOut t, 'v2 hasKey' envHasKey('v2')
if 0 then
call tstOut t, 'v2 get' envGet('v2')
m.put1.fld = 'via value'
call tstOut t, 'via v1.fld' envVia('v1*FLD')
call envPush env('>#', 'theBuf')
call jOut 'one to theBur'
call jOut 'two to theBuf'
call envPop
call envPush env('<#', 'theBuf')
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstEnvVars
tstScan: procedure expose m.
call tst t, 'tstScan.1',
, "scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' ",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "scan n tok 3: Und key val ",
, "scan v tok 1: key val ",
, "scan n tok 10: hr123sdfER key val ",
, "scan q tok 5: ""st1"" key val st1",
, "scan v tok 1: key val st1",
, "scan a tok 19: 'str2''mit''apo''s' key val str2'mit'apo's",
, "scan v tok 1: key val str2'mit'apo's"
call tstScan1 'l"litEins"l"litZwei"ndv" "aq1' ,
,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call tstEnd t
call tst t, 'tstScan.2',
, "scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' ",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "scan n tok 3: Und key val ",
, "scan b tok 0: key val ",
, "scan n tok 10: hr123sdfER key val ",
, "scan s tok 5: ""st1"" key val st1",
, "scan b tok 0: key val st1",
, "scan s tok 19: 'str2''mit''apo''s' key val str2'mit'apo's",
, "scan b tok 0: key val str2'mit'apo's"
call tstScan1 'ndsb1' ,
,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call tstEnd t
call tst t, 'tstScan.3',
, "scan src a034,'wie 789abc",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "*** err: scanErr ending Apostroph(') missing",
, " e 1: last token scanPosition 'wie 789abc",
, " e 2: pos 6 in string a034,'wie 789abc",
, "scan 1 tok 1: ' key val ",
, "scan n tok 3: wie key val ",
, "scan 1 tok 1: key val ",
, "*** err: scanErr illegal number end",
, " e 1: last token 789 scanPosition abc",
, " e 2: pos 14 in string a034,'wie 789abc",
, "scan d tok 3: 789 key val ",
, "scan n tok 3: abc key val "
call tstScan1 'nds1' ,
,"a034,'wie 789abc"
call tstEnd t
call tst t, 'jTestScan.4',
, "scan src litEinsefr 23 sdfER'str1'litZwei ""str2""""mit qu",
|| "o""s ",
, "scan l tok 7: litEins key val ",
, "scan n tok 3: efr key val ",
, "scan b tok 0: key val ",
, "scan d tok 2: 23 key val ",
, "scan b tok 0: key val ",
, "scan n tok 5: sdfER key val ",
, "scan a tok 6: 'str1' key val str1",
, "scan l tok 7: litZwei key val str1",
, "scan b tok 0: key val str1",
, "scan q tok 15: ""str2""""mit quo"" key val str2""mit quo",
, "scan n tok 1: s key val str2""mit quo",
, "scan b tok 0: key val str2""mit quo"
call tstScan1 'l"litEins"l"litZwei"ndbaq1' ,
,"litEinsefr 23 sdfER'str1'litZwei ""str2""""mit quo""s "
call tstEnd t
call tst t, 'jTestScan.5',
, "scan src aha;+-=f ab=cdEf eF='strIng' ",
, "scan b tok 0: key val ",
, "scan k tok 4: no= key aha val def",
, "scan 1 tok 1: ; key aha val def",
, "scan 1 tok 1: + key aha val def",
, "scan 1 tok 1: - key aha val def",
, "scan 1 tok 1: = key aha val def",
, "scan k tok 4: no= key f val def",
, "scan k tok 4: cdEf key ab val cdEf",
, "scan b tok 4: cdEf key ab val cdEf",
, "scan k tok 8: 'strIng' key eF val strIng",
, "scan b tok 8: 'strIng' key eF val strIng"
call tstScan1 'bk1'," aha;+-=f ab=cdEf eF='strIng' "
call tstEnd t
return
endProcedure tstScan
tstScanRead: procedure expose m.
call jTest t, 'jTestScanReader',
, "jOut: name erste",
, "jOut: space",
, "jOut: name Zeile",
, "jOut: space",
, "jOut: nextLine",
, "jOut: nextLine",
, "jOut: space",
, "jOut: name dritte",
, "jOut: space",
, "jOut: name Zeile",
, "jOut: space",
, "jOut: name schluss",
, "jOut: space"
b = jBuf('erste Zeile ',,' dritte Zeile schluss ')
call jOpen b, 'r'
call scanReader s, b
do while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.m.tok
else if scanVerify(s, ' ') then call tstOut t, 'space'
else if scanReadNL(s) then call tstOut t, 'nextLine'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
end
call jTestEnd t
call jTest t, 'jTestScanReader mit spaceLn',
, "tstOut t,: name erste",
, "jOut: spaceLn",
, "jOut: name Zeile",
, "jOut: spaceLn",
, "jOut: name dritte",
, "jOut: spaceLn",
, "jOut: name Zeile",
, "jOut: spaceLn",
, "jOut: name schluss",
, "jOut: spaceLn"
call jOpen b, 'r'
call scanReader s, b
do forever
if scanName(s) then call jOut 'name' m.m.tok
else if scanSpaceNL(s) then call jOut 'spaceLn'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
else leave
end
call jTestEnd t
return
endProcedure jTestScan
/*--- one single test scan with lines to scan in stem ln -------------*/
tstScan1:
parse arg types, ln
call tstOut t, 'scan src' ln
call scanSrc scanReset(s), ln
do forever
x = scanType(s, types)
if x == '' then
leave
call tstOut t, 'scan' x 'tok' length(m.s.tok)':' m.s.tok ,
'key' m.s.key 'val' m.s.val
end
return
endProcedure tstScan1
tstO: procedure expose m.
call tst t, 'tstO',
, "class R with 2 methods",
, " print call tstOut T, 'Rprint' m a1",
, " say call tstOut T, 'Rsay ' m a2; return",
, "class S with 3 methods",
, " print call tstOut T, 'Sprint' m a1; return",
, " say call tstOut T, 'Rsay ' m a2; return",
, " quak call tstOut T, 'Squak ' m a3; return 'quak'a3",
, "O.CLAOBJ.R.1 class R",
, "O.CLAOBJ.S.1 class S",
, "oR.print call tstOut T, 'Rprint' m a1",
, "oS.print call tstOut T, 'Sprint' m a1; return",
, "oS.say call tstOut T, 'Rsay ' m a2; return",
, "Rsay O.CLAOBJ.R.1 arg oR say",
, "Rprint O.CLAOBJ.R.1 arg oR print",
, "Rsay O.CLAOBJ.S.1 arg oS say"
call mAdd t.cmp ,
, "Sprint O.CLAOBJ.S.1 arg oS print",
, "Squak O.CLAOBJ.S.1 arg oS quak",
, "quak: quakarg oS quak",
, "Rprint O.CLAOBJ.S.1 cast(os, R)",
, "Sprint O.CLAOBJ.S.1 cast(os, R), S)",
, "mutate oS R O.CLAOBJ.S.1",
, "Rprint O.CLAOBJ.S.1 mutate R",
, "oRun 7*3 21",
, "oRun 12*12 144"
oo = 'call tstOut' t','
cR = oNewClass('R')
call oClaAddMethods cR, "print", oo "'Rprint' m a1",
, "say", oo "'Rsay ' m a2; return"
cS = oNewClass('S', "R")
call oClaAddMethods cS, "print", oo "'Sprint' m a1; return",
, "quak", oo "'Squak ' m a3; return 'quak'a3"
cc = 'R S'
do cx=1 to words(cc)
cla = word(cc, cx)
call tstOut t, 'class' cla 'with' m.o.claMet.cla.0 'methods'
do mx=1 to m.o.claMet.cla.0
met = m.o.claMet.cla.mx
call tstOut t, ' ' met mapGet('O.CLAMET.'cla, met)
end
end
oR = oNew(cR)
oS = oNew(cS)
call tstOut t, oR 'class' oGetClass(oR)
call tstOut t, oS 'class' oGetClass(oS)
call tstOut t, 'oR.print' oObjMethod(oR, 'print')
call tstOut t, 'oS.print' oObjMethod(oS, 'print')
call tstOut t, 'oS.say' oObjMethod(oS, 'say')
call tstClassRsay oR, 'arg oR say'
call tstClassRprint oR, 'arg oR print'
call tstClassRsay oS, 'arg oS say'
call tstClassRprint oS, 'arg oS print'
call tstOut t, 'quak:' tstClassSquak(oS, 'arg oS quak')
q1 = oCast(oS, 'R')
call tstClassRprint q1, 'cast(os, R)'
q2 = oCast(q1, 'S')
call tstClassRprint q2, 'cast(os, R), S)'
call tstOut t, 'mutate oS R' oMutate(oS, 'R')
call tstClassRprint oS, 'mutate R'
rr = oRunner('return 7 * 3')
call tstOut t, 'oRun 7*3' oRun(rr)
call oRunnerReset rr, 'return 12 * 12'
call tstOut t, 'oRun 12*12' oRun(rr)
call tstEnd t
return
endProcedure tstClass
tstClassRprint: procedure expose m.
parse arg m, a1
interpret oObjMethod(m, 'print')
return
endProcedure tstClassRprint
tstClassRsay: procedure expose m.
parse arg m, a2
interpret oObjMethod(m, 'say')
endProcedure tstClassRsay
tstClassSquak: procedure expose m.
parse arg m, a3
interpret oObjMethod(m, 'quak')
endProcedure tstClassSquak
/* copy comp begin *****************************************************
the shell compiler
syntax and semantics of the shell language see javaDoc
***********************************************************************/
/*--- module initialisation ------------------------------------------*/
compIni: procedure expose m.
if m.compIni = 1 then
return
m.compIni = 1
call scanReadIni
cc = oNewClass('Compiler')
return
endProcedure compIni
/*--- constructor of Compiler ----------------------------------------*/
comp: procedure expose m.
parse arg src
nn = oNew('Compiler')
m.nn.scan = scanRead(src)
return compReset(nn, src)
endProcedure comp
compReset: procedure expose m.
parse arg m, src
call scanReadReset m.m.scan, src, , ,'$*'
m.m.chDol = '$'
m.m.chSpa = ' '
m.m.chNotWord = '${}=£:' || m.m.chSpa
m.m.stack = 0
return m
endProceduere compReset
/*--- push an empty stem on the stack --------------------------------*/
compPushStem: procedure expose m.
parse arg m
m.m.stack = m.m.stack + 1
pp = m'.STACK'm.m.stack
m.pp.0 = 0
return pp
endProcedure compPushStem
/*--- push a stem from the stack -------------------------------------*/
compPop: procedure expose m.
parse arg m, pp
if pp ^== m'.STACK'm.m.stack then
call err 'compPop pp' pp 'mismatch to' m'.STACK'm.m.stack
m.m.stack = m.m.stack - 1
return m
endProcedure compPop
/*--- compile the source and return an oRunner with the code ---------*/
compile: procedure expose m.
parse arg m, type
if type == 's' then do
what = "shell"
expec = "pipe or $;";
call compSpNlComment m
src = compShell(m)
end
else if type == 'd' then do
what = "data";
expec = "sExpression or block";
src = compData(m, 0)
end
else do
call err "bad type " type
end
if ^ scanAtEnd(m.m.scan) then
call scanErr m.m.scan, expec "expected: compile" what ,
" stopped before end of input"
r = oRunner(src)
return r
endProcedure compile
/*--- compile data lines return stmts or expr ------------------------*/
compData: procedure expose m.
parse arg m, makeExpr
s = m.m.scan
exprs = compPushStem(m)
do forever
aftEol = 0
do forever
text = "";
do forever
if scanVerify(s, m.m.chDol, 'm') then
text = text || m.s.tok
if ^ compComment(m) then
leave
end
nd = compExpr(m, 'd')
befEol = scanReadNL(s)
if nd <> '' | (aftEol & befEol) ,
| verify(text, m.m.chSpa) > 0 then do
if text ^== '' then
text = quote(text)
if text ^== '' & nd ^= '' then
text = text '|| '
call mAdd exprs, 'e' compNull2EE(text || nd)
end
if ^ befEol then
leave
aftEol = 1
end
one = compStmt(m)
if one == '' then
one = compRedirIO(m, 0)
if one == '' then
leave
call mAdd exprs, 's' one
end
if m.exprs.0 < 1 then do
if makeExpr then
res = '""'
else
res = ';'
end
else do
do x=1 to m.exprs.0 while left(m.exprs.x, 1) = 'e'
end
res = ''
if makeExpr & x > m.exprs.0 then do
res = substr(m.exprs.1, 3)
do x=2 to m.exprs.0
res = res substr(m.exprs.x, 3)
end
end
else do
do x=1 to m.exprs.0
if left(m.exprs.x, 1) = 'e' then
res = res 'call jOut'
res = res substr(m.exprs.x, 3)';'
end
if makeExpr then
res = "mCat("compStmts2ExprBuf(res)"'.BUF', ' ')"
end
end
call compPop m, exprs
return res
endProcedure compData
/*--- compile shell and return code ----------------------------------*/
compShell: procedure expose m.
parse arg m
res = ''
do forever
one = compPipe(m)
if one ^== '' then
res = res one
if ^ scanLit(m.m.scan, '$;') then
return strip(res)
call compSpNlComment m
end
endProcedure compShell
/*--- compile an expression, type d=data, w=word, s=strip ------------*/
compExpr: procedure expose m.
parse arg m, type
res = ''
if type == 'w' then
charsNot = m.m.chNotWord
else
charsNot = m.m.chDol
s = m.m.scan
if pos(type, 'sw') > 0 then
call compSpComment m
do forever
txt = ''
do forever
if scanVerify(s, charsNot, 'm') then
txt = txt || m.s.tok
if ^ compComment(m) then
leave
end
pr = compPrimary(m)
if pr = '' & pos(type, 'sw') > 0 then
txt = strip(txt, 't')
if txt ^== '' then
res = res '||' quote(txt)
if pr = '' then do
if pos(type, 'sw') > 0 then
call compSpComment m
if res == '' then
return ''
return substr(res, 5)
end
res = res '||' pr
end
return ''
endProcedure compExpr
/*--- push an empty stem on the stack --------------------------------*/
compPushStem: procedure expose m.
parse arg m
m.m.stack = m.m.stack + 1
pp = m'.STACK'm.m.stack
m.pp.0 = 0
return pp
endProcedure compPushStem
/*--- push a stem from the stack -------------------------------------*/
compPop: procedure expose m.
parse arg m, pp
if pp ^== m'.STACK'm.m.stack then
call err 'compPop pp' pp 'mismatch to' m'.STACK'm.m.stack
m.m.stack = m.m.stack - 1
return m
endProcedure compPop
/*--- compile a primary and return code ------------------------------*/
compPrimary: procedure expose m.
parse arg m
s = m.m.scan
if ^ scanLit(s, '$') then
return ''
if scanString(s) then
return m.s.tok
if scanLit(s, '(') then do
one = compCheckNN(m, compLang(m, 0), 'rexx expexted after $(')
if ^ scanLit(s, '$)') then
call scanErr s, 'closing $) missing after $(...'
return '('one')'
end
if scanLit(s, '-¢') then do
res = compData(m, 1)
if ^scanLit(s, '$!') then
call scanErr s, 'closing $! missing after $-¢ data'
return res
end
if scanLit(s, '-{') then do
res = compShell(m)
if ^scanLit(s, '$}') then
call scanErr s, 'closing $} missing after $-{ shell'
return "mCat("compStmts2ExprBuf(res)"'.BUF', ' ')"
end
if scanLit(s, '-cmpShell', '-cmpData') then do
return 'compile(comp(envRead2Buf()),' ,
'"'substr('ds', 1+(m.s.tok == '-cmpShell'), 1)'")'
end
if scanLit(s, '{') then do
if scanLit(s, '?') then
f = 'envIsDefined'
else if scanLit(s, '>') then
f = 'envRead'
else
f = 'envGet'
nm = compExpr(m, 'w')
if ^scanLit(s, '}') then
call scanErr s, 'closing } missing after ${'
return f'('nm')'
end
if scanName(s) then
return 'envGet('quote(m.s.tok)')'
call scanBack s, '$'
return ''
endProcedure compPrimary
/*--- compile a pipe and return code ---------------------------------*/
compPipe: procedure expose m.
parse arg m
s = m.m.scan
ios = ''
stmts = ''
stmtLast = ''
do forever
io1 = compRedirIO(m, 1)
if io1 ^== '' then do
ios = ios',' io1
call compSpNlComment m
end
else do
if stmtLast ^== '' then do
if ^ scanLit(s, '$¨') then
leave
call compSpNlComment m
end
one = compStmts(m)
if one == '' then do
if stmtLast ^== '' then
call scanErr s, 'stmts expected afte $¨'
if ios == '' then
return ''
leave
end
if stmtLast ^== '' then
stmts = stmts 'call envBar;' stmtLast
stmtLast = one
end
end
if stmts ^== '' then
stmtLast = insert('Begin', stmts, pos('envBar;', stmts)+5) ,
'call envBarLast;' stmtLast 'call envBarEnd;'
if ios ^== '' then do
if stmtLast == '' then
stmtLast = 'call envReadWrite;'
stmtLast = 'call envPush env('substr(ios, 3)');' stmtLast ,
'call envPop;'
end
return stmtLast
endProcedure compPipe
/*--- compile an io redirection, return
if makeExpr then "option", expr
else code write inut to standard out -------------*/
compRedirIO: procedure expose m.
parse arg m, makeExpr
s = m.m.scan
if ^ scanLit(s, '$&', '$<<', '$<', '$>>', '$>') then
return ''
opt = substr(m.s.tok, 2)
call scanVerify s, '+-£#¢{'
opt = opt || m.s.tok
/* ???? call compSpComment m */
if left(opt, 2) ^== '<<' then do
if verify(opt, '¢{', 'm') > 0 ,
| (left(opt, 1) == '&' & pos('£', opt) > 0) then
call scanErr s, 'inconsistent io redirection option' opt
ex = compCheckNN(m, compExpr(m, 's'),
, 'expression expected after $'opt)
end
else do
if verify(opt, '-£#', 'm') > 0 then
call scanErr s, 'inconsistent io redirection option' opt
if ^ scanName(s) then
call scanErr s, 'stopper expected in heredata after $'opt
stopper = m.s.tok
call scanVerify s, m.m.chSpa
if ^ scanReadNl(s) then
call scanErr s,
, 'space nl expected in heredata after $'opt||stopper
buf = jOpen(jBuf(), 'w')
do while ^ scanLit(s, stopper)
call jWrite buf, m.s.src
if ^ scanReadNl(s, 1) then
call scanErr s, 'eof in heredata after $'opt||stopper
end
call jClose buf
ex = quote(buf)
if verify(opt, '¢{', 'm') > 0 then do
if pos('¢', opt) > 0 then
ex = "compile(comp("ex"), 'd')"
else
ex = "compile(comp("ex"), 's')"
if makeExpr then
return "'<£', envRun("ex")"
else
return "call oRun" ex";"
end
opt = '<£'
end
if makeExpr then
return "'"opt"'," ex
else if left(opt, 1) = '>' then
call scanErr s, 'cannot write ioRedir $'opt
else
return "call envReadWrite '"opt"'," ex
endProcedure compRedirIO
/*--- compile stmts (stmt or java) -----------------------------------*/
compStmts: procedure expose m.
parse arg m
res = ''
do forever
one = compStmt(m)
if one == '' then
one = compLang(m, 1)
if one == '' then
return res
res = res strip(one)
call compSpNlComment m
end
endProcedure compStmts
/*--- compile a single statement -------------------------------------*/
compStmt: procedure expose m.
parse arg m
s = m.m.scan
if scanLit(s, "$=") then do
nm = compCheckNN(m, compExpr(m, 'w'), "variable name")
if scanLit(s, "=") then
vl = compExpr(m, 's')
else if scanLit(s, "£") then
vl = compCheckNN(m, compLang(m, 0),
, 'java expression after $= .. £')
else
call scanErr s, '= or £ expected after $= name'
return 'call envPut' nm',' vl';'
end
else if scanLit(s, '$@{') then do
call compSpNlComment m
one = compShell(m)
if ^ scanLit(s, "$}") then
call scanErr s, "closing $} missing for $@{ shell"
return "do;" one "end;"
end
else if scanLit(s, '$@¢') then do
call compSpNlComment m
one = compData(m, 0)
if ^ scanLit(s, "$!") then
call scanErr s, "closing $! missing for $@! data"
return "do;" one "end;"
end
else if scanLit(s, '$$') then do
return 'call jOut' compExpr(m, 's')';'
end
else if scanLit(s, '$£') then do
return 'call jOut' compCheckNN(m, compLang(m, 0),
, 'language expression after $£')';'
end
else if scanLit(s, '$@for') then do
v = compCheckNN(m, compExpr(m, 'w') ,
, "variable name after $@for")
call compSpNlComment m
return 'do while envRead('v');',
compCheckNN(m, compStmt(m),
, "statement after $@for variable") 'end;'
end
else if scanLit(s, '$@run') then do
return 'call oRun' compCheckNN(m, compExpr(m, 's'),
, 'expression after $@run') ';'
end
return ''
endProcedure compStmt
/*--- compile a language clause
multi=0 a single line for a rexx expression
multi=1 mulitple lines for rexx statements
(with rexx line contiunation) -----------------------*/
compLang: procedure expose m.
parse arg m, multi
s = m.m.scan
res = ''
do forever
if scanVerify(s, m.m.chDol, 'm') then do
res = res || m.s.tok
end
else do
one = compPrimary(m)
if one ^== '' then
res = res || one
else if compComment(m) then
res = res || ' '
else if ^multi then
return res
else if ^ scanReadNl(s) then do
if res == '' then
return res
else
return strip(res)';'
end
else do
res = strip(res)
if right(res, 1) = ',' then
res = strip(left(res, length(res)-1))
else
res = res';'
end
end
end
endProcedure compLang
/*--- convert stmts to an expression yielding the output ------------*/
compStmts2ExprBuf: procedure expose m.
parse arg stmts
rr = oRunner(stmts)
return "envRun('"rr"')"
endProcedure compStmts2ExprBuf
/*--- convert '' to an empty expression ------------------------------*/
compNull2EE: procedure
parse arg e
if e = '' then
e return '""'
return e
endProcedure compNull2EE
/*--- if va == '' then issue an error with msg -----------------------*/
compCheckNN: procedure expose m.
parse arg m, va, msg
if va == '' then
call scanErr m.m.scan, msg 'expected'
return va
endProcedure compCheckNN
/*--- skip a comment. return 0 if there is none ----------------------*/
compComment: procedure expose m.
parse arg m
s = m.m.scan
if scanLit(s, '$**') then
m.s.pos = 1 + length(m.s.src) /* before next nl */
else if scanLit(s, '$*+') then
call scanReadNl s, 1
else if scanLit(s, '$*(') then do
do forever
if scanVerify(s, m.m.chDol, 'm') then iterate
if scanReadNl(s) then iterate
if compComment(m) then iterate
if ^ scanLit(s, '$') then
call scanErr s, 'source end in comment'
if scanLit(s, '*)') then
return 1
if scanLit(s, '$') then iterate
if scanString(s) then iterate
end
end
else
return 0
return 1
endProcedure compComment
/*--- skip spaces and comments ---------------------------------------*/
compSpComment: procedure expose m.
parse arg m
found = 0
do forever
if scanVerify(m.m.scan, m.m.chSpa) then
found = 1
else if compComment(m) then
found = 1
else
return found
end
endProcedure compSpComment
/*--- skip spaces, NLs and comments ----------------------------------*/
compSpNlComment: procedure expose m.
parse arg m
found = 0
do forever
if compSpComment(m) then
found = 1
else if scanReadNl(m.m.scan) then
found = 1
else
return found
end
endProcedure compSpComment
/* copy comp end ******************************************************/
/* copy tst begin ****************************************************
test infrastructure
***********************************************************************/
/*--- return stems ---------------------------------------------------*/
/*--- make writerDescriptor m a testWriter
--- and use remaining lines as compare values -----------------*/
tst: procedure expose m.
parse arg m, nm
if m.tst.ini <> 1 then
call tstIni
m.m.name = nm
m.tst.act = m
m.tst.tests = m.tst.tests+1
call oMutate m, 'Tst'
ox = 1
m.m.cmp.ox = left('****** start tst' nm '', 79, '*')
do ax=3 to arg()
ox = ox + 1
m.m.cmp.ox = arg(ax)
end
m.m.cmp.0 = ox
m.m.in.0 = 0
m.m.inIx = 0
m.m.out.0 = 0
m.m.err = 0
call mAdd m'.IN', 'tst in line 1 eins ,' ,
, 'tst in line 2 zwei ; ' ,
, 'tst in line 3 drei |'
call oMutate m, 'Tst'
if m.env.0 <> 1 then
call tstErr m, 'm.env.0' m.env.0 '<> 1'
call envPush env( '<-£', m, '>-£', m)
call tstOut m, m.m.cmp.1
return 'TST.'m
endProcedure tst
tstEnd: procedure expose m.
parse arg m, opt
m.tst.act = ''
call envPop
if m.env.0 <> 1 then
call tstErr m, 'm.env.0' m.env.0 '<> 1'
if m.m.out.0 ^= m.m.cmp.0 then do
call tstErr m, 'old' m.m.cmp.0 'lines ^= new' m.m.out.0
do nx = m.m.out.0 + 1 to min(m.m.out.0+10, m.m.cmp.0)
say 'old - ' m.m.cmp.nx
end
end
if m.m.err > 0 then do
say 'new lines:' (m.m.out.0 - 1)
len = 60
do nx=2 to m.m.out.0
str = quote(m.m.out.nx, '"')
pr = ' , '
do while length(str) > len
l=len
if substr(str, l-1, 1) = '"' then
if posCount('"', left(str, l-1)) // 2 = 0 then
l = l-1
say pr left(str, l-1)'",'
str = '"'substr(str, l)
pr = ' ||'
end
say pr str || left(',', nx < m.m.out.0)
end
end
say left('******' m.m.name 'end with' m.m.err 'errors ', 79,
, '*')
return
endProcedure tstEnd
/*--- write to test: say lines and compare them ----------------------*/
tstWrite: procedure expose m.
parse arg m, arg
call tstOut m, 'jOut:' arg
return
endProcedure tstWrite
tstOut: procedure expose m.
parse arg m, arg
call mAdd m'.OUT', arg
nx = m.m.out.0
if nx > m.m.cmp.0 then do
if nx = m.m.cmp.0+1 then
call tstErr m, 'more new Lines' nx
end
else if m.m.cmp.nx ^== arg then do
call tstErr m, 'next line old' nx '^^^ new overnext'
say m.m.cmp.nx
end
say arg
return
endProcedure tstOut
tstRead: procedure expose m.
parse arg m, arg
ix = m.m.inIx + 1
m.m.inIx = ix
if ix <= m.m.in.0 then do
m.arg = m.m.in.ix
call tstOut m, '<jIn' ix'<' m.arg
return 1
end
call tstOut m, 'jIn eof' ix
return 0
endProcedure tstRead
tstDsn: procedure
parse arg suf, opt
dsn = dsn2jcl('~tmp.tst.'suf)
if opt = 'r' & sysDsn("'"dsn"'") ^== 'DATASET NOT FOUND' then
call adrTso "delete '"dsn"'"
return dsn
endProcedure tstDsn
/*--- say total errors and fail if not zero --------------------------*/
tstTotal: procedure expose m.
say '******'
say '******'
say '******' m.tst.tests 'tests with' ,
m.tst.err 'errors in' m.tst.errNames
say '******'
say '******'
if m.tst.err ^== 0 then
call err m.tst.err 'errors total'
return
endProcedure tstTotal
/*--- test err: message, count it and continue -----------------------*/
tstErr: procedure expose m.
parse arg m, msg
say '*** error' msg
m.m.err = m.m.err + 1
m.tst.err = m.tst.err + 1
nm = m.m.name
if wordPos(nm, m.tst.errNames) < 1 then
m.tst.errNames = m.tst.errNames nm
return
endProcedure tstErr
/*--- tstErrHandler: intercept errors --------------------------------*/
tstErrHandler: procedure expose m.
parse arg ggTxt, ggStem
if m.tst.act == '' then
call err ggTxt, ggStem, '*'
call tstOut m.tst.act, '*** err:' ggTxt
if ggStem ^== '' then
do x=1 to m.ggStem.0
call tstOut m.tst.act, ' e' x':' m.ggStem.x
end
return
endSubroutine tstErrHandler
/*--- tstIni: global initialization ----------------------------------*/
tstIni: procedure expose m.
if m.tst.ini == 1 then
return
m.tst.ini = 1
call envIni
m.tst.err = 0
m.tst.errNames = ''
m.tst.tests = 0
m.tst.act = ''
call oClaAddMethods oNewClass("Tst"),
, "jRead", "return tstRead(m, var)",
, "jWrite", "call tstOut m, line"
call errReset 'h', 'call tstErrHandler ggTxt, ggStem'
return
endProcedure tstIni
/*--- return the count of occurrences of needle in heyStack ----------*/
posCount: procedure
parse arg needle, hayStack, start, fin
if start = '' then
start = 1
if fin = '' then
fin = length(hayStack) + 1 - length(needle)
do cnt = 0 by 1
start = pos(needle, haystack, start)
if start < 1 | start > fin then
return cnt
start = start + length(needle)
end
endProcedure posCount
/* copy tst end **************************************************/
/* copy env begin ******************************************************
***********************************************************************/
env: procedure expose m.
nn = oNew("Env")
m.nn.doClose.0 = 0
call envReset nn
do ax=1 by 2 to arg()-1
call envAddIo nn, arg(ax), arg(ax+1)
end
return nn
endProcedure env
envReset: procedure expose m.
parse arg m
call envClose m
m.m.in = ''
m.m.out = ''
m.m.doClose.0 = 0
m.m.lastCat = ''
do ax=2 by 2 to arg()-1
call envAddIo m, arg(ax), arg(ax+1)
end
return m
endProcedure envReset
envClose: procedure expose m.
parse arg m
do cx=1 to m.m.doClose.0
call jClose m.m.doClose.cx
end
m.m.doClose.0 = 0
return m
endProcedure envClose
envAddIO: procedure expose m.
parse arg m, opt, spec
contX = pos("+", opt)
if contX > 0 then do
opt = left(opt, contX-1)substr(opt,contX+1)
contX = 1
if m.m.lastCat == '' then
m.m.lastCat = cat()
end
if m.m.lastCat ^== '' then
call catAdd m.m.lastCat, opt, spec
else
oc = catMake(opt, spec)
if contX then
return
if m.m.lastCat ^== '' then do
oc = m.m.lastCat
m.m.lastCat = ''
opt = left(m.oc.opts.1, 1)
end
o1 = left(opt, 1)
if pos(o1, 'r<') > 0 then do
if m.m.in ^== '' then
call err 'envAddIo('opt',' spec') duplicate stdIn'
m.m.in = oc
end
else if pos(o1, 'wa>') > 0 then do
if m.m.out ^== '' then
call err 'envAddIo('opt',' spec') duplicate stdOut'
m.m.out = oc
end
if pos('-', opt) < 1 then do
call jOpen oc, catOpt(opt)
call mAdd m'.DOCLOSE', oc
end
return m
endProcedure envAddIO
envLink: procedure expose m.
parse arg m, old
if m.m.lastCat ^== '' then
call err 'envLink with open cat'
if m.m.in == '' then
m.m.in = m.j.jIn
if m.m.out == '' then
m.m.out = m.j.jOut
return m
endProcedure envLink
envReadWrite: procedure expose m.
parse arg opt, rdr
if opt ^== '' then
call envPush env(opt, rdr)
do while jIn(v)
call jOut m.v
end
if opt ^== '' then
call envPop
return
endProcedure envReadWrite
envRead2Buf: procedure expose m.
b = jBuf()
call envPush env('>£', b)
call envReadWrite
x = envPop()
return b
endProcedure envRead2Buf
envPreSuf: procedure expose m.
parse arg le, ri
do while jIn(v)
call jOut le || m.v || ri
end
return
endProcedure envPreSuf
envIsDefined: procedure expose m.
parse arg na
return symbol('m.env.vars.na') == 'VAR'
endProcedure envIsDefined
envGet: procedure expose m.
parse arg na
return mapGet(env.vars, na)
envRead: procedure expose m.
parse arg na
return jIn(env.vars.na)
envHasKey: procedure expose m.
parse arg na
return mapHasKey(env.vars, na)
envVia: procedure expose m.
parse arg na
return mapVia(env.vars, na)
envPut: procedure expose m.
parse arg na, va
return mapPut(env.vars, na, va)
envRemove: procedure expose m.
parse arg na
return mapRemove(env.vars, na)
envIni: procedure expose m.
if m.env.ini == 1 then
return
m.env.ini = 1
call catIni
call oClaAddMethods oNewClass("Env", "JRW"),
, "jOpen", "call err 'envOpen('m', 'arg')'",
, "jReset", "return envReset(m, arg, arg(3), arg(4), arg(5))",
, "jClose", "call envClose m"
m.env.0 = 1
call mapReset env.vars
ex = env()
m.env.1 = ex
m.ex.in = m.j.jIn
m.ex.out = m.j.jOut
return
endProcedure
envPush: procedure expose m.
parse arg e
ex = m.env.0
call envLink e, m.env.ex
ex = ex + 1
m.env.0 = ex
m.env.ex = e
m.j.jIn = m.e.in
m.j.jOut = m.e.out
return e
endProcedure envPush
envPop: procedure expose m.
ox = m.env.0
if ox <= 1 then
call err 'envPop on empty stack' ox
call envClose m.env.ox
ex = ox - 1
m.env.0 = ex
e = m.env.ex
m.j.jIn = m.e.in
m.j.jOut = m.e.out
return m.env.ox
endProcedure envPop
envBarBegin: procedure expose m.
call envPush env('>£', jBuf())
return
endProcedure envBarBegin
envBar: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.oldEnv.out, '>£', jBuf())
return
endProcedure envBar
envBarLast: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.oldEnv.out)
return
endProcedure envBarLast
envBarEnd: procedure expose m.
oldEnv = envPop()
return
endProcedure envBarEnd
/*--- return the output buffer of oRunner m --------------------------*/
envRun: procedure expose m.
parse arg m
b = jBuf()
call envPush env('>£', b)
call oRun m
x = envPop()
return b
endProcedure envRun
/* copy env end *******************************************************/
/* copy cat begin ****************************************************
***********************************************************************/
catOpt: procedure
parse arg opt, keep
if abbrev(opt, '<') then
o = 'r'substr(opt, 2)
else if abbrev(opt, '>>') then
o = 'a'substr(opt, 3)
else if abbrev(opt, '>') then
o = 'w'substr(opt, 2)
else if pos(left(opt, 1), 'rwa') > 0 then
o = opt
else
o = '?'opt
if keep ^== 1 then
o = translate(o, ' ', '£#')
return space(o, 0)
endProcedure catOpt
catMake: procedure expose m.
parse arg opt, spec
o = catOpt(opt, 1)
if pos('£', o) > 0 then
return spec
else if pos('#', o) > 0 then do
if envhasKey(spec) then
return catMake(translate(opt, '£', '#'), envGet(spec))
else
return envPut(spec, jBuf())
end
else if pos('&', o) > 0 then
return catDsn('&'spec)
else
return catDsn(spec)
call err 'catMake implement' opt
if defDsn == '' then do
o = left(o, length(o)-1)
end
else if defDsn == '' then do
rw = catDsn(spec)
end
else do
rw = jReset(defDsn, spec)
end
if pos('-', o) < 1 then
call jOpen rw, o
return rw
endProcedure catMake
cat: procedure expose m.
m = oNew('Cat')
m.m.catIx = -9
call catReset m
do ax=1 by 2 to arg()
call catAdd m, arg(ax), arg(ax+1)
end
return m
endProcedure cat
catReset: procedure expose m.
parse arg m
call jClose m
m.m.opts.0 = 0
m.m.RWs.0 = 0
m.m.catIx = -9
do ax=2 to arg()
call catAdd m, arg(ax), arg(ax+1)
end
return m
endProcedure catReset
catAdd: procedure expose m.
parse arg m
if m.m.catIx ^== -9 then
call err 'catAdd('m',' arg(2)',' arg(3)') but opened,',
'catIx='m.m.catIx
bx = m.m.RWs.0
do ax=2 by 2 to arg()
bx=bx+1
m.m.opts.bx = catOpt(arg(ax))
m.m.RWs.bx = catMake(arg(ax), arg(ax+1))
end
m.m.RWs.0 = bx
m.m.opts.0 = bx
return
endProcedure catAdd
catClose: procedure expose m.
parse arg m
if m.m.catIx == -9 then
return
xx = max(1, m.m.catIx)
if xx <= m.m.RWs.0 & pos('-', m.m.opts.xx) < 1 then
call jClose m.m.catCur
m.m.catIx = -9
call oMutate m, 'Cat'
return m
endProcedure catClose
catOpen: procedure expose m.
parse arg m, oo
call jClose m
if oo = 'r' then do
m.m.catIx = 0
m.m.catCur = catNextRdr(m)
call oMutate m, 'CatRead'
end
else if oo == 'w' | oo == 'a' then do
if m.m.RWs.0 < 1 then
call err 'catOpen('m',' oo') but no writer'
m.m.catIx = -7
m.m.catCur = m.m.RWs.1
if pos('-', m.m.opts.1) < 1 then do
aa = m.m.opts.1
if pos(left(aa, 1), 'wa') < 1 then
aa = overlay(oo, aa)
call jOpen m.m.catCur, aa
end
call oMutate m, 'CatWrite'
end
else do
call err 'catOpen('m',' oo') bad opt'
end
return m
endProcedure catOpen
catNextRdr: procedure expose m.
parse arg m
cx = m.m.catIx
if cx > 0 & cx <= m.m.RWs.0 & pos('-', m.m.opts.cx) < 1 then
call jClose m.m.catCur
cx = cx + 1
m.m.catIx = cx
if cx > m.m.RWs.0 then
return ''
oo = overlay('r', m.m.opts.cx)
if pos('-', oo) < 1 then
call jOpen m.m.RWs.cx, oo
return m.m.RWs.cx
endProcedure catNextRdr
catRead: procedure expose m.
parse arg m, var
do while m.m.catCur ^== ''
if jRead(m.m.catCur, var) then
return 1
m.m.catCur = catNextRdr(m)
end
return 0
endProcedure catRead
catDsn: procedure expose m.
parse arg spec
m = oNew('CatDsn')
m.m.readIx = 'c'
ix = mInc('CAT.BUF')
m.m.defDD = 'CAT'ix
m.m.buf = 'CAT.BUF'ix
call catDsnReset m, spec
return m
endProcedure catDsn
catDsnReset: procedure expose m.
parse arg m, sp
call jClose m
if symbol('m.m.defDD') ^== 'VAR' then
m.m.defDD = 'CDD' mInc('CAT.DEFDD')
m.m.spec = sp
return m
endProcedure catDsnReset
catDsnOpen: procedure expose m.
parse arg m, opt
call jClose m
buf = m.m.buf
if opt == 'r' then do
aa = dsnAlloc(m.m.spec, 'SHR', m.m.defDD)
call readDDBegin word(aa, 1)
call oMutate m, 'CatDsnRead'
m.buf.0 = -1
m.m.readIx = 0
end
else do
if opt == 'w' then
aa = dsnAlloc(m.m.spec, 'OLD', m.m.defDD)
else if opt == 'a' then
aa = dsnAlloc(m.m.spec, 'MOD', m.m.defDD)
else
call err 'catDsnOpen('m',' opt') with bad opt'
call writeDDbegin word(aa, 1)
call oMutate m, 'CatDsnWrite'
m.buf.0 = 0
m.m.readIx = 'w'
end
m.m.dd = word(aa, 1)
m.m.free = subword(aa, 2)
return m
endProcedure catDsnOpen
catDsnClose:
parse arg m
buf = m.m.buf
if m.m.readIx ^== 'c' then do
if m.m.readIx == 'w' then do
if m.buf.0 > 0 then
call writeDD m.m.dd, 'M.'BUF'.'
call writeDDend m.m.dd
end
else do
call readDDend m.m.dd
end
interpret m.m.free
end
m.buf.0 = 'closed'
m.m.readIx = 'c'
m.m.free = ''
m.m.dd = ''
return m
endProcedure catDsnClose
catDsnRead: procedure expose m.
parse arg m, var
ix = m.m.readIx + 1
buf = m.m.buf
if ix > m.buf.0 then do
res = readDD(m.m.dd, 'M.'buf'.')
if ^ res then
return 0
ix = 1
end
m.m.readIx = ix
m.var = m.buf.ix
return 1
endProcedure catDsnRead
catDsnWrite: procedure expose m.
parse arg m, var
buf = m.m.buf
ix = m.buf.0 + 1
m.buf.0 = ix
m.buf.ix = var
if ix > 99 then do
call writeDD m.m.dd, 'M.'buf'.'
m.buf.0 = 0
end
return
endProcedure catDsnWrite
catIni: procedure expose m.
if m.cat.ini == 1 then
return
m.cat.ini = 1
m.cat.buf = 0
call jIni
call oClaAddMethods oNewClass("Cat", "JRW"),
, "jOpen", "return catOpen(m, arg)",
, "jReset", "return catReset(m, arg)",
, "jClose", "call catClose m"
call oClaAddMethods oNewClass("CatRead", "Cat"),
, "jRead", "return catRead(m, var)"
call oClaAddMethods oNewClass("CatWrite", "Cat"),
, "jWrite", "call jWrite m.m.catCur, line; return"
call oClaAddMethods oNewClass("CatDsn", "JRW"),
, "jOpen", "return catDsnOpen(m, arg)",
, "jReset", "return catDsnReset(m, arg)",
, "jClose", "call catDsnClose m"
call oClaAddMethods oNewClass("CatDsnRead", "CatDsn"),
, "jRead", "return catDsnRead(m, var)"
call oClaAddMethods oNewClass("CatDsnWrite", "CatDsn"),
, "jWrite", "call catDsnWrite m, line"
return
endProcedure catIni
/* copy cat end ****************************************************/
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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 -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
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 = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', ds) > 0) then
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 j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jRead: procedure expose m.
parse arg m, var
interpret oObjMethod(m, 'jRead')
endProcedure jRead
jWrite: procedure expose m.
parse arg m, line
interpret oObjMethod(m, 'jWrite')
return
endProcedure jWrite
jReset: procedure expose m.
parse arg m, arg
interpret oObjMethod(m, 'jReset')
call oMutate m, 'JRW'
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret oObjMethod(m, 'jOpen')
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
interpret oObjMethod(m, 'jClose')
return m
endProcedure jClose
jDefRead: procedure expose m.
parse arg m, m.j.m.read
m.j.m.write = 'call err "write('m') when reading"'
return m
endProcedure jDeRead
jDefWrite: procedure expose m.
parse arg m, m.j.m.write
m.j.m.read = 'call err "read('m') when writing"'
return m
endProcedure jDeWrite
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jIni: procedure expose m.
if m.j.ini == 1 then
return
m.j.ini = 1
call oIni
call oClaAddMethods oNewClass("JRW"),
, "jRead", "call err 'jRead('m',' var') but not opened r'",
, "jWrite", "call err 'jWrite('m',' line') but not opened w'"
call oClaAddMethods oNewClass("Jin", "JRW"),
, "jRead", "drop m.arg; return 0"
m.j.jIn = oNew("Jin")
call oClaAddMethods oNewClass("Jout", "JRW"),
, "jWrite", "say 'jOut:' line"
m.j.jOut = oNew("Jout")
call oClaAddMethods oNewClass("Jbuf", "JRW"),
, "jOpen", "return jBufOpen(m, arg)",
, "jReset", "return jBufReset(m, arg)",
, "jClose", "call oMutate m, 'Jbuf'"
call oClaAddMethods oNewClass("JbufRead", "Jbuf"),
, "jRead", "return mNext(m'.BUF', m'.READIX', var)"
call oClaAddMethods oNewClass("JbufWrite", "Jbuf"),
, "jWrite", "call mAdd m'.BUF', line"
return
endProcedure jInit
jStdIOError: procedure expose m.
parse arg fun m, arg
call err 'do not j'fun'('m',' arg') base stdIn/stdOut'
return
endSubroutine
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
jBuf: procedure expose m.
m = oNew('Jbuf')
call jBufReset m
do ax=1 to arg()
m.m.buf.ax = arg(ax)
end
m.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
m.m.stem = m'.BUF'
do ax=1 to arg() - 1
m.m.buf.ax = arg(ax+1)
end
m.m.buf.0 = ax-1
return m
endProcedure jBufReset
jBufOpen: procedure expose m.
parse arg m, opt
call jClose m
if opt == 'r' then do
m.m.readIx = 0
return oMutate(m, "JbufRead")
return m
end
if opt == 'w' then
m.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
return oMutate(m, "JbufWrite")
endProcedure jBufOpen
/* copy j end *********************************************************/
/* copy o begin *******************************************************/
oClaMethod: procedure expose m.
parse arg cl, me
if symbol('m.o.claMet.cl.me') = 'VAR' then
return m.o.claMet.cl.me
else
call err 'no method' me 'in class' cl
endProcedure oClaMethod
oObjMethod: procedure expose m.
parse arg obj, me
if symbol('m.o.obj2cla.obj') = 'VAR' then
return oClaMethod(m.o.obj2cla.obj, me)
if abbrev(obj, 'oCast:') then do
cx = pos(':', obj, 7)
return 'M="'substr(obj, cx+1)'";' ,
oClaMethod(substr(obj, 7,cx-7), me)
end
call err 'no class found for object' obj
endProcedure oObjMethod
oCast: procedure
parse arg obj, cl
if abbrev(obj, 'oCast:') then
obj = substr(obj, 1 + pos(':', obj, 7))
return 'oCast:'cl':'obj
endProcedure oCast
oNewClass: procedure expose m.
parse arg name, super
call oIni
if pos(left(name, 1), '0123456789') > 0 | ^datatype(name, 'a') then
call err 'bad class name' name
if mapHasKey(o.claNames, name) then
call err 'duplicate class' name
call mapAdd o.claNames, name
m.o.claObj.name.0 = 0
call mapReset 'O.CLAMET.'name, '='
do sx=1 to words(super)
sup = word(super, sx)
if ^mapHasKey(o.claNames, sup) then
call err 'superclass' sup 'is not initialized'
suMe = 'O.CLAMET.'sup
do x=1 to m.suMe.0
me = m.suMe.x
call mapPut 'O.CLAMET.'name, me, mapGet(suMe, me)
end
end
return name
endProcedure oNewClass
oClaAddMethods: procedure expose m.
parse arg cla
me = 'O.CLAMET.'cla
do ax=2 by 2 to arg()
call mapPut me, arg(ax), arg(ax+1)
end
return
endProcedure oClaAddMethods
oNew: procedure expose m.
parse arg cla
if symbol('M.O.CLANAMES.cla') ^== 'VAR' then
call err 'class' cla 'is not initialized'
nn = 'O.CLAOBJ.'cla'.'mInc('O.CLAOBJ.'cla'.0')
if symbol('m.o.obj2cla.nn') == 'VAR' then
call err 'oNew already defined:' nn
m.o.obj2cla.nn = cla
return nn
endProcedure oNew
oGetClass: procedure expose m.
parse arg obj
if symbol('m.o.obj2cla.obj') = 'VAR' then
return m.o.obj2cla.obj
else
call err 'no class found for object' obj
endProcedure oGetClass
oMutate: procedure expose m.
parse arg obj, cla
if symbol('M.O.CLANAMES.cla') ^== 'VAR' then
call err 'class' cla 'is not initialized'
m.o.obj2cla.obj = cla
return obj
endProcedure oMutate
oRunner: procedure expose m.
parse arg code
return oRunnerReset(oNew('ORunner'), code)
oRunnerReset: procedure expose m.
parse arg m, pCode
m.m.code = pCode
return m
endProcedure oRunnerReset
oRun: procedure expose m.
parse arg m
interpret m.m.code
return
endProcedure oRun
oIni: procedure expose m.
if m.o.ini = 1 then
return
m.o.ini = 1
call mapReset o.claNames, '='
call oClaAddMethods oNewClass('ORunner'), 'oRun', 'call oRun m'
return
endProcedure oIni
/* copy o end *********************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanReader(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.m.tok ==> last token
m.m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.m.pos ==> scan position
m.m.src ==> scan source
***********************************************************************/
scanIni: procedure expose m.
if m.scan.ini == 1 then
return
m.scan.ini = 1
m.scan.alfLC = 'abcdefghijklmnopqrstuvwxyz'
m.scan.alfUC = translate(m.scan.alfLC)
m.scan.alfa = m.scan.alfLC || m.scan.alfUC
m.scan.alfNum = m.scan.alfa || '0123456789'
return
endProcedure scanIni
scanReset: procedure expose m.
parse arg m, m.m.scanName1, namePlus, m.m.scanComment
call scanIni
m.m.tok = ''
m.m.val = ''
m.m.key = ''
m.m.read = ''
if m.m.scanName1 == '' then
m.m.scanName1 = m.scan.alfa
if namePlus == '' then
m.m.scanNameR = m.m.scanName1 || '0123456789'
else
m.m.scanNameR = m.m.scanName1 || namePlus
return m
endProcedure scanReset
/*--- begin scanning a single line -----------------------------------*/
scanSrc: procedure expose m.
parse arg m, m.m.src
m.m.pos = 1
return m
endProcedure scanSrc
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
if len == '' then
return substr(m.m.src, m.m.pos)
else
return substr(m.m.src, m.m.pos,
, min(len, 1 + length(m.m.src) - m.m.pos))
endProcedure scanLook
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m, lit
do ax=2 to arg()
if abbrev(substr(m.m.src, m.m.pos), arg(ax)) then do
m.m.tok = arg(ax)
m.m.pos = m.m.pos + length(arg(ax))
return 1
end
end
m.m.tok = ''
return 0
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.m.src)
if len ^= '' then
nx = min(m.m.pos + len, nx)
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanChar
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, qu
m.m.tok = ''
if qu = '' then do
qu = substr(m.m.src, m.m.pos, 1)
if pos(qu, "'""") < 1 then
return 0
end
else do
if substr(m.m.src, m.m.pos, 1) ^== qu then
return 0
end
bx = m.m.pos
ax = bx + 1
m.m.val = ''
do forever
qx = pos(qu, m.m.src, ax)
if qx < 1 then
return scanErr(m, 'ending Apostroph('qu') missing')
m.m.val = m.m.val || substr(m.m.src, ax, qx-ax)
if qx >= length(m.m.src) then
leave
else if substr(m.m.src, qx+1, 1) <> qu then
leave
ax = qx+2
m.m.val = m.m.val || qu
end
m.m.tok = substr(m.m.src, bx, qx+1-bx)
m.m.pos = qx+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.scanName1, rest in *.scanNameR ----*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.m.src, m.m.pos, 1),
, m.m.scanName1) <= 0 then do
m.m.tok = ''
return 0
end
return scanVerify(m, m.m.scanNameR)
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.m.src, alpha, , m.m.pos)
else
nx = verify(m.m.src, alpha, vOpt, m.m.pos)
if nx = 0 then
nx = length(m.m.src) + 1
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
scanNat: procedure expose m.
parse arg m, chEn
if ^ scanVerify(m, '0123456789') then
return 0
if chEn^==0 & pos(substr(m.m.src, m.m.pos,1), m.m.scanNameR)>0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
scanInt: procedure expose m.
parse arg m, chEn
if scanNat(m, chEn) then
return 1
ox = m.scan.m.pos
if pos(substr(m.scan.m.src, ox, 1) , '+-') < 1 then
return 0
m.scan.m.pos = ox + 1
if | scanNat(m) then do
m.scan.m.pos = ox
return 0
end
m.tok =substr(m.scan.m.src, ox, 1)|| m.tok
return 1
endProcedure scanInt
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m) then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.m.val = m.m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.m.pos - length(tok)
if substr(m.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.m.key = m.m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.m.val = def
m.m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.m.key '=')
return 1
endProcedure scanKeyValue
scanType: procedure expose m.
parse arg s, opt
cx = 1
a2 = ''
do while cx <= length(opt)
f = substr(opt, cx, 1)
cx = cx + 1
if pos(substr(opt, cx, 1), "'""") > 0 then do
m.scan.type.src = opt
m.scan.type.pos = cx
call scanString 'SCAN.TYPE'
a2 = m.scan.type.val
cx = m.scan.type.pos
end
if f == 'a' then
res = scanString(s, "'")
else if f == 'b' then
res = scanSpaceNl(s)
else if f == 'c' then
res = scanChar(s, a2)
else if f == 'd' then
res = scanNat(s, a2)
else if f == 'k' then
res = scanKeyValue(s, 'def')
else if f == 'l' then
res = scanLit(s, a2)
else if f == 'n' then
res = scanName(s)
else if f == 'q' then
res = scanString(s, '"')
else if f == 's' then
res = scanString(s)
else if f == 'v' then
res = scanVerify(s, a2)
else if f == 'w' then
res = scanWord(s)
else if f == 'y' then
res = scanVerify(s, a2, 'm')
else if pos(f, '123456789') > 0 then
res = scanChar(s, f)
else
call err 'bad scanType' f
if res then
return f
end
return ''
endProcedure scanType
scanAtEnd: procedure expose m.
parse arg m
if m.m.pos <= length(m.m.src) then
return 0
if m.m.read ^== '' then
interpret oObjMethod(m, 'scanAtEnd')
return 1
endProcedure scanAtEnd
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.m.tok
if m.m.read ^== '' then
interpret 'res = ' oObjMethod(m, 'scanSpaceNl')
else
res = scanSpaceCom(m)
m.m.tok = lastTok
return res
endProcedure scanSpaceNL
scanSpaceCom: procedure expose m.
parse arg m
res = scanVerify(m, ' ')
if m.m.scanComment ^== '' then
if abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
m.m.pos = 1 + length(m.m.src)
return 1
end
return res
endProcedure scanSpaceCom
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
m.m.err.0 = 0
call err 'scanErr' txt, scanInfo(m, m'.ERR')
return 0
endProcedure scanErr
scanInfo:
parse arg m, st
x = m.st.0 + 1
m.st.0 = x
m.st.x = 'last token' m.m.tok 'scanPosition' ,
strip(left(substr(m.m.src, m.m.pos), 40), 't')
if m.m.read ^== '' then
interpret oObjMethod(m, 'scanInfo')
x = x + 1
m.st.x = 'pos' m.m.Pos 'in string' strip(m.m.src, 't')
m.st.0 = x
return st
endProcedure scanInfo
/* copy scan end ****************************************************/
/* copy scanRead begin ************************************************/
scanReadIni: procedure expose m.
if m.scanRead.ini = 1 then
return
m.scanRead.ini = 1 then
call scanIni
call jIni
call oClaAddMethods oNewClass('ScanRead'),
, 'scanReadNl', 'return scanReadNlImpl(m, unCond)',
, 'scanAtEnd', 'return scanReadAtEnd(m)',
, 'scanSpaceNl', 'scanReadSpaceNl(m)',
, 'scanInfo', 'return scanReadInfo(m, st)'
return
endProcedure scanReadIni
/*--- begin scanning the lines of a reader ---------------------------*/
scanRead: procedure expose m.
parse arg rdr, n1, np, co
return scanReadReset(oNew('ScanRead'), rdr , n1, np, co)
scanReadReset: procedure expose m.
parse arg m, rdr, n1, np, co
call scanReset m, n1, np, co
m.m.atEnd = 0
m.m.lineX = 0
m.m.read = rdr
call jOpen rdr, 'r'
call scanReadNl m, 1
return m
endProcedure scanReader
scanReadNl: procedure expose m.
parse arg m, unCond
interpret oObjMethod(m, 'scanReadNl')
endProcedure scanReadNl
/*--- return true/false whether we are at the end of line / reader ---*/
scanReadAtEnd: procedure expose m.
parse arg m
return m.m.atEnd
endProcedure scanReadAtEnd
scanReadNLimpl: procedure expose m.
parse arg m, unCond
if unCond ^== 1 then
if m.m.pos <= length(m.m.src) then
return 0
if m.m.atEnd then
return 0
m.m.atEnd = ^ jRead(m.m.read, m'.SRC')
if m.m.atEnd then do
m.m.pos = 1 + length(m.m.src)
end
else do
m.m.pos = 1
m.m.lineX = m.m.lineX + 1
end
return ^ m.m.atEnd
endProcedure scanReadNLimpl
scanReadSpaceNl: procedure expose m.
parse arg m
fnd = 0
do forever
if scanSpaceCom(m) then
fnd = 1
if ^ scanReadNl(m) then
return fnd
fnd = 1
end
endProcedure scanReadSpaceNl
scanReadInfo: procedure expose m.
parse arg m, st
if m.m.atEnd then
qq = 'atEnd after'
else
qq = 'pos' m.m.pos 'in'
call mAdd st, qq 'line' m.m.lineX':' strip(m.m.src, 't')
return st
endProcedure scanReadInfo
/* copy scanRead end **************************************************/
/* copy map begin*******************************************************
map
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset( , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if m.map.ini ^== 1 then
call mapIni
if a == '' | symbol('m.map.a2.a.mix') ^== 'VAR' then do
call mAdd 'MAP.MAP', a
mx = m.map.map.0
if a == '' then
a = 'MAP.K2V.'mx
m.map.A2.a.mix = mx
end
else do
mx = m.map.A2.a.mix
call mapClear a
end
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.STEM.'mx
else
st = ''
m.map.a2.a.stem = st
if st ^== '' then
m.st.0 = 0
return a
endProcedure
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
mapKeys: procedure expose m.
parse arg a
if m.map.a2.a.stem == '' then
call err 'mapKeys('a') with no keys'
return m.map.a2.a.stem
endProcedure mapKeys
mapAdd: procedure expose m.
parse arg a, ky, val
if symbol('m.a.ky') == 'VAR' then
call err 'duplicate key in mAdd('a',' ky',' val')'
m.a.ky = val
if m.map.a2.a.stem ^== '' then
return mAdd(m.map.a2.a.stem, ky)
return
endProcedure mapAdd
mapPut: procedure expose m.
parse arg a, ky, val
if m.map.a2.a.stem ^== '' then
if symbol('m.a.ky') ^== 'VAR' then
call mAdd m.map.a2.a.stem, ky
m.a.ky = val
return val
endProcedure mapPut
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
drop m.a.ky
return val
endProcedure mapRemove
mapHasKey: procedure expose m.
parse arg a, ky
return symbol('m.a.ky') == 'VAR'
endProcedure mapHasKey
mapGet: procedure expose m.
parse arg a, ky
if symbol('m.a.ky') ^== 'VAR' then
call err 'missing key in mapGet('a',' ky')'
return m.a.ky
endProcedure mapGet
mapGetOr: procedure expose m.
parse arg a, ky, orDef
if symbol('m.a.ky') == 'VAR' then
return m.a.ky
else
return orDef
endProcedure mapGetOr
mapVia: procedure expose m.
parse arg a, ky
sx = pos('*', ky)
if sx < 1 then
return mapGet(a, ky)
via = mapGet(a, left(ky, sx-1))
do while sx <= length(ky)
fx = sx+1
sx = pos('*', ky, fx)
if sx < 1 then
sx = length(ky) + 1
if sx = fx then do
if symbol('m.via') ^== 'VAR' then
call err 'missing m.'via 'at' sx 'in mapVia('a',' ky')'
via = m.via
end
else do
f = substr(ky, fx, sx - fx)
if symbol('m.via.f') ^== 'VAR' then
call err 'missing m.'via'.'f ,
'at' sx 'in mapVia('a',' ky')'
via = m.via.f
end
end
return via
endProcedure mapVia
mapExpAt: procedure expose m.
parse arg a, src, sx
m.map.ExpAt = 0
cx = pos('$', src, sx)
if cx < 1 then
return substr(src, sx)
res = substr(src, sx, cx-sx)
do forever
if substr(src, cx+1, 1) = '{' then do
ex = pos('}', src, cx+2)
if ex < 1 then
call err 'missing } after' substr(src, cx) 'in' src
res = res || mapVia(a, strip(substr(src, cx+2, ex-cx-2)))
ex = ex + 1
end
else do
ex = verify(src, m.mAlfDot, 'n', cx+1)
if ex < 1 then
return res || mapVia(a, substr(src, cx+1))
if ex = cx+1 then do
m.map.ExpAt = cx
return res
end
res = res || mapVia(a, substr(src, cx+1, ex-cx-1))
end
cx = pos('$', src, ex)
if cx < 1 then
return res || substr(src, ex)
res = res || substr(src, ex, cx-ex)
end
endProcedure mapExpAt
mapExp: procedure expose m.
parse arg a, src
res = mapExpAt(a, src, 1)
if m.map.ExpAt ^== 0 then
call err 'mapExp stopped at' substr(src, map.ExpAt) 'in' src
return res
endProcedure mapExp
mapExpAllAt: procedure expose m.
parse arg a, dst, src, sx, cx
do while sx <= m.src.0
li = mapExpAt(a, m.src.sx, cx)
dx = m.map.ExpAt
if (cx=1 & dx = 0) | li ^= '' then
call mAdd dst, li
if dx = 0 then do
cx = 1
sx = sx+1
end
else do
return sx dx
end
end
return ''
endProcedure mapExpAllAt
mapExpAll: procedure expose m.
parse arg a, dst, src
sto = mapExpAllAt(a, dst, src, 1, 1)
if sto == '' then
return
lx = word(sto, 1)
call err 'mapExpAll stopped at' sto':' m.src.lx
endProcedure mapExpAll
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.map.0 = 0
return
endProcedure mIni
/* copy map end *******************************************************/
/* copy m begin ********************************************************
stem handling
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
mDefIfNot: procedure expose m.
parse arg a, put
if symbol('m.a') == 'VAR' then
return 0
m.a = put
return 1
endProcedure mDefIfNot
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
mNext: procedure expose m.
parse arg m, ix, var
nx = m.ix + 1
if nx > m.m.0 then
return 0
m.ix = nx
m.var = m.m.nx
return 1
endProcedur mNext
/*--- put into stem a the fields flds from arguments -----------------*/
mPut: procedure expose m.
parse arg a, flds
do wx = 1 to words(flds)
f = word(flds, wx)
m.a.f = arg(wx+2)
end
return a
endProcedure mPut
/*--- put into stem a the fields flds from stem b --------------------*/
mPutSt: procedure expose m.
parse arg a, flds, b
do wx = 1 to words(flds)
f = word(flds, wx)
m.a.f = m.b.f
end
return a
endProcedure mPutSt
/*--- put into stem a the fields flds from variable pool -------------*/
mPutVars:
parse arg ggA, ggFlds
do ggWx = 1 to words(ggFlds)
ggF = word(ggFlds, ggWx)
m.ggA.ggF = value(ggF)
end
return ggA
endProcedure mPutVars
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m end *********************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* configure err -----------------------------------------------------*/
errReset: procedure expose m.
parse arg oo, ha
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, ggStem, ggOpt
if ggOpt == '' & symbol('m.err.handler') == 'VAR' then do
interpret m.err.handler
return 12
end
say 'fatal error:' ggTxt
if ggOpt == '' | ggOpt == '*' then
ggOpt = translate(value('m.err.opt'), 'ht', 'HT')
if ggStem ^== '' then do
do ggXX=1 to m.ggStem.0
say ' ' m.ggStem.ggXX
end
if ggXX > 3 then
say 'fatal error in' ggS3':' ggTxt
end
parse source . . ggS3 . /* current rexx */
if ggOpt == 'h' 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 setRc(12)
endSubroutine err
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure expose m.
parse arg msg, st, op
say 'fatal error:' msg
call help
call err msg, st, 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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(TSTALL) cre=2008-06-23 mod=2008-11-24-17.34.31 F540769 ---
/* copy tstAll begin *************************************************/
/* copx tstSql end ***************************************************/
tstAll: procedure expose m.
call sqlOIni
call compIni
call tstBase
call tstComp
call tstPlus
return 0
endProcedure tstAll
tstPlus:
call tstSort
call tstMatch
call sqlIni
call tstSql
call tstSqlO
call tstSqlEnv
call tstTotal
return
tstWshBatch:
call adrTso 'alloc dd(WSH) shr dsn(WK.TEXT(WSHBATCH))'
call wshBatch
return adrTso('free dd(WSH)')
tstCsi: procedure expose m.
if 0 then do
call lmd 'A540769.*K'
call tstCsiCla 'A540769.WK.REXX'
call tstCsiCla 'A540769.AAA.DATASETS'
call tstCsiCla 'A540769.RRR.DATASETS'
end
if 0 then do
call tstCsiOpNx 'A540769.WK.*E*'
call tstCsiOpNx 'A540769.AAA.DATASETS'
call tstCsiOpNx 'A540769.RRR.DATASETS'
end
if 1 then do
call tstCsiNxCl 'A540769.WK.**'
call tstCsiNxCl 'DBTF.M*.**'
call tstCsiNxCl 'DBTF.BE*.**'
end
return
tstCsi: procedure expose m.
/* call lmd 'A540769.*K' */
call tstCsi1 'A540769.WK.REXX'
call tstCsi1 'A540769.AAA.DATASETS'
call tstCsi1 'A540769.RRR.DATASETS'
return
tstCsiCla:
parse arg ds
say ds '-->' csiCla(ds)
return
tstCsiOpNx: procedure expose m.
parse arg ds
m = 'NUE123'
s = 'res89'
flds = 'devtyp volser mgmtclas comudsiz NOBYTTRK UDATASIZ HARBA'
say 'csiOpen' ds
call csiOpen m, ds, flds
do while csiNext(m, s)
say m.s.dsn 'dev' c2x(m.s.devTyp) ,
'vol' m.s.volSer 'cla' m.s.mgmtclas,
'comuDsiz' m.s.comuDsiz 'noBytTrk' m.s.noBytTrk,
'udatasiz' c2x(m.s.udatasiz) ,
'harba' c2x(m.s.harba)
end
return
tstCsiNxCl: procedure expose m.
parse arg ds
m = 'ABC123'
s = 'efg89'
flds = 'devtyp volser mgmtclas'
say 'csiOpen' ds
call csiOpen m, ds, flds
say timing() 'begin'
do i=1 while csiNext(m, s)
nn = csiArcTape(m.s.volser, m.s.mgmtClas, m.s.devtyp, m.s.dsn)
/* oo = csiCla(strip(m.s.dsn))
if oo <> nn then
say nn '<>' oo m.s.dsn
*/ if i // 1000 = 0 then
say timing() i nn m.s.dsn
end
say timing() (i-1) nn m.s.dsn
return
tstTypePara:
b = jBuf()
say 'b typePara undef' oGetTypePara(b)
ty = oFldNew('Ty*', '=', '=', 'A = B =')
call oSetTypePara b, ty
say 'b argCla def' oGetTypePara(b)
call tstJ2
return
tstSort: procedure expose m.
call tst t, "tstSort" ,
, "sort 29 c ACHT DREI DREIZEHN EINS ELF FUENF M.I.25 M.I.26",
|| " M.I.27 M.I.29 NEUN SECHS SIEBEN VIER VIERZEHN ZEHN ZWEI Z",
|| "WOELF 0 1 1 1 2 2 3 3 4 4",
, "sort 22 c ACHT DREIZEHN ELF M.I.25 M.I.26 M.I.27 M.I.29 N",
|| "EUN VIERZEHN ZEHN ZWOELF 0 1 1 1 2 2 3 3 4 4",
, "sort 15 c M.I.25 M.I.26 M.I.27 M.I.29 0 1 1 1 2 2 3 3 4 4",
, "sort 8 c M.I.25 M.I.26 M.I.27 M.I.29 0 1 1",
, "sort 1 M.I.29"
m.i.1 = eins
m.i.2 = zwei
m.i.3 = drei
m.i.4 = vier
m.i.5 = fuenf
m.i.6 = sechs
m.i.7 = sieben
m.i.8 = acht
m.i.9 = neun
m.i.10 = zehn
m.i.11 = elf
m.i.12 = zwoelf
m.i.13 = dreizehn
m.i.14 = vierzehn
m.i.15 = 1
m.i.16 = 2
m.i.17 = 3
m.i.18 = 4
m.i.19 = 4
m.i.20 = 3
m.i.21 = 2
m.i.22 = 1
m.i.23 = 0
m.i.24 = 1
m.i.28 = 'c'
yy = 29
do while yy > 0
do x = 0 to yy
m.i.0 = x
call sort i, o
m = ''
la = ''
if x <> m.o.0 then
call err 'size mismatch' x '<>' m.o.0
do y=1 to m.o.0
m = m m.o.y
if ^ (la << m.o.y) then
call err 'sort mismatch' yy x y '^' la '<<' m.o.y
end
end
if yy // 7 = 1 then
call tstOut t, 'sort' yy m
do x = 2 to yy
x1 = x-1
m.i.x1 = m.i.x
end
yy = yy-1
end
call tstEnd t
return
endProcedure tstSort
tstMatch: procedure expose m.
call tst t, "tstMatch" ,
, "match(eins, e?n*) 1 1 2,i,s trans(E?N*) EiNs",
, "match(eins, eins) 1 1 0 trans(EINS) EINS",
, "match(e1nss, e?n*) 1 1 2,1,ss trans(?*) 1ss",
, "match(eiinss, e?n*) 0 0 -9",
, "match(einss, e?n *) 0 0 -9",
, "match(ein s, e?n *) 1 1 2,i,s trans(E?N *) EiN s",
, "match(ein abss , ?i*b*) 1 1 3,e,n a,ss trans(?I*B*) eIn",
|| " aBss ",
, "match(ein abss wie gehtsssxdirx und auch , ) 0 0 -9",
, "match(ies000, *000) 1 1 1,ies trans(*000) ies000",
, "match(xx0x0000, *000) 1 1 1,xx0x0 trans(*000) xx0x0000",
, "match(000x00000xx, 000*) 1 1 1,x00000xx trans(000*) 000x00",
|| "000xx",
, "match(000xx, *0*) 1 1 2,00,xx trans(ab*cd*ef) ab00cdxxef"
call tstOut t, matchTest1('eins', 'e?n*' )
call tstOut t, matchTest1('eins', 'eins' )
call tstOut t, matchTest1('e1nss', 'e?n*', '?*' )
call tstOut t, matchTest1('eiinss', 'e?n*' )
call tstOut t, matchTest1('einss', 'e?n *' )
call tstOut t, matchTest1('ein s', 'e?n *' )
call tstOut t, matchTest1('ein abss ', '?i*b*' )
call tstOut t, matchTest1('ein abss wie gehtsssxdirx und auch ' )
call tstOut t, matchTest1('ies000', '*000' )
call tstOut t, matchTest1('xx0x0000', '*000' )
call tstOut t, matchTest1('000x00000xx', '000*' )
call tstOut t, matchTest1('000xx', '*0*', 'ab*cd*ef' )
call tstEnd t
return
matchTest1:
parse arg w, m, m2
r = 'match('w',' m')' match(w, m) match(w, m, vv) m.vv.0
do x=1 to m.vv.0
r = r','m.vv.x
end
if m2 = '' then
m2 = translate(m)
if m.vv.0 >= 0 then
r = r 'trans('m2')' matchTrans(m2, vv)
return r
endProcedure matchTest1
tstSqlUtils: procedure expose m.
call sqlConnect 'DBAF'
id = 'A540769.dsnUtils'
rst = 'NO'
retcode = -9876
e = ''
z = 0
st = "TEMPLATE TCOPYD",
"DSN('&SSID..&JO..&US..P&PART(2)..D&DATE(3)..T&TIME.')",
"DATACLAS(NULL12) MGMTCLAS(COM#A011) STORCLAS(FAR$N)",
"SPACE (150,3750) TRK UNCNT 59;",
"listdef abc include tablespace DA540769.A002* partlevel;",
"listdef mf include tablespace MF01A1A.A110A partlevel;",
"copy list abc copyddn(tcopyd) shrlevel change;"
upper st
call sqlExec "call SYSPROC.DSNUTILS ( :id, :rst,",
":st,:retcode, :ANY" copies(',:e,:e,:z',12) ")"
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE SYSPROC.DSNUTILS'
say 'results' results
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say 'allocated c111'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say 'closed'
call sqlDisconnect
exit
endProcedure tstSqlUtils
tstSqlStored: procedure expose m.
call sqlConnect 'DBAF'
rst = 'NO'
retcode = -9876
e = ''
z = 0
st = "abc"
call sqlExec "call SYSPROC.COMMAND ( :st, :rst)"
say 'after call st='st 'rst='rst
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE SYSPROC.COMMAND'
say 'results' results
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say 'allocated c111'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say 'closed'
call sqlDisconnect
return
endProcedure tstSqlStored
tstSqlStoredWK: procedure expose m.
call sqlConnect 'DBAF'
/* st = "direct wkUtiSub"
rst = 'NO'
say 'before call st='st 'rst='rst
call sqlExec "call A540769.WKUTILSUB ( :st, :rst)"
say 'after call st='st 'rst='rst
*/ rst = 'NO'
retcode = -9876
e = ''
z = 0
prc = 'DB2UTIL.DB2UTIL'
st = "DA540769.A2*" /* DA540769.A1*" */
say "call" prc "("st", ...)"
call sqlExec "call" prc "(:st, :rst)"
say 'after call st='st 'rst='rst
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE' prc
/* say 'results' results */
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say ''
say '***** utility output'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say '***** end output'
call sqlDisconnect
return 0
endProcedure tstSqlStoredWK
tstSqlStoredSQL1: procedure expose m.
call sqlConnect 'DBIA'
rst = 'NO'
retcode = -9876
e = ''
z = 0
st = "DA540769.A2* DA540769.A1*"
call sqlExec "call A540769.WKSQL1 ( :st, :rst)"
say 'after call st='st 'rst='rst
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE A540769.WKUTIL'
say 'results' results
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say 'allocated c111'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say 'closed'
call sqlDisconnect
return
endProcedure tstSqlStoredSQL1
tstSqlTriggerTiming:
parse upper arg tb ni
m.noInsert = ni == 0
cnt = 200000
if tb = '' then
TB = 'GDB9998.TWK511TRI'
call sqlConnect dbaf
say timing() 'noInsert' m.noInsert 'tb' tb
call sql2St 49, '*', cc, 'select max(pri) MX from' tb
if m.cc.1.mx == m.sqlNull then
m.cc.1.mx = 0
von = m.cc.1.mx + 1
bis = m.cc.1.mx + cnt
say m.cc.0 'max' m.cc.1.mx 'von' von 'bis' bis 'count' cnt tb
if right(tb, 2) = 'A1' then do
call sqlPrepare 3, 'insert into' tb '(pri, short, long, par)' ,
'values (?, ?, ?, ?)'
do ax=von to bis
call sqlExecute 3, ax,
, ax 'wsh short', ax 'wsh long long long long long ',
, (ax-1) // 1000 + 1
end
end
else do
call sqlPrepare 3, 'insert into' tb '(pri, short, long)' ,
'values (?, ?, ?)'
do ax=von to bis
call sqlExecute 3, ax,
, ax 'wsh short', ax 'wsh long long long long long ',
, (ax-1) // 1000 + 1
end
end
/* call sqlLn 5,,, 'select * from' tb 'where pri >=' von */
call sqlExImm 'commit'
say timing()
call sqlDisconnect
return
endProcedure tstSqlTriggerTiming
tstSql: procedure expose m.
cx = 2
call tst t, "tstSql",
, "*** err: sqlCode -204 A540769.SYSDUMMY IS AN UNDEFINED NAM",
|| "E ",
, " e 1: warnings",
, " e 2: state 42704",
, " e 3: stmt = execSql prepare s7 from :src",
, " e 4: with src = select * from sysdummy",
, "fetchA 1 ab= m.abcdef.123.AB abc ef= efg",
, "fetchA 0 ab= m.abcdef.123.AB abc ef= efg",
, "sqlVars :M.STST.A :M.STST.A.SQLIND, :M.STST.B :M.STST.B.SQ",
|| "LIND, :M.STST.C :M.STST.C.SQLIND",
, "1 all from dummy1",
, "a=a b=2 c=0",
, "sqlVarsNull 1",
, "a=a b=2 c=---",
, "fetchBT 1 SYSTABLES",
, "fetchBT 0 SYSTABLES",
, "fetchBI 1 SYSINDEXES",
, "fetchBI 0 SYSINDEXES"
call mAdd t.cmp,
, "opAllCl 3",
, "fetchC 1 SYSTABLES",
, "fetchC 2 SYSTABLESPACE",
, "fetchC 3 SYSTABLESPACESTATS",
, "PreAllCl 3",
, "fetchD 1 SYSIBM.SYSTABLES",
, "fetchD 2 SYSIBM.SYSTABLESPACE",
, "fetchD 3 SYSIBM.SYSTABLESPACESTATS"
call sqlConnect 'DBAF'
src = 'select * from sysdummy'
call sqlExec 'prepare s7 from :src'
call sqlPrepare cx, "select 'abc' , 'efg'",
'from sysibm.sysDummy1'
call sqlExec 'declare c'cx 'cursor for s'cx
call sqlOpen cx
a = 'abcdef'
b = 123
do i=1 to 2
call jOut 'fetchA' sqlFetchInto(cx, ':m.a.b.ab, :m.a.b.ef') ,
'ab= m.'a'.' || b'.'ab m.a.b.ab 'ef=' m.a.b.ef
end
call sqlClose cx
drop stst a b c m.stst.a m.stst.b m.stst.c
sv = sqlVars('M.STST', A B C , 1)
call jOut 'sqlVars' sv
call jOut sqlPreAllCl(cx,
, "select 'a', 2, case when 1=0 then 1 else null end ",
"from sysibm.sysDummy1",
, stst, sv) 'all from dummy1'
call jOut 'a='m.stst.a 'b='m.stst.b 'c='m.stst.c
call jOut 'sqlVarsNull' sqlVarsNull(stst, A B C)
call jOut 'a='m.stst.a 'b='m.stst.b 'c='m.stst.c
call sqlPreDeclare cx, "select name" ,
"from sysibm.sysTables" ,
"where creator = 'SYSIBM' and name = ?"
call sqlOpen cx, 'SYSTABLES'
call jOut 'fetchBT' sqlFetchInto(cx, ':NM') nm
call jOut 'fetchBT' sqlFetchInto(cx, ':NM') nm
call sqlClose cx
call sqlOpen cx, 'SYSINDEXES'
a = 'a b c'
b = 1234565687687234
call jOut 'fetchBI' sqlFetchInto(cx, ':NM') nm
call jOut 'fetchBI' sqlFetchInto(cx, ':NM') nm
call sqlClose cx
src = "select name" ,
"from sysibm.sysTables" ,
"where creator = 'SYSIBM' and name like 'SYSTABLES%'",
"fetch first 3 rows only"
call sqlPreDeclare cx, src
st = 'wie geht'' s'
call jOut 'opAllCl' sqlOpAllCl(cx, st, ':M.ST.SX.NAME')
do x=1 to m.st.0
call jOut 'fetchC' x m.st.x.name
end
st = 'auch noch'
src = "select strip(creator) || '.' || strip(name)" substr(src,12)
call jOut 'PreAllCl' sqlPreAllCl(cx+11, src, st, ':M.ST.SX.NAME')
do x=1 to m.st.0
call jOut 'fetchD' x m.st.x.name
end
call sqlDisconnect
call tstEnd t
return
endProcedure tstSql
tstSqlO: procedure expose m.
call tst t, "tstSqlO",
, "*** err: sqlCode -204 A540769.SYSDUMMY IS AN UNDEFINED NAM",
|| "E ",
, " e 1: warnings",
, " e 2: state 42704",
, " e 3: stmt = execSql prepare s7 from :src",
, " e 4: with src = select * from sysdummy",
, "REQD=Y col=123 case=--- col5=anonym",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE ",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE ",
, "SYSTABLEPART_HI T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE ",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_HIST T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE"
call sqlConnect 'DBAF'
src = 'select * from sysdummy'
call sqlExec 'prepare s7 from :src'
call sql2Cursor 13,
, 'select d.*, 123, current timestamp "jetzt und heute",',
'case when 1=0 then 1 else null end caseNull,',
"'anonym'" ,
'from sysibm.sysdummy1 d'
call sqlOpen 13
do while sqlFetch(13, abc)
call jOut 'REQD='m.ABC.IBMREQD 'col='m.ABC.col2,
'case='m.ABC.CASENULL,
'col5='m.ABC.col5
je = 'jetzt'
jetzt = m.ABC.je
dd = date('s')
dd = left(dd, 4)'-'substr(dd, 5, 2)'-'right(dd, 2)'-' ,
|| left(time(), 2)'.'
say 'jetzt='jetzt 'date time' dd
if ^ abbrev(jetzt, dd) then
call err 'date mismatch abbrev' dd
end
call sqlClose 13
call sql2Cursor 13 ,
, 'select name, type, dbName, tsName' ,
/* ,alteredTS, obid, cardf'*/ ,
'from sysibm.systables' ,
"where creator = 'SYSIBM' and name like 'SYSTA%'" ,
"fetch first 5 rows only",
, , 'sl<15'
call sqlOpen 13
call jOut fmtFldTitle(m.sql.13.fmt)
do while sqlFetchLn(13, li)
call jOut m.li
end
call sqlClose 13
call sqlGenFmt m.sql.13.fmt, 13, 'sst'
call sqlOpen 13
do ix=1 while sqlFetch(13, fe.ix)
end
m.fe.0 = ix-1
call fmtFldSquash sqFmt, sqlType(13), fe
call jOut fmtFldTitle(sqFmt)
do ix=1 to m.fe.0
call jOut oFldCat(sqlType(13), fe.ix, sqFmt)
end
call sqlClose 13
if 0 then do
call sql2Cursor 13 ,
, 'select *',
'from sysibm.systables' ,
"where creator = 'SYSIBM' and name like 'SYSTA%'" ,
"fetch first 1 rows only",
, , 'sl<15'
call sqlOpen 13
call jOut fmtFldTitle(m.sql.13.fmt)
do while sqlFetchLn(13, li)
call jOut m.li
end
call sqlClose 13
end
call sqlDisconnect
call tstEnd t
return
endProcedure tstSqlO
tstSqlEnv: procedure expose m.
call tst t, "tstSqlEnv",
, "REQD=Y COL2=123 case=--- COL5=anonym",
, "sql fmtFldRw sl<15",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE ",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE ",
, "SYSTABLEPART_HI T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE ",
, "sql fmtFldSquashRW",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_HIST T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE",
, "sqlLn sl=",
, "COL1 T DBNAME COL4 ",
, "SYSTABAUTH T DSNDB06 SYSDBASE"
call mAdd t.cmp,
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_ T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE",
, "sqlLn ---",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_HIST T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE"
call sqlConnect 'DBAF'
call envBarBegin
call jOut 'select d.*, 123, current timestamp "jetzt und heute",'
call jOut 'case when 1=0 then 1 else null end caseNull,'
call jOut "'anonym'"
call jOut 'from sysibm.sysdummy1 d'
call envBar
call sql 13
call envBarLast
do while envRead(abc)
call jOut 'REQD='envGet('ABC.IBMREQD'),
'COL2='envGet('ABC.COL2'),
'case='envGet('ABC.CASENULL'),
'COL5='envGet('ABC.COL5')
jetzt = envGet('ABC.jetzt')
say 'jetzt='jetzt
dd = date('s')
dd = left(dd, 4)'-'substr(dd, 5, 2)'-'right(dd, 2)'-' ,
|| left(time(), 2)'.'
if ^ abbrev(jetzt, dd) then
call err 'date mismatch abbrev' dd
end
call envBarEnd
call jOut 'sql fmtFldRw sl<15'
call envBarBegin
call jOut 'select name, type, dbName, tsName'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBar
call sql 13
call envBarLast
call fmtFldRW sqlGenFmt(fmtAbc, 13, 'sl<15')
call envBarEnd
call jOut 'sql fmtFldSquashRW'
call envBarBegin
call jOut 'select name, type, dbName, tsName'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBar
call sql 13
call envBarLast
call fmtFldSquashRW
call envBarEnd
call jOut 'sqlLn sl='
call envBarBegin
call jOut 'select char(name, 13), type, dbName, char(tsName, 8)'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBarLast
call sqlLn 13, , ,'sl='
call envBarEnd
call jOut 'sqlLn ---'
call envBarBegin
call jOut 'select name, type, dbName, tsName'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBarLast
call sqlLn 13
call envBarEnd
call sqlDisconnect
call tstEnd t
return
endProcedure tstSqlEnv
/* copx tstSql end ***************************************************/
/* copx tstComp begin **************************************************
test the wsh comp
***********************************************************************/
tstComp: procedure expose m.
call compIni
call tstCompDataConst
call tstCompDataVars
call tstCompShell
call tstCompPrimary
call tstCompStmt
call tstCompDataIO
call tstCompPipe
call tstCompRedir
call tstCompComp
call tstTotal
return
endProcedure tstComp
tstCompRun: procedure expose m.
parse arg type cnt
src = jBuf()
call jOpen src, 'w'
do sx=2 to arg()
call jWrite src, arg(sx)
end
cmp = comp(src)
call jOut 'compile' type',' (sx-2) 'lines:' arg(2)
r = compile(cmp, type)
say "compiled: >>>>" r "<<<<" m.r.code
call jOut "run without input"
call mCut 'T.IN', 0
call oRun r
if cnt == 3 then do
call jOut "run with 3 inputs"
call mAdd 'T.IN', "eins zwei drei", "zehn elf zwoelf?",
, "zwanzig 21 22 23 24 ... 29|"
m.t.inIx = 0
call oRun r
end
return
endProcedure tstCompRun
tstCompDataConst: procedure expose m.
call tst t, 'tstCompDataConst',
, "compile d, 8 lines: Lline one, $** asdf",
, "run without input",
, " Lline one, ",
, "line two.",
, "line threecontinued on 4",
, "line five fortsetzung",
, "line six fortsetzung"
call tstCompRun 'd' ,
, ' Lline one, $** asdf',
, 'line two.',
, 'line three$*+ bla bla' ,
, 'continued on 4',
, 'line five $*( und so',
, 'weiter $abc $? $''$*)'' $"$*)" und weiter $*) fortsetzung',
, 'line six $*( und $*( $** $*( so',
, 'weiter $abc $? $*)'' $"$*)" und weiter $*) fortsetzung'
call tstEnd t
return
endProcedure tstCompDataComm
tstCompDataVars: procedure expose m.
call tst t, 'tstCompDataVars',
, "compile d, 4 lines: Lline one, $** asdf",
, "run without input",
, " Lline one, ",
, "lline zwei output",
, "lline 3 ",
, "variable v1 = valueV1 ${v1}= valueV1| "
call tstCompRun 'd' ,
, ' Lline one, $** asdf',
, ' $$ lline zwei output',
, 'lline 3 $=v1= valueV1 ' ,
, 'variable v1 = $v1 $"${v1}=" ${ v1 }| '
call tstEnd t
return
endProcedure tstCompDataVars
tstCompShell: procedure expose m.
call tst t, 'tstCompShell',
, "compile s, 9 lines: $$ Lline one, $** asdf",
, "run without input",
, "Lline one,",
, "lline zwei output",
, "v1 = valueV1 ${v1}= valueV1|",
, "REXX JOUT L5 CONTINUED L6 CONTINUED L7",
, "L8 ONE",
, "L9 END"
call tstCompRun 's' ,
, ' $$ Lline one, $** asdf',
, ' $$ lline zwei output',
, ' $=v1= valueV1 ' ,
, '$$ v1 = $v1 $"${v1}=" ${ v1 }| ' ,
, 'call jOut rexx jout l5, ' ,
, ' continued l6 , ' ,
, ' continued l7 ' ,
, 'call jOut l8 one ' ,
, 'call jOut l9 end'
call tstEnd t
return
endProcedure tstCompDataVars
tstCompPrimary: procedure expose m.
call tst t, 'tstCompPrimary',
, "compile d, 11 lines: Strings $""$""""$""""""""$"""""" $'$'",
|| "'$''''$'''",
, "run without input",
, "Strings $""$""""$"" $'$''$'",
, "rexx 3*5 = 15",
, "data line three line four bis hier",
, "shell line five line six bis hier",
, "var get v1 value Eins, v1 value Eins ",
, "var isDef v1 1, v2 0 ",
, "jIn eof 1",
, "var read >1 0 rr undefined",
, "jIn eof 2",
, "var read >2 0 rr undefined",
, "run with 3 inputs",
, "Strings $""$""""$"" $'$''$'",
, "rexx 3*5 = 15",
, "data line three line four bis hier",
, "shell line five line six bis hier",
, "var get v1 value Eins, v1 value Eins "
call mAdd t.cmp,
, "var isDef v1 1, v2 0 ",
, "<jIn 1< eins zwei drei",
, "var read >1 1 rr eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "var read >2 1 rr zehn elf zwoelf?"
call envRemove 'v2'
call tstCompRun 'd' 3 ,
, 'Strings $"$""$""""$"""' "$'$''$''''$'''",
, 'rexx 3*5 = $( 3 * 5 $)',
, 'data $-¢ line three',
, 'line four $! bis hier',
, 'shell $-{ $$ line five',
, '$$ line six $} bis hier',
, '$= v1 = value Eins $=rr=undefined',
, 'var get v1 $v1, v1 ${ v1 } ',
, 'var isDef v1 ${? v$( 1 * 1 + 0 $) }, v2 ${?v2 } ',
, 'var read >1 ${> rr} rr $rr' ,
, 'var read >2 ${> rr} rr $rr'
call tstEnd t
return
endProcedure tstCompPrimary
tstCompStmt: procedure expose m.
call tst t, 'tstCompStmt1',
, "compile s, 8 lines: $= v1 = value eins $= v2 £ 3*5*7 ",
, "run without input",
, "data v1 value eins v2 105",
, "eins",
, "zwei",
, "drei",
, "vier",
, "fuenf",
, "elf",
, "zwoelf dreiZ ",
, "vierZ ",
, "fuenfZ",
, "lang v1 value eins v2 945",
, "oRun ouput 1"
call envPut 'oRun', oRunner('call jOut "oRun ouput" (1*1)')
call envRemove 'v2'
call tstCompRun 's' ,
, '$= v1 = value eins $= v2 £ 3*5*7 ',
, '$$ data v1 $v1 v2 ${ v2 }',
, '$$eins $@{$$ zwei $$ drei ',
, ' $@{ $} $@{ $@{ $$vier $} $} $} $$fuenf',
, '$$elf $@¢ zwoelf dreiZ ',
, ' $@¢ $! $@¢ $@¢ vierZ $! $! $! $$fuenfZ',
, '$£ "lang v1" $v1 "v2" ${v2}*9',
, '$@run $oRun'
call tstEnd t
call tst t, 'tstCompStmt2',
, "compile s, 1 lines: $@for qq $$ loop qq $qq",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "loop qq eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "loop qq zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "loop qq zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4"
call tstCompRun 's' 3 ,
, '$@for qq $$ loop qq $qq'
call tstEnd t
return
endProcedure tstCompStmt
tstCompDataIO: procedure expose m.
call tst t, 'tstCompDataHereData',
, "compile d, 13 lines: herdata $<<stop ",
, "run without input",
, " herdata ",
, "heredata 1 $x",
, "heredata 2 $y",
, "nach heredata",
, " herdata ¢ ",
, "heredata 1 xValue",
, "heredata 2 yValueY",
, "nach heredata ¢",
, " herdata { ",
, "HEREDATA 1 xValue",
, "heredata 2 yValueY",
, "nach heredata {"
call tstCompRun 'd' ,
, ' herdata $<<stop ',
, 'heredata 1 $x',
, 'heredata 2 $y',
, 'stop $$ nach heredata',
, ' herdata ¢ $<<¢stop ',
, '$=x=xValue$=y=yValueY',
, 'heredata 1 $x',
, 'heredata 2 $y',
, 'stop $$ nach heredata ¢',
, ' herdata { $<<{st',
, 'call jOut heredata 1 $x',
, '$$heredata 2 $y',
, 'st $$ nach heredata {'
call tstEnd t
dsn = tstDsn('lib37', 'r')'(readInp)'
call mAdd mCut(abc, 0), 'readInp line 1', 'readInp line 2'
call writeDsn dsn '::f37', m.abc., ,1
call envPut 'dsn', dsn
call tst t, 'tstCompDataIO',
, "compile d, 4 lines: input 1 $<$dsn ::fb ",
, "run without input",
, " input 1 ",
, "readInp line 1 ",
, "readInp line 2 ",
, " nach dsn input und nochmals mit & ",
, "readInp line 1 ",
, "readInp line 2 ",
, " und schluiss."
call tstCompRun 'd' ,
, ' input 1 $<$dsn ::fb ',
, ' nach dsn input und nochmals mit & ' ,
, ' $<&dsn('dsn2jcl(dsn)') dd(xyz)',
, ' und schluiss.'
call tstEnd t
return
endProcedure tstCompDataIO
tstCompPipe: procedure expose m.
call tst t, 'tstCompPipe1',
, "compile s, 1 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "(1 eins zwei drei 1)",
, "<jIn 2< zehn elf zwoelf?",
, "(1 zehn elf zwoelf? 1)",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "(1 zwanzig 21 22 23 24 ... 29| 1)",
, "jIn eof 4"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"'
call tstEnd t
call tst t, 'tstCompPipe2',
, "compile s, 2 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "¢2 (1 eins zwei drei 1) 2!",
, "¢2 (1 zehn elf zwoelf? 1) 2!",
, "¢2 (1 zwanzig 21 22 23 24 ... 29| 1) 2!"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $¨ call envPreSuf "¢2 ", " 2!"'
call tstEnd t
call tst t, 'tstCompPipe3',
, "compile s, 3 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "<3 ¢2 (1 eins zwei drei 1) 2! 3>",
, "<3 ¢2 (1 zehn elf zwoelf? 1) 2! 3>",
, "<3 ¢2 (1 zwanzig 21 22 23 24 ... 29| 1) 2! 3>"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $¨ call envPreSuf "¢2 ", " 2!"',
, ' $¨ call envPreSuf "<3 ", " 3>"'
call tstEnd t
call tst t, 'tstCompPipe4',
, "compile s, 7 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "<3 ¢222 ¢221 ¢21 ¢20 (1 eins zwei drei 1) 20! 21! 221! 222",
|| "! 3>",
, "<3 ¢222 ¢221 ¢21 ¢20 (1 zehn elf zwoelf? 1) 20! 21! 221! 22",
|| "2! 3>",
, "<3 ¢222 ¢221 ¢21 ¢20 (1 zwanzig 21 22 23 24 ... 29| 1) 20!",
|| " 21! 221! 222! 3>"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $¨ $@{ call envPreSuf "¢20 ", " 20!"',
, ' $¨ call envPreSuf "¢21 ", " 21!"',
, ' $¨ $@{ call envPreSuf "¢221 ", " 221!"',
, ' $¨ call envPreSuf "¢222 ", " 222!"',
, '$} $} ',
, ' $¨ call envPreSuf "<3 ", " 3>"'
call tstEnd t
return
endProcedure tstCompPipe
tstCompRedir: procedure expose m.
call tst t, 'tstCompRedir',
, "compile s, 5 lines: $>#eins $@for vv $$<$vv> $; ",
, "run without input",
, "jIn eof 1",
, "output eins ",
, "output piped zwei ",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "output eins <eins zwei drei> <zehn elf zwoelf?> <zwanzig 2",
|| "1 22 23 24 ... 29|>",
, "output piped zwei ab<eins zwei drei>yz ab<zehn elf zwoelf?",
|| ">yz ab<zwanzig 21 22 23 24 ... 29|>yz"
dsn = tstDsn('libvb', 'r')'(redir1)'
call envPut 'dsn', dsn
call tstCompRun 's' 3 ,
, ' $>#eins $@for vv $$<$vv> $; ',
, ' $$ output eins $-{$<#eins$}$; ',
, ' $@for ww $$b${ww}y ',
, ' $> $dsn ::v $¨ call envPreSuf "a", "z" $<# eins',
, '$;$$ output piped zwei $-{$<$dsn$} '
call tstEnd t
return
endProcedure tstCompRedir
tstCompComp: procedure expose m.
call tst t, 'tstCompCompShell',
, "compile s, 5 lines: $$compiling shell $; $= rrr = $-cmpShe",
|| "ll $<<aaa",
, "run without input",
, "compiling shell",
, "running einmal",
, "RUN 1 COMPILED einmal",
, "jIn eof 1",
, "running zweimal",
, "RUN 1 COMPILED zweimal",
, "jIn eof 2",
, "run with 3 inputs",
, "compiling shell",
, "running einmal",
, "RUN 1 COMPILED einmal",
, "<jIn 1< eins zwei drei",
, "compRun eins zwei dreieinmal"
call mAdd t'.CMP',
, "<jIn 2< zehn elf zwoelf?",
, "compRun zehn elf zwoelf?einmal",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "compRun zwanzig 21 22 23 24 ... 29|einmal",
, "jIn eof 4",
, "running zweimal",
, "RUN 1 COMPILED zweimal",
, "jIn eof 5"
call tstCompRun 's' 3 ,
, "$$compiling shell $; $= rrr = $-cmpShell $<<aaa",
, "call jOut run 1*1*1 compiled $cc; $@for v $$ compRun $v$cc",
, "aaa $;",
, "$=cc=einmal $$ running $cc $@run $rrr",
, "$=cc=zweimal $$ running $cc $@run $rrr"
call tstEnd t
call tst t, 'tstCompCompData',
, "compile s, 5 lines: $$compiling data $; $= rrr = $-cmpData",
|| " $<<aaa",
, "run without input",
, "compiling data",
, "running einmal",
, "call jOut run 1*1*1 compiled einmal",
, "running zweimal",
, "call jOut run 1*1*1 compiled zweimal",
, "run with 3 inputs",
, "compiling data",
, "running einmal",
, "call jOut run 1*1*1 compiled einmal",
, "running zweimal",
, "call jOut run 1*1*1 compiled zweimal"
call tstCompRun 's' 3 ,
, "$$compiling data $; $= rrr = $-cmpData $<<aaa",
, "call jOut run 1*1*1 compiled $cc",
, "aaa $;",
, "$=cc=einmal $$ running $cc $@run $rrr",
, "$=cc=zweimal $$ running $cc $@run $rrr"
call tstEnd t
return
endProcedure tstCompComp
/* copx tstComp end *************************************************/
/* copx tstBase begin **************************************************
test the basic classes
***********************************************************************/
tstBase: procedure expose m.
call tstM
call tstMap
call tstMapVia
call tstScan
call tstO
call tstJsay
call tstJ
call tstJ2
call tstCat
call tstScanRead
call tstScanWin
call tstScanSQL
call tstEnv
call tstEnvCat
call tstEnvLazy
call tstEnvVars
call tstCatDsn
call tstTotal
return
endProcedure tstBase
tstTstSay: procedure
call tst x, 'test eins', "test eins einzige testZeile"
call tstOut x, "test eins einzige testZeile"
call tstEnd x
call tst x, 'test zwei', "zwei 1. testZeile",
, "zwei 2. und letsdfazte testZeile"
call tstOut x, "zwei 1. testZeile"
call tstOut x, "zwei 2. und letzte testZeile"
call tstEnd x
call tst y, 'test drei',
, "drei 1. testZeile",
, "drei 2. tEstZeile",
, "drei 3. testZeile test line drei ganz lang 1 ",
|| " ...line drei ganz lang 2 ",
|| " ...line drei ganz lang 3 .",
|| "..line drei ganz lang 4 und schluss."
call tstOut y, 'drei 1. testZeile'
call tstOut y, 'drei 2. testZeile'
call tstOut y, 'drei 3. testZeile',
'test line drei ganz lang 1 ',
' ...line drei ganz lang 2 ',
' ...line drei ganz lang 3 ',
' ...line drei ganz lang 4 und schluss.'
call tstEnd y
call tstTotal
endProcedure tstTstSay
tstM: procedure
call tst t, 'tstM',
, "symbol m.b LIT",
, "mInc b 2 m.b 2",
, "symbol m.a LIT",
, "mAdd a A.2",
, "mAdd a A.3",
, "m.a: 3: 1=eins 2=zwei 3=drei 4=M.A.4",
, "m.c: 5: 1=c vor AddSt a 2=eins 3=zwei",
, " 4=drei 5=c nach addSt a 6=M.C.6"
call tstOut t, 'symbol m.b' symbol('m.b')
m.b = 1
call tstOut t, 'mInc b' mInc(b) 'm.b' m.b
call tstOut t, 'symbol m.a' symbol('m.a')
call tstOut t, 'mAdd a' mAdd(mCut(a, 0), 'eins', 'zwei')
call tstOut t, 'mAdd a' mAdd(a, 'drei')
call tstOut t, 'm.a:' m.a.0': 1='m.a.1 '2='m.a.2 '3='m.a.3 '4='m.a.4
call mAdd mCut(c, 0), 'c vor AddSt a'
call mAddSt c, a
call mAdd c, 'c nach addSt a'
call tstOut t, 'm.c:' m.c.0': 1='m.c.1 '2='m.c.2 '3='m.c.3
call tstOut t, ' 4='m.c.4 '5='m.c.5 '6='m.c.6
call tstEnd t
return
endProcedure tstM
tstMap: procedure expose m.
m = mapNew('K')
ky = mapKeys(m)
say '***mapNew' m 'keys' ky
call tst t, 'tstMap',
, "map "m": zwei --> 2",
, "map "m": Zwei is not defined",
, "map stem "ky" 4",
, "map "m": eins --> 1",
, "map "m": zwei --> 2",
, "map "m": drei --> 3",
, "map "m": vier --> 4",
, "*** err: duplicate key in mAdd("m", eins, 1)",
, "map "m": zwei is not defined",
, "q 2 zw dr",
, "map stem Q 2",
, "map Q: zw --> 2Q",
, "map Q: dr --> 3Q",
, "map stem "m" 3",
, "map "m": eins --> 1",
, "map "m": zwei --> 2PUT",
, "map "m": vier --> 4PUT",
, "*** err: duplicate key in mAdd("m", zwei, 2ADDDUP)"
call mapAdd m, 'eins', 1
call mapAdd m, 'zwei', 2
call mapAdd m, 'drei', 3
call mapAdd m, 'vier', 4
call tstMapShow m, 'zwei'
call tstMapShow m, 'Zwei'
call tstMapShowSt m, mapKeys(m)
call mapAdd m, 'eins', 1
call mapReset m, '='
call tstMapShow m, 'zwei'
call mapAdd m, 'eins', 1
call mapAdd m, 'zwei', 2
call mapPut m, 'zwei', 2Put
call mapPut m, 'vier', 4Put
call mapReset q, '='
call mapAdd q, 'zw', 2q
call mapAdd q, 'dr', 3q
call tstOut t, 'q' m.q.0 m.q.1 m.q.2
call tstMapShowSt q, mapKeys(q)
call tstMapShowSt m, mapKeys(m)
call mapAdd m, 'zwei', 2addDup
call tstEnd t
return
endProcedure tstMap
tstMapVia: procedure expose m.
call tst t, 'tstMap',
, "map M: K --> A",
, "mapVia(m, K) A",
, "*** err: missing m.A at 3 in mapVia(M, K*)",
, "mapVia(m, K*) M.A",
, "mapVia(m, K*) valAt m.a",
, "mapVia(m, K*) valAt m.a",
, "*** err: missing m.A.aB at 5 in mapVia(M, K*aB)",
, "mapVia(m, K*aB) M.A.aB",
, "mapVia(m, K*aB) valAt m.A.aB",
, "*** err: missing m.valAt m.a at 4 in mapVia(M, K**)",
, "mapVia(m, K**) M.valAt m.a",
, "mapVia(m, K**) valAt m.valAt m.a",
, "mapVia(m, K**F) valAt m.valAt m.a.F"
drop m.a.
call mapReset m
call mapAdd m, k, a
call tstMapShow m, k
call tstOut t, 'mapVia(m, K) ' mapVia(m, 'K')
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
m.a = 'valAt m.a'
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
call tstOut t, 'mapVia(m, K*aB) ' mapVia(m, 'K*aB')
u='A.aB'
m.u = 'valAt m.'u
call tstOut t, 'mapVia(m, K*aB) ' mapVia(m, 'K*aB')
call tstOut t, 'mapVia(m, K**) ' mapVia(m, 'K**')
u= m.a
m.u = 'valAt m.'u
m.u.f = 'valAt m.'u'.F'
call tstOut t, 'mapVia(m, K**) ' mapVia(m, 'K**')
call tstOut t, 'mapVia(m, K**F) ' mapVia(m, 'K**F')
call tstEnd t
return
endProcedure tstMapVia
tstMapShow: procedure expose m.
parse arg a, key
if mapHasKey(a, key) then
call tstOut t, 'map' a':' key '-->' mapGet(a, key)
else
call tstOut t, 'map' a':' key 'is not defined'
return
endProcedure tstMapShow
tstMapShowSt: procedure expose m.
parse arg a, st
call tstOut t, 'map stem' st m.st.0
do wx=1 to m.st.0
call tstMapShow a, m.st.wx
end
return
endProcedure tstMapShow
tstJsay: procedure expose m.
call jIni
call jOut 'out eins'
call jOut 'out zwei jIn' jIn(vv) 'vv='vv
vv = 'value'
call jOut 'out drei jIn' jIn(vv) 'vv='vv 'Schluss'
return
endProcedure tstJsay
tstJ: procedure expose m.
call jIni
oldJin = m.j.jIn
oldJOut = m.j.jOut
m.j.jIn = t
m.j.jOut = t
b = jOpen(jBuf(), 'w')
call tst t, "tstJ",
, "out eins",
, "<jIn 1< tst in line 1 eins ,",
, "1 jIn() tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "2 jIn() tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "3 jIn() tst in line 3 drei |",
, "jIn eof 4",
, "jIn() 3 reads vv VV",
, "line buf line one",
, "line buf line two",
, "line buf line three",
, "line buf line four",
, "*** err: jWrite(" || b", buf line four) but not ope",
|| "ned w"
call jOut 'out eins'
do lx=1 by 1 while jIn(var)
call jOut lx 'jIn()' m.var
end
call jOut 'jIn()' (lx-1) 'reads vv' vv
call jWrite b, 'buf line one'
call mAdd m.b.stem, 'buf line two', 'buf line three'
call jWrite b, 'buf line four'
call jOpen b, 'r'
do while (jRead(b, line))
call jOut 'line' m.line
end
call jWrite b, 'buf line four'
call jClose b
call tstEnd t
return
endProcedure tstJ
tstLmdTiming:
parse arg lev
say timing() lev
call lmdBegin abc, lev
c = 0
do while lmdNext(abc, st.)
c = c + st.0
end
call lmdEnd abc
say timing() lev 'with group - without reading' c
call adrIsp 'lmdinit listid(lmdId) level('lev')'
do c=0 while adrIsp('lmdlist listid(&lmdId) dataset(abc)', 8) = 0
end
call adrIsp 'lmdfree listid(&lmdId)'
say timing() lev 'with list' c
return
endProcedure lmdTiming
tstCat: procedure expose m.
call catIni
call tst t, "tstCat",
, "catRead 1 line 1",
, "catRead 2 line 2",
, "catRead 3 line 3",
, "appRead 1 line 1",
, "appRead 2 line 2",
, "appRead 3 line 3",
, "appRead 4 append 4",
, "appRead 5 append 5"
i = cat('£', jBuf('line 1', 'line 2'), '£', jBuf('line 3'))
call jOpen i, 'r'
do lx=1 by 1 while jRead(i, v)
call tstOut t, 'catRead' lx m.v
end
call jOpen i, 'a'
call jWrite i, 'append 4'
call jWrite i, 'append 5'
call jOpen i, 'r'
do lx=1 by 1 while jRead(i, v)
call tstOut t, 'appRead' lx m.v
end
call tstEnd t
return
endProcedure tstCat
tstJ2: procedure expose m.
call jIni
call tst t, "tstJ2",
, "b read EINS feld eins, ZWEI feld zwei, DREI feld drei",
, "b read EINS feld eins, ZWEI feld zwei 2, DREI feld drei",
, "c read EINS feld eins, ZWEI feld zwei, DREI drei cat 1",
, "c read EINS feld eins, ZWEI feld zwei 2, DREI drei cat 2"
ty = oFldNew('Tst*', , , 'EINS = ZWEI = DREI =')
m.qq.eins = 'feld eins'
m.qq.zwei = 'feld zwei'
m.qq.drei = 'feld drei'
b = jBuf()
call oSetTypePara b, ty
call jOpen b, 'w'
call jWrite b, qq
m.qq.zwei = 'feld zwei 2'
call jWrite b, qq
call jOpen b, 'r'
c = jOpen(cat(), 'w')
call oSetTypePara c, ty
do xx=1 while jRead(b, res)
call jOut 'b read EINS' m.res.eins', ZWEI' m.res.zwei,
|| ', DREI' m.res.drei
m.res.drei = 'drei cat' xx
call jWrite c, res
end
call jOpen c, 'r'
do while jRead(c, ccc)
call jOut 'c read EINS' m.ccc.eins', ZWEI' m.ccc.zwei,
|| ', DREI' m.ccc.drei
end
call tstEnd t
return
endProcedure tstJ2
tstCatDsn: procedure expose m.
call catIni
call tst t, "tstCatDsn",
, "write read 0 last 10 vor anfang",
, "write read 1 last 80 links1 1 und rechts | .",
, "write read 2 last 80 liinks2 2 und rechts | .",
, "write read 5 last 80 links5 5 rechts5",
, "write read 99 last 80 links99 99 rechts",
, "write read 100 last 80 links100 100 rechts",
, "write read 101 last 80 links101 101 rechts",
, "write read 999 last 80 links999 999 rechts",
, "write read 1000 last 80 links1000 1000 rechts",
, "write read 1001 last 80 links1001 1001 rechts",
, "write read 2109 last 80 links2109 2109 rechts",
, "out > eins 1 ",
|| " ",
, "out > eins 2 schluss. ",
|| " ",
, "buf eins",
, "buf zwei",
, "buf drei",
, "out > zwei mit einer einzigen Zeile ",
|| " ",
, " links1 1 und rechts | . ",
|| " "
pds = tstDsn('lib', 'r')
call tstCatDsnWr pds, 0, ' links0', ' und rechts | . '
call tstCatDsnWr pds, 1, ' links1', ' und rechts | . '
call tstCatDsnWr pds, 2, 'liinks2', ' und rechts | . '
call tstCatDsnWr pds, 5, 'links5', 'rechts5'
call tstCatDsnWr pds, 99, 'links99', 'rechts'
call tstCatDsnWr pds, 100, 'links100', 'rechts'
call tstCatDsnWr pds, 101, 'links101', 'rechts'
call tstCatDsnWr pds, 999, 'links999', 'rechts'
call tstCatDsnWr pds, 1000, 'links1000', 'rechts'
call tstCatDsnWr pds, 1001, 'links1001', 'rechts'
call tstCatDsnWr pds, 2109, 'links2109', 'rechts'
pd2 = tstDsn('li2', 'r')
call envPush env('>', pd2'(eins) ::F')
call jOut 'out > eins 1'
call jOut 'out > eins 2 schluss.'
call envPop
call envPush env('>', pd2'(zwei) ::F')
call jOut 'out > zwei mit einer einzigen Zeile'
call envPop
b = jBuf("buf eins", "buf zwei", "buf drei")
call envPush env('<+', pd2'(eins) ::F', '+£', b,
,'+£', jBuf(), '+', pd2'(zwei)',
,'+', pds'(WR0)','', pds'(wr1)')
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstCatDsn
tstCatDsnWR: procedure expose m.
parse arg dsn, num, le, ri
io = catDsn(dsn'(wr'num') ::F')
call jOpen io, 'w'
do x = 1 to num
call jWrite io, le x ri
end
if num > 100 then
call catDsnReset io, dsn'(wr'num') ::F'
call jOpen io, 'r'
m.vv = 'vor anfang'
do x = 1 to num
if ^ jRead(io, vv) then
call err x 'not jRead'
else if m.vv <> le x ri then
call err x 'read mismatch' m.vv
end
if jRead(io, vv) then
call err x 'jRead'
if jRead(io, vv) then
call err x'+1 jRead'
call jClose io
call tstOut t, 'write read' num 'last' length(m.vv) strip(m.vv,'t')
return
endProcedure tstCatDsnRW
tstEnv: procedure expose m.
call envIni
c = jBuf()
call tst t, "tstEnv",
, "before envPush",
, "after envPop",
, "*** err: jWrite("c", write nach pop) but not op",
|| "ened w",
, "<jIn 1< tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "jIn eof 4",
, "before readWrite 2 c --> std",
, "before readWrite 1 b --> c",
, "b line eins",
, "b zwei |",
, "nach readWrite 1 b --> c",
, "add nach pop",
, "after push c only",
, "tst in line 1 eins ,",
, "tst in line 2 zwei ; "
call mAdd t'.CMP',
, "tst in line 3 drei |",
, "nach readWrite 2 c --> std",
, "*** err: jWrite("c", ) but not opened w"
call jOut 'before envPush'
b = jBuf("b line eins", "b zwei |")
call envPush env('<£', b, '>£', c)
call jOut 'before readWrite 1 b --> c'
call envReadWrite
call jOut 'nach readWrite 1 b --> c'
call envPop
call jOut 'after envPop'
call jWrite c, 'write nach pop'
call mAdd c'.BUF', 'add nach pop'
call envPush env('>>£', c)
call jOut 'after push c only'
call envReadWrite
call envPop
call envPush env('<£', c)
call jOut 'before readWrite 2 c --> std'
call envReadWrite
call jOut 'nach readWrite 2 c --> std'
call envPop
call jWrite c
call tstEnd t
return
endProcedure tstEnv
tstEnvCat: procedure expose m.
call tst t, "tstEnvCat",
, "c1 contents",
, "c1 line eins |",
, "before readWrite 1 b* --> c*",
, "b1 line eins|",
, "b2 line eins",
, "b2 zwei |",
, "c2 line eins |",
, "after readWrite 1 b* --> c*",
, "c2 contents",
, "c2 line eins |"
b0= jBuf()
b0= jBuf()
b1= jBuf("b1 line eins|")
b2 = jBuf("b2 line eins", "b2 zwei |")
c1 = jBuf("c1 line eins |")
c2 = jBuf("c2 line eins |")
call envPush env('<+£', b0, '<+£', b1, '<+£', b2, '<£', c2,
,'>>£', c1)
call jOut 'before readWrite 1 b* --> c*'
call envReadWrite
call jOut 'after readWrite 1 b* --> c*'
call envPop
call jOut 'c1 contents'
call envPush env('<£', c1)
call envReadWrite
call envPop
call envPush env('<£', c2)
call jOut 'c2 contents'
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstEnv
tstEnvBar: procedure expose m.
call tst t, 'tstEnvBar',
, "+0 vor envBarBegin",
, "<jIn 1< tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "jIn eof 4",
, "+7 nach envBarLast",
, "¢7 +6 nach envBar 7!",
, "¢7 +2 nach envBar 7!",
, "¢7 +4 nach nested envBarLast 7!",
, "¢7 (4 +3 nach nested envBarBegin 4) 7!",
, "¢7 (4 (3 +1 nach envBarBegin 3) 4) 7!",
, "¢7 (4 (3 tst in line 1 eins , 3) 4) 7!",
, "¢7 (4 (3 tst in line 2 zwei ; 3) 4) 7!",
, "¢7 (4 (3 tst in line 3 drei | 3) 4) 7!",
, "¢7 (4 (3 +1 nach readWrite vor envBar 3) 4) 7!",
, "¢7 (4 +3 nach preSuf vor nested envBarLast 4) 7!",
, "¢7 +4 nach preSuf vor nested envBarEnd 7!"
call mAdd t.cmp,
, "¢7 +5 nach nested envBarEnd vor envBar 7!",
, "¢7 +6 nach readWrite vor envBarLast 7!",
, "+7 nach readWrite vor envBarEnd",
, "+8 nach envBarEnd"
call jOut '+0 vor envBarBegin'
call envBarBegin
call jOut '+1 nach envBarBegin'
call envReadWrite
call jOut '+1 nach readWrite vor envBar'
call envBar
call jOut '+2 nach envBar'
call envBarBegin
call jOut '+3 nach nested envBarBegin'
call envPreSuf '(3 ', ' 3)'
call jOut '+3 nach preSuf vor nested envBarLast'
call envBarLast
call jOut '+4 nach nested envBarLast'
call envPreSuf '(4 ', ' 4)'
call jOut '+4 nach preSuf vor nested envBarEnd'
call envBarEnd
call jOut '+5 nach nested envBarEnd vor envBar'
call envBar
call jOut '+6 nach envBar'
say '?? 6 call envReadWrite'
call envReadWrite
say 'jOut +6 nach readWrite vor envBarLast'
call jOut '+6 nach readWrite vor envBarLast'
call envBarLast
call jOut '+7 nach envBarLast'
call envPreSuf '¢7 ', ' 7!'
call jOut '+7 nach readWrite vor envBarEnd'
call envBarEnd
call jOut '+8 nach envBarEnd'
call tstEnd t
return
endProcedure tstEnvBar
tstEnvLazy: procedure expose m.
call tst t, "tstEnvLazy",
, "vor envBarBegin",
, "vor 2 writeAll jIn inIx 0",
, "vor writeAll jBuf",
, "jBuf line 1",
, "jBuf line 2",
, "vor writeAll jIn inIx 0",
, "<jIn 1< tst in line 1 eins ,",
, "tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "tst in line 3 drei |",
, "jIn eof 4",
, "vor barLast inIx 0",
, "vor barEnd inIx 4",
, "nach barEnd"
call jOut 'vor envBarBegin'
call envBarBegin
call jOut 'vor writeAll jBuf'
call jWriteAll m.j.jOut, "£", jBuf('jBuf line 1', 'jBuf line 2')
call jOut 'vor writeAll jIn inIx' m.t.inIx
call jWriteAll m.j.jOut, "£-", m.j.jIn
call jOut 'vor barLast inIx' m.t.inIx
call envBarLast
call jOut 'vor 2 writeAll jIn inIx' m.t.inIx
call jWriteAll m.j.jOut, "£-", m.j.jIn
call jOut 'vor barEnd inIx' m.t.inIx
call envBarEnd
call jOut 'nach barEnd'
call tstEnd t
return
endProcedure tstEnvLazy
tstEnvVars: procedure expose m.
call tst t, "tstEnvVars",
, "put v1 value eins",
, "v1 hasKey 1 get value eins",
, "v2 hasKey 0",
, "via v1.fld via value",
, "one to theBur",
, "two to theBuf"
put1 = envPut('v1', 'value eins')
call tstOut t, 'put v1' put1
call tstOut t, 'v1 hasKey' envHasKey('v1') 'get' envGet('v1')
call tstOut t, 'v2 hasKey' envHasKey('v2')
if 0 then
call tstOut t, 'v2 get' envGet('v2')
m.put1.fld = 'via value'
call tstOut t, 'via v1.fld' envVia('v1*FLD')
call envPush env('>#', 'theBuf')
call jOut 'one to theBur'
call jOut 'two to theBuf'
call envPop
call envPush env('<#', 'theBuf')
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstEnvVars
tstScan: procedure expose m.
call tst t, 'tstScan.1',
, "scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' ",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "scan n tok 3: Und key val ",
, "scan v tok 1: key val ",
, "scan n tok 10: hr123sdfER key val ",
, "scan q tok 5: ""st1"" key val st1",
, "scan v tok 1: key val st1",
, "scan a tok 19: 'str2''mit''apo''s' key val str2'mit'apo's",
, "scan v tok 1: key val str2'mit'apo's"
call tstScan1 ,'l"litEins"l"litZwei"ndv" "aq1' ,
,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call tstEnd t
call tst t, 'tstScan.2',
, "scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' ",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "scan n tok 3: Und key val ",
, "scan b tok 0: key val ",
, "scan n tok 10: hr123sdfER key val ",
, "scan s tok 5: ""st1"" key val st1",
, "scan b tok 0: key val st1",
, "scan s tok 19: 'str2''mit''apo''s' key val str2'mit'apo's",
, "scan b tok 0: key val str2'mit'apo's"
call tstScan1 , 'ndsb1' ,
,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call tstEnd t
call tst t, 'tstScan.3',
, "scan src a034,'wie 789abc",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "*** err: scanErr ending Apostroph(') missing",
, " e 1: last token scanPosition 'wie 789abc",
, " e 2: pos 6 in string a034,'wie 789abc",
, "scan 1 tok 1: ' key val ",
, "scan n tok 3: wie key val ",
, "scan 1 tok 1: key val ",
, "*** err: scanErr illegal number end",
, " e 1: last token 789 scanPosition abc",
, " e 2: pos 14 in string a034,'wie 789abc",
, "scan d tok 3: 789 key val ",
, "scan n tok 3: abc key val "
call tstScan1 , 'nds1' ,
,"a034,'wie 789abc"
call tstEnd t
call tst t, 'jTestScan.4',
, "scan src litEinsefr 23 sdfER'str1'litZwei ""str2""""mit qu",
|| "o""s ",
, "scan l tok 7: litEins key val ",
, "scan n tok 3: efr key val ",
, "scan b tok 0: key val ",
, "scan d tok 2: 23 key val ",
, "scan b tok 0: key val ",
, "scan n tok 5: sdfER key val ",
, "scan a tok 6: 'str1' key val str1",
, "scan l tok 7: litZwei key val str1",
, "scan b tok 0: key val str1",
, "scan q tok 15: ""str2""""mit quo"" key val str2""mit quo",
, "scan n tok 1: s key val str2""mit quo",
, "scan b tok 0: key val str2""mit quo"
call tstScan1 , 'l"litEins"l"litZwei"ndbaq1' ,
,"litEinsefr 23 sdfER'str1'litZwei ""str2""""mit quo""s "
call tstEnd t
call tst t, 'jTestScan.5',
, "scan src aha;+-=f ab=cdEf eF='strIng' ",
, "scan b tok 0: key val ",
, "scan k tok 4: no= key aha val def",
, "scan 1 tok 1: ; key aha val def",
, "scan 1 tok 1: + key aha val def",
, "scan 1 tok 1: - key aha val def",
, "scan 1 tok 1: = key aha val def",
, "scan k tok 4: no= key f val def",
, "scan k tok 4: cdEf key ab val cdEf",
, "scan b tok 4: cdEf key ab val cdEf",
, "scan k tok 8: 'strIng' key eF val strIng",
, "scan b tok 8: 'strIng' key eF val strIng"
call tstScan1 , 'bk1'," aha;+-=f ab=cdEf eF='strIng' "
call tstEnd t
return
endProcedure tstScan
tstScanRead: procedure expose m.
call tst t, 'jTestScanRead',
, "name erste",
, "space",
, "name Zeile",
, "space",
, "nextLine",
, "nextLine",
, "space",
, "name dritte",
, "space",
, "name Zeile",
, "space",
, "name schluss",
, "space"
b = jBuf('erste Zeile ',,' dritte Zeile schluss ')
s = scanRead(b)
do while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanVerify(s, ' ') then call tstOut t, 'space'
else if scanReadNL(s) then call tstOut t, 'nextLine'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanRead mit spaceLn',
, "name erste",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name dritte",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name schluss",
, "spaceLn"
s = scanRead(b)
do forever
if scanName(s) then call jOut 'name' m.s.tok
else if scanSpaceNL(s) then call jOut 'spaceLn'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
else leave
end
call tstEnd t
return
endProcedure tstScanRead
tstScanWin: procedure expose m.
call scanWinIni
call tst t, 'jTestScanWin',
, "info 0: last token scanPosition erste Zeile ",
|| " dritteZe\npos 1 in line 1: erste Zeile",
, "name erste",
, "spaceNL",
, "name Zeile",
, "spaceNL",
, "name dritteZeeeile",
, "info 5: last token dritteZeeeile scanPosition zeile4 ",
|| " fuenfueberSechs\npos 1 in line 4: zeile4",
, "spaceNL",
, "name zeile4",
, "spaceNL",
, "name fuenfueberSechsUnddSiebenUNDundUndUAcht",
, "spaceNL",
, "info 10: last token scanPosition undZehnueberElfundNochWe",
|| "iterZwoelfundim1\npos 9 in line 10: undZehn",
, "name undZehnueberElfundNochWeiterZwoelfundim13",
, "spaceNL",
, "name Punkt",
, "infoE 14: last token Punkt scanPosition \natEnd after line",
|| " 13: im13 Punkt"
b = jBuf('?erste Zeile?',,'? dritteZeeeile?', '? zeile4 ',
,'? fuenf?', '?ueberSechsUnddS?', '?iebenUNDundUndU?',
,'?Acht ?', '? ?', '? undZehn?',
,'?ueberElfundNoch?', '?WeiterZwoelfund?', '?im13 Punkt?')
s = scanWin(b, , , 2, 15)
call tstOut t, 'info 0:' scanInfo(s)
do sx=1 while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
if sx // 5 = 0 then
call tstOut t, 'info' sx':' scanInfo(s)
end
call tstOut t, 'infoE' sx':' scanInfo(s)
call tstEnd t
call tst t, 'jTestScanRead',
, "info 0: last token scanPosition erste Zeile ",
|| " z3 com Ze\npos 1 in line 1: erste Zeile",
, "name erste",
, "spaceNL",
, "name Zeile",
, "spaceNL",
, "name z3",
, "info 5: last token z3 scanPosition com Zeeeile z4 come4 ",
|| " fuenf\npos 4 in line 3: z3 com Zeeeile",
, "spaceNL",
, "name z4",
, "spaceNL",
, "name fuenf",
, "spaceNL",
, "info 10: last token scanPosition com Sechs com siebe",
|| "n comAcht com\npos 15 in line 5: fuenf c",
, "name com",
, "spaceNL"
call mAdd t.cmp,
, "name Sechs",
, "spaceNL",
, "name com",
, "info 15: last token com scanPosition sieben comAcht c",
|| "om com com\npos 2 in line 7: m sieben com" ,
, "spaceNL",
, "name sieben",
, "spaceNL",
, "name Acht",
, "spaceNL",
, "info 20: last token scanPosition ueberElfundNochWeit com ",
|| "elfundim13\npos 1 in line 11: ueberElfundNoch",
, "name ueberElfundNochWeit",
, "spaceNL",
, "name im13",
, "spaceNL",
, "name Punkt",
, "info 25: last token Punkt scanPosition \natEnd after line ",
|| "13: im13 Punkt",
, "infoE 26: last token Punkt scanPosition \natEnd after line",
|| " 13: im13 Punkt"
b = jBuf('?erste Zeile?',,'? z3 com Zeeeile?', '? z4 come4 ',
,'? fuenf c?', '?om Sechs co?', '?m sieben com?',
,'?Acht com com ?', '? com ?', '? com undZehn?',
,'?ueberElfundNoch?', '?Weit com elfund?', '?im13 Punkt?')
s = scanWin(b, , , 2, 15)
call scanOpts s, , , 'com'
call tstOut t, 'info 0:' scanInfo(s)
do sx=1 while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
if sx // 5 = 0 then
call tstOut t, 'info' sx':' scanInfo(s)
end
call tstOut t, 'infoE' sx':' scanInfo(s)
call tstEnd t
return
endProcedure tstScanWin
tstScanSql: procedure expose m.
call scanWinIni
call tst t, 'jTestScanSql id',
, "sqlId ABC",
, "spaceNL",
, "sqlId AB__345EF",
, "spaceNL"
b = jBuf('abc -- kommentar', right('ab_', 72), '_345ef-- kom')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlID(s) then call tstOut t, 'sqlId' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql delimited',
, "sqlDeId ABC",
, "spaceNL",
, "sqlDeId AB_3F",
, "spaceNL",
, "sqlDeId abc",
, "spaceNL",
, "sqlDeId ab_Ef",
, "spaceNL"
b = jBuf('abc -- kommentar',,' -- ',,right('ab_', 72),'3F-- kom',
, '"abc" -- ko', ' -- ',,right('"ab_', 72),'Ef"-- kom')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlDeID(s) then call tstOut t, 'sqlDeId' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql qualified',
, "sqlQuId ABC 1 ABC",
, "sqlQuId AB_3F 1 AB_3F",
, "sqlQuId abc 1 abc",
, "sqlQuId ab_Ef 1 ab_Ef",
, "sqlQuId EINS.Zwei.DREI 3 EINS",
, "sqlQuId vi er.fu enf 2 vi er"
b = jBuf('abc -- kommentar',,' -- ',,right('ab_', 72),'3F-- kom',
, '"abc" -- ko', ' -- ',right('"ab_', 72),'Ef"-- kom',
, 'eins."Zwei', '" -- com', ' . -- com', ' -- com',
, 'drei -- ko', '"vi er"."fu enf " -- co')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlQuID(s) then
call tstOut t, 'sqlQuId' m.s.val m.s.val.0 m.s.val.1
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql Num',
, "sqlNum 1",
, "spaceNL",
, "sqlNum 2",
, "spaceNL",
, "sqlNum .3",
, "spaceNL",
, "sqlNum 4.5",
, "spaceNL",
, "sqlNum +6",
, "spaceNL",
, "sqlNum +7.03",
, "spaceNL",
, "sqlNum -8",
, "spaceNL",
, "sqlNum -.9",
, "spaceNL"
call mAdd t.cmp,
, "sqlNum 1E2",
, "spaceNL",
, "sqlNum -2E-2",
, "spaceNL",
, "sqlNum +.3E+3",
, "spaceNL"
b = jBuf('1 2. .3 4.5 +6 + --kom', , ' -- com ', , ' 7.03 -8 - .9',
'1e2 - 2.e-2 + .3e+3')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlNum(s) then
call tstOut t, 'sqlNum' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql Num Unit',
, "sqlNumUnit 1 KB",
, "spaceNL",
, "sqlNumUnit .3 MB",
, "sqlNumUnit .5",
, "sqlNumUnit +6E-5 B",
, "spaceNL",
, "sqlNumUnit -7",
, "char *",
, "spaceNL",
, "sqlNumUnit -.8",
, "char T",
, "char B",
, "spaceNL",
, "*** err: scanErr scanSqlNumUnit after +9 bad unit TB",
, " e 1: last token Tb scanPosition ",
, " e 2: pos 41 in line 1: 1 kb .3mB.5 + 6.e-5B -7* -.8 ",
|| "TB + 9.Tb",
, "sqlNumUnit +9",
, "spaceNL"
b = jBuf('1 kb .3mB.5 + 6.e-5B -7* -.8 TB + 9.Tb')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlNumUnit(s, 0, 'B KB MB') then
call tstOut t, 'sqlNumUnit' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if scanChar(s ,1) then call tstOut t, 'char' m.s.tok
else call scanErr s, 'cannot scan'
end
call tstEnd t
return
call tst t, 'jTestScanRead',
, "info 0: last token scanPosition erste Zeile ",
|| " z3 com Ze\npos 1 in line 1: erste Zeile",
, "name erste",
, "spaceNL",
, "name Zeile",
, "spaceNL",
, "name z3",
, "info 5: last token z3 scanPosition com Zeeeile z4 come4 ",
|| " fuenf\npos 4 in line 3: z3 com Zeeeile",
, "spaceNL",
, "name z4",
, "spaceNL",
, "name fuenf",
, "spaceNL",
, "info 10: last token scanPosition com Sechs com siebe",
|| "n comAcht com\npos 15 in line 5: fuenf c",
, "name com",
, "spaceNL"
call mAdd t.cmp,
, "name Sechs",
, "spaceNL",
, "name com",
, "info 15: last token com scanPosition sieben comAcht c",
|| "om com com\npos 2 in line 7: m sieben com" ,
, "spaceNL",
, "name sieben",
, "spaceNL",
, "name Acht",
, "spaceNL",
, "info 20: last token scanPosition ueberElfundNochWeit com ",
|| "elfundim13\npos 1 in line 11: ueberElfundNoch",
, "name ueberElfundNochWeit",
, "spaceNL",
, "name im13",
, "spaceNL",
, "name Punkt",
, "info 25: last token Punkt scanPosition \natEnd after line ",
|| "13: im13 Punkt",
, "infoE 26: last token Punkt scanPosition \natEnd after line",
|| " 13: im13 Punkt"
b = jBuf('?erste Zeile?',,'? z3 com Zeeeile?', '? z4 come4 ',
,'? fuenf c?', '?om Sechs co?', '?m sieben com?',
,'?Acht com com ?', '? com ?', '? com undZehn?',
,'?ueberElfundNoch?', '?Weit com elfund?', '?im13 Punkt?')
s = scanWin(b, , ,'com', , , 2, 15)
call tstOut t, 'info 0:' scanInfo(s)
do sx=1 while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
if sx // 5 = 0 then
call tstOut t, 'info' sx':' scanInfo(s)
end
call tstOut t, 'infoE' sx':' scanInfo(s)
call tstEnd t
return
call tst t, 'jTestScanRead mit spaceLn',
, "name erste",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name dritte",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name schluss",
, "spaceLn"
s = scanRead(b)
do forever
if scanName(s) then call jOut 'name' m.s.tok
else if scanSpaceNL(s) then call jOut 'spaceLn'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
else leave
end
call tstEnd t
return
endProcedure tstScanSql
/*--- one single test scan with lines to scan in stem ln -------------*/
tstScan1:
parse arg sc, types, ln
if sc == '' then do
call tstOut t, 'scan src' ln
call scanSrc scanReset(s), ln
end
else do
call tstOut t, 'scan scanner' sc
s = sc
end
do forever
x = tstScanType(s, types)
if x == '' then
leave
call tstOut t, 'scan' x 'tok' length(m.s.tok)':' m.s.tok ,
'key' m.s.key 'val' m.s.val
end
return
endProcedure tstScan1
tstScanType: procedure expose m.
parse arg s, opt
cx = 1
a2 = ''
do while cx <= length(opt)
f = substr(opt, cx, 1)
cx = cx + 1
if pos(substr(opt, cx, 1), "'""") > 0 then do
m.scan.type.src = opt
m.scan.type.pos = cx
call scanString 'SCAN.TYPE'
a2 = m.scan.type.val
cx = m.scan.type.pos
end
if f == 'a' then
res = scanString(s, "'")
else if f == 'b' then
res = scanSpaceNl(s)
else if f == 'c' then
res = scanChar(s, a2)
else if f == 'd' then
res = scanNat(s, a2)
else if f == 'k' then
res = scanKeyValue(s, 'def')
else if f == 'l' then
res = scanLit(s, a2)
else if f == 'n' then
res = scanName(s)
else if f == 'q' then
res = scanString(s, '"')
else if f == 's' then
res = scanString(s)
else if f == 'v' then
res = scanVerify(s, a2)
else if f == 'w' then
res = scanWord(s)
else if f == 'y' then
res = scanVerify(s, a2, 'm')
else if pos(f, '123456789') > 0 then
res = scanChar(s, f)
else
call err 'bad scanType' f
if res then
return f
end
return ''
endProcedure tstScanType
tstO: procedure expose m.
cR = oNewClass('R')
iR = 'O.C'm.o.cla.cR'I'
oo = 'call tstOut' t','
call oDecMethods cR, "print" oo "'Rprint' m a1",
, "say" oo "'Rsay ' m a2; return"
cS = oNewClass('S', "R")
is = 'O.C'm.o.cla.cS'I'
call oDecMethods cS, "print" oo "'Sprint' m a1; return",
, "quak" oo "'Squak ' m a3; return 'quak'a3"
call tst t, 'tstO',
, "class R with 2 methods",
, " print call tstOut T, 'Rprint' m a1",
, " say call tstOut T, 'Rsay ' m a2; return",
, "class S with 3 methods",
, " print call tstOut T, 'Sprint' m a1; return",
, " say call tstOut T, 'Rsay ' m a2; return",
, " quak call tstOut T, 'Squak ' m a3; return 'quak'a3",
, "oR.print call tstOut T, 'Rprint' m a1",
, "oS.print call tstOut T, 'Sprint' m a1; return",
, "oS.say call tstOut T, 'Rsay ' m a2; return",
, "Rsay "iR"1 arg oR say",
, "Rprint "iR"1 arg oR print",
, "Rsay "iS"1 arg oS say"
call mAdd t.cmp ,
, "Sprint "iS"1 arg oS print",
, "Squak "iS"1 arg oS quak",
, "quak: quakarg oS quak",
, "Rprint "iS"1 cast(os, R)",
, "Sprint "iS"1 cast(os, R), S)",
, "mutate oS R "iS"1",
, "Rprint "iS"1 mutate R",
, "oRun 7*3 21",
, "oRun 12*12 144"
cc = 'R S'
do cx=1 to words(cc)
cl = word(cc, cx)
call tstOut t, 'class' cl 'with' m.o.cla.cl.met.0 'methods'
do mx=1 to m.o.cla.cl.met.0
me = m.o.cla.cl.met.mx
call tstOut t, ' ' me m.o.cla.cl.met.me
end
end
oR = oNew(cR)
oS = oNew(cS)
call tstOut t, 'oR.print' oObjMethod(oR, 'print')
call tstOut t, 'oS.print' oObjMethod(oS, 'print')
call tstOut t, 'oS.say' oObjMethod(oS, 'say')
call tstClassRsay oR, 'arg oR say'
call tstClassRprint oR, 'arg oR print'
call tstClassRsay oS, 'arg oS say'
call tstClassRprint oS, 'arg oS print'
call tstOut t, 'quak:' tstClassSquak(oS, 'arg oS quak')
q1 = oCast(oS, 'R')
call tstClassRprint q1, 'cast(os, R)'
q2 = oCast(q1, 'S')
call tstClassRprint q2, 'cast(os, R), S)'
call tstOut t, 'mutate oS R' oMutate(oS, 'R')
call tstClassRprint oS, 'mutate R'
rr = oRunner('return 7 * 3')
call tstOut t, 'oRun 7*3' oRun(rr)
call oRunnerReset rr, 'return 12 * 12'
call tstOut t, 'oRun 12*12' oRun(rr)
call tstEnd t
return
endProcedure tstO
tstOType: procedure
call oIni
si = 'Simple'
call oFldNew 'T1', '=', '=', 'A = B ='
m.x.0 = 3
call oSay 'T1', x
call oSay 'Class', 'O.CLA.='
call oSay 'Class', 'O.CLA.Class'
call oClear 'Class', abc, 'abc'
call oSay 'Class', abc
call oTyCopy 'Class', abc, 'O.CLA.Class'
call oSay 'Class', abc
call oCopy efg, 'O.CLA.Class'
call oSay 'Class', efg
ff = oFlds('Class')
x = m.ff.0
say 'fields' x':' m.ff.1 m.ff.2 '...' m.ff.x
return
endProcedure tstOType
tstClassRprint: procedure expose m.
parse arg m, a1
interpret oObjMethod(m, 'print')
return
endProcedure tstClassRprint
tstClassRsay: procedure expose m.
parse arg m, a2
interpret oObjMethod(m, 'say')
endProcedure tstClassRsay
tstClassSquak: procedure expose m.
parse arg m, a3
interpret oObjMethod(m, 'quak')
endProcedure tstClassSquak
/* copx tstBase end *************************************************/
/* copx tst begin ****************************************************
test infrastructure
***********************************************************************/
/*--- return stems ---------------------------------------------------*/
/*--- make writerDescriptor m a testWriter
--- and use remaining lines as compare values -----------------*/
tst: procedure expose m.
parse arg m, nm
if m.tst.ini <> 1 then
call tstIni
m.m.name = nm
m.tst.act = m
m.tst.tests = m.tst.tests+1
call oMutate m, 'Tst'
m.m.jReading = 1
m.m.jWriting = 1
ox = 1
m.m.cmp.ox = left('****** start tst' nm '', 79, '*')
do ax=3 to arg()
ox = ox + 1
m.m.cmp.ox = arg(ax)
end
m.m.cmp.0 = ox
m.m.in.0 = 0
m.m.inIx = 0
m.m.out.0 = 0
m.m.err = 0
call mAdd m'.IN', 'tst in line 1 eins ,' ,
, 'tst in line 2 zwei ; ' ,
, 'tst in line 3 drei |'
call oMutate m, 'Tst'
if m.env.0 <> 1 then
call tstErr m, 'm.env.0' m.env.0 '<> 1'
call envPush env( '<-£', m, '>-£', m)
call tstOut m, m.m.cmp.1
return 'TST.'m
endProcedure tst
tstEnd: procedure expose m.
parse arg m, opt
m.tst.act = ''
call envPop
if m.env.0 <> 1 then
call tstErr m, 'm.env.0' m.env.0 '<> 1'
if m.m.out.0 ^= m.m.cmp.0 then do
call tstErr m, 'old' m.m.cmp.0 'lines ^= new' m.m.out.0
do nx = m.m.out.0 + 1 to min(m.m.out.0+10, m.m.cmp.0)
say 'old - ' m.m.cmp.nx
end
end
if m.m.err > 0 then do
say 'new lines:' (m.m.out.0 - 1)
len = 60
do nx=2 to m.m.out.0
str = quote(m.m.out.nx, '"')
pr = ' , '
do while length(str) > len
l=len
if substr(str, l-1, 1) = '"' then
if posCount('"', left(str, l-1)) // 2 = 0 then
l = l-1
say pr left(str, l-1)'",'
str = '"'substr(str, l)
pr = ' ||'
end
say pr str || left(',', nx < m.m.out.0)
end
end
say left('******' m.m.name 'end with' m.m.err 'errors ', 79,
, '*')
return
endProcedure tstEnd
/*--- write to test: say lines and compare them ----------------------*/
tstWrite: procedure expose m.
parse arg m, arg
call tstOut m, 'jOut:' arg
return
endProcedure tstWrite
tstOut: procedure expose m.
parse arg m, arg
call mAdd m'.OUT', arg
nx = m.m.out.0
if nx > m.m.cmp.0 then do
if nx = m.m.cmp.0+1 then
call tstErr m, 'more new Lines' nx
end
else if m.m.cmp.nx ^== arg then do
call tstErr m, 'next line old' nx '^^^ new overnext'
say m.m.cmp.nx
end
say arg
return
endProcedure tstOut
tstRead: procedure expose m.
parse arg m, arg
ix = m.m.inIx + 1
m.m.inIx = ix
if ix <= m.m.in.0 then do
m.arg = m.m.in.ix
call tstOut m, '<jIn' ix'<' m.arg
return 1
end
call tstOut m, 'jIn eof' ix
return 0
endProcedure tstRead
tstDsn: procedure
parse arg suf, opt
dsn = dsn2jcl('~tmp.tst.'suf)
if opt = 'r' & sysDsn("'"dsn"'") ^== 'DATASET NOT FOUND' then
call adrTso "delete '"dsn"'"
return dsn
endProcedure tstDsn
/*--- say total errors and fail if not zero --------------------------*/
tstTotal: procedure expose m.
say '******'
say '******'
say '******' m.tst.tests 'tests with' ,
m.tst.err 'errors in' m.tst.errNames
say '******'
say '******'
if m.tst.err ^== 0 then
call err m.tst.err 'errors total'
return
endProcedure tstTotal
/*--- test err: message, count it and continue -----------------------*/
tstErr: procedure expose m.
parse arg m, msg
say '*** error' msg
m.m.err = m.m.err + 1
m.tst.err = m.tst.err + 1
nm = m.m.name
if wordPos(nm, m.tst.errNames) < 1 then
m.tst.errNames = m.tst.errNames nm
return
endProcedure tstErr
/*--- tstErrHandler: intercept errors --------------------------------*/
tstErrHandler: procedure expose m.
parse arg ggTxt
if m.tst.act == '' then
call err ggTxt, '*'
call errSay ggTxt, tstErrHandler
call tstOut m.tst.act, '*** err:' m.tstErrHandler.1
do x=2 to m.tstErrHandler.0
call tstOut m.tst.act, ' e' (x-1)':' m.tstErrHandler.x
end
return 12
endSubroutine tstErrHandler
/*--- tstIni: global initialization ----------------------------------*/
tstIni: procedure expose m.
if m.tst.ini == 1 then
return
m.tst.ini = 1
call envIni
m.tst.err = 0
m.tst.errNames = ''
m.tst.tests = 0
m.tst.act = ''
call oDecMethods oNewClass("Tst", 'JRW'),
, "jRead return tstRead(m, var)",
, "jWrite call tstOut m, line"
call errReset 'h', 'return tstErrHandler(ggTxt)'
return
endProcedure tstIni
/*--- return the count of occurrences of needle in heyStack ----------*/
posCount: procedure
parse arg needle, hayStack, start, fin
if start = '' then
start = 1
if fin = '' then
fin = length(hayStack) + 1 - length(needle)
do cnt = 0 by 1
start = pos(needle, haystack, start)
if start < 1 | start > fin then
return cnt
start = start + length(needle)
end
endProcedure posCount
/* copx tst end **************************************************/
/* copy tstAll end **************************************************/
}¢--- A540769.WK.REXX.O08(TT) cre=2008-04-29 mod=2008-04-29-13.25.19 F540769 ---
/*********************************************************************/
/* */
/* INITIALIZE WORK VARIABLES */
/* */
/*********************************************************************/
RESUME = 'Y' /* SET RESUME FLAG */
CSIDSN.0 = 0 /* A COUNT OF DSNAMES FILLED */
/*********************************************************************/
/* */
/* SET UP LOOP FOR RESUME (IF A RESUME IS NECESSARY) */
/* */
/*********************************************************************/
DO WHILE RESUME = 'Y' /* UNTIL EOF OF CATALOG READ */
ADDRESS LINKPGM 'IGGCSI00 m.'m'.reason m.'m'.filt m.'m'.work'
/* GET RESUME FLAG FOR NEXT LOOP */
RESUME = SUBSTR(m.m.filt,150,1)
USEDLEN = C2D(SUBSTR(m.m.work,9,4)) /* GET AMOUNT OF WORK AREA USED */
POS1=15 /* STARTING POSITION */
/********************************************************************/
/* */
/* PROCESS DATA RETURNED IN WORK AREA */
/* */
/********************************************************************/
DO WHILE POS1 < USEDLEN /* UNTIL ALL DATA IS PROCESSED */
IF SUBSTR(m.m.work,POS1+1,1) = '0' THEN /* IF ITS THE CATALOG */
DO
POS1 = POS1 + 50 /* SKIP TO THE END OF IT */
END
ELSE DO /* IF NOT CATALOG */
IF SUBSTR(m.m.work,POS1+1,1) = 'A' THEN /* ONLY PROCESS NVSAM */
DO
CSIDSN.0 = CSIDSN.0 + 1 /* COUNT DSNAMES FILLED */
DSN = SUBSTR(m.m.work,POS1+2,44) /* GET THE DSNAME */
if dsn <> dsnMask then
call err 'dsn' dsn '<> dsnMask' dsnMask
pL = POS1 + 50
L1 = c2d(SUBSTR(m.m.work,PL, 2))
L2 = c2d(SUBSTR(m.m.work,PL+2, 2))
L3 = c2d(SUBSTR(m.m.work,PL+4, 2))
dt = substr(m.m.work, pL+6, l1)
vo = substr(m.m.work, pL+6+l1, l2)
cl = substr(m.m.work, pL+6+l1+l2, l3)
cl = substr(cl, 3, c2d(left(cl, 2)))
if vo = '' then
say err '||| no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl <> '' then
res = cl
else if abbrev(vo, 'SHR') then
res = 'SHR'
else
res = 'tape'
if abbrev(res, 'ar') ^= abbrev(dt, '00'x) ,
| abbrev(res, 'ta') ^= abbrev(c2x(left(dt, 1)), '7') ,
| (left(res, 1) >= 'A') ^= abbrev(dt, '30'x) then
say '||| mismatch cl' cl 'vo' vo 'dt' c2x(dt) 'dsn' dsn
return res
END
POS1 = POS1 + 46 /* SKIP TO RECORD END */
POS1 = POS1 + C2D(SUBSTR(m.m.work,POS1,2)) /* ADD CSITOTLN */
END
END
END
RETURN 'notFound' /* RETURN TO INVOKER */
/* copy csi begin ***************************************************
csi interface: see dfs managing catalogs appendix c
returncode/reason see message IDC3009I
**********************************************************************/
csiOpen: procedure expose m.
parse arg m, dsnMask, fields
/*_==================================================================*/
/********************************************************************
dsnMask:
% 1 character
* 0 - n character in one level
** 0 - n levels
********************************************************************/
m.m.fld.0 = words(fields)
ffix = d2c(m.m.fld.0, 2)
do x=1 to m.m.fld.0
m.m.fld.x = translate(word(fields, x))
ffix = ffix || left(m.m.fld.x, 8)
end
m.m.filt = left(dsnMask, 149) ,
|| left('Y', 3) , /* resume offset 149 */
|| ffix /* csiNumEn offset 152 */
WORKLEN = 1024
m.m.work = D2C(WORKLEN,4) || COPIES('00'X,WORKLEN-4)
m.m.pos = workLen + 1
return
endProcedure csiOpen
csiNext: procedure expose m.
parse arg m, o
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET AMOUNT OF WORK AREA USED */
ee = C2D(SUBSTR(m.m.work,9,4)) ???
px = m.m.pos
do forever
if px > usedL then do
if substr(m.m.filt, 150, 1) ^== 'Y' then do
m.m.pos = px
m.o.dsn = ''
return 0
end
reason = left('', 4)
ADDRESS LINKPGM 'IGGCSI00 reason m.'m'.filt m.'m'.work'
if rc == 0 & substr(reason, 3, 2) == '0000'x then
nop
else if rc == 4 & substr(reason, 3, 2) == '0464'x then
say 'data set entry with error'
else
call err 'call csi returns' rc,
'rc' c2d(substr(reason, 4,1)),
'reason' c2d(substr(reason, 3,1)),
'module' substr(reason, 1,2)
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET WORK AREA USED */
numFD = C2D(SUBSTR(m.m.work,13,2)) /* no flds + 1 */
if numFd <> m.m.fld.0 + 1 then
call err 'csiNumFd' numFd 'not' m.m.fld.0 '+' 1
px = 15
iterate
end
eType = substr(m.m.work, px+1, 1)
m.o.dsn = substr(m.m.work, px+2, 44)
flag = substr(m.m.work, px, 1)
/* say 'eType' eType m.o.dsn 'flag' c2x(flag) */
if eType == '0' then do
if flag ^== '00'x & flag ^== '40'x then
call err 'flag' c2x(flag) 'for catalog' m.o.dsn
px = px + 50 /* length of catalog entry */
iterate
end
else do
if ^ abbrev(x2b(c2x(flag)), '101') then
call err 'call csi entry flag' x2b(c2x(flag)),
'rc' c2d(substr(m.m.work, px+49,1)),
'reason' c2d(substr(m.m.work, px+48,1)),
'module' substr(m.m.work, px+46, 2),
'for entry' m.o.dsn,
'see qw IDC3009I'
py = px + 46
tl = c2d(substr(m.m.work, py, 2))
pl = py + 4
pf = py + m.m.fld.0 * 2 + 4
do fx = 1 to m.m.fld.0
fi = m.m.fld.fx
fl = c2d(substr(m.m.work, pl, 2))
m.o.fi = substr(m.m.work, pf, fl)
if fi = 'MGMTCLAS' then
m.o.fi = substr(m.o.fi, 3, c2d(left(m.o.fi ,2)))
else if wordPos(fi, 'COMUDSIZ NOBYTTRK') > 0 then
m.o.fi = c2d(m.o.fi)
pf = pf + fl
pl = pl + 2
end
if py + tl <> pf then
call err 'length mismatch for entry' m.o.dsn
m.m.pos = pf
return 1
end
end
endProcedure csiNext
csiArcTape: procedure expose m.
parse arg vo, cl, dt, dsn
if vo = '' then
say err '||| no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl <> '' then
res = cl
else if abbrev(vo, 'SHR') then
res = 'SHR'
else
res = 'tape'
if res = 'arcive' then
return res
/*if abbrev(res, 'ar') ^= abbrev(dt, '00'x) , */
if abbrev(res, 'ta') ^= abbrev(c2x(left(dt, 1)), '7') ,
| (left(res, 1) >= 'A') ^= abbrev(dt, '30'x) then
say '||| mismatch cl' cl 'vo' vo 'dt' c2x(dt) 'dsn' dsn
return res
endProcedure csiArcTape
/* copy csi end ******************************************************/
}¢--- A540769.WK.REXX.O08(TTJ) cre=2007-04-05 mod=2007-04-05-16.12.21 F540769 ---
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jNew: procedure expose m.
return 'J.'mIncD(j.0)
endProcedure jNew
jFree: procedure expose m.
parse arg m
return
endProcedure jFree
jRead: procedure expose m.
parse arg m, arg
res = '?'
interpret m.m.jRead
return res
endProcedure jRead
jWrite: procedure expose m.
parse arg m, arg
interpret m.m.jWrite
return
endProcedure jWrite
jReset: procedure expose m.
parse arg m, arg
interpret 'call' m.m.jPref'Reset m, arg'
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret 'call' m.m.jPref'Open m, arg'
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
interpret 'call' m.m.jPref'Close m'
m.m.jRead = 'call err "read('m') when closed"'
m.m.jWrite = 'call err "write('m') when closed"'
return m
endProcedure jClose
jDefine: procedure expose m.
parse arg m, m.m.jPref
m.m.jRead = 'call err "read('m') when closed"'
m.m.jWrite = 'call err "write('m') when closed"'
return m
endProcedure jDefine
jDefRead: procedure expose m.
parse arg m, m.m.jRead
m.m.jWrite = 'call err "write('m') when reading"'
return m
endProcedure jDeRead
jDefWrite: procedure expose m.
parse arg m, m.m.jWrite
m.m.jRead = 'call err "read('m') when writing"'
return m
endProcedure jDeWrite
jOpts: procedure
parse arg src, alone, val
if left(src, 1) ^== '-' then
return ''
opt = substr(src, 2)
vv = ''
if val ^== '' then do
vx = verify(src, opt, 'm')
if vx ^= 0 then do
vv = substr(opt, vx+1)
opt = left(opt, vx)
end
end
if alone ^== '' then do
if verify(left(opt, length(opt)-1), alone) > 0 then
call err 'bad opt "'src'" should be "'alone'"' ,
'or "'valid'" with value'
end
return strip(opt vv)
endProcedure jOpts
jPush: procedure expose m.
parse arg i, o
sx = m.j.jStack.0 + 1
m.j.jStack.0 = sx
if i == '' then
i = m.j.jIn
else if i ^== m.j.jIn then
call jOpen i, 'r'
if o == '' then
o = m.j.jOut
else if o ^== m.j.jOut then
call jOpen o, 'w'
m.j.jIn.sx = i
m.j.jIn = i
m.j.jOut.sx = o
m.j.jOut = o
return
endProcedure jPush
jPop: procedure expose m.
sx = m.j.jStack.0 - 1
m.j.jStack.0 = sx
if sx < 1 then
call err 'jPop on empty stack' sx
if m.j.jIn ^== m.j.jIn.sx then
call jClose m.j.jIn
if m.j.jOut ^== m.j.jOut.sx then
call jClose m.j.jOut
m.j.jIn = m.j.jIn.sx
m.j.jOut = m.j.jOut.sx
return
endProcedure jPop
jReadWrite: procedure expose m.
parse arg i, o
if i == '' then
i = m.j.jIn
if o == '' then
o = m.j.jOut
do while (jRead(i, line))
call jWrite o, m.line
end
return
endProcedure jReadWrite
jInit: procedure expose m.
if symbol('m.j.0') == 'VAR' | symbol('m.j.jStack.0')=='VAR' then do
say 'jInit but alread initialised'
end
else do
m.j.0 = 0
end
m.j.jStack.0 = 1
m.j.jIn = jNew()
m.j.jIn.1 = m.j.jIn
m.j.jOut = jNew()
m.j.jOut.1 = m.j.jOut
call jDefine m.j.jIn, "jStdIOError "
call jDefRead m.j.jIn, "res = 0"
call jDefine m.j.jOut, "jStdIOError "
call jDefWrite m.j.jOut, "say 'jOut'" arg
return
endProcedure jInit
jStdIOError: procedure expose m.
parse arg fun m, arg
call err 'do not j'fun'('m',' arg') base stdIn/stdOut'
return
endSubroutine
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
jBuf: procedure expose m.
parse arg m
call jDefine m, "jBuf"
do ax=1 to arg() - 1
m.m.jBuf.ax = arg(ax+1)
end
m.m.jBuf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
do ax=1 to arg() - 1
m.m.jBuf.ax = arg(ax+1)
end
m.m.jBuf.0 = ax-1
return m
endProcedure jBuf
jBufOpen: procedure expose m.
parse arg m, opt
if opt == 'r' then do
call jDefRead m, "res = jBufRead(m , arg)"
m.m.jBufIx = 0
return m
end
if opt == 'w' then
m.m.jBuf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
call jDefWrite m, "call mAdd m'.'jBuf, arg"
return m
endProcedure jBufOpen
jBufClose:
return arg(1)
endProcedure jBufOpen
jBufStem: procedure expose m.
parse arg m
return m'.JBUF'
endProcedure jBufStem
jBufRead: procedure expose m.
parse arg m, var
ix = m.m.jBufIx + 1
if ix > m.m.jBuf.0 then
return 0
m.m.jBufIx = ix
m.var = m.m.jBuf.ix
return 1
endProcedure jBufRead
/* copy j end *********************************************************/
}¢--- A540769.WK.REXX.O08(TTT) cre=2007-03-02 mod=2007-11-23-14.12.33 F540769 ---
parse arg dsn
call lmmtest dsn
exit
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn2Jcl(dsn, 1))
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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 -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
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 ds = '' then
ds = dsn2jcl(w)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', ds) > 0) then
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 ****************************************************/
}¢--- A540769.WK.REXX.O08(TYPE) cre=2007-05-16 mod=2007-11-14-14.24.05 F540769 ---
call typeTest
exit
/* copy type begin ****************************************************/
typeGet:
parse arg name
return mapGet(type, name)
endProcedure typeGet
typeNew: procedure expose m.
parse arg name, val, stem, flds, types
call typeIni
if pos(left(name, 1), '0123456789') > 0 | ^datatype(name, 'a') then
call err 'bad type name' name
ty = mapAdd(type, name)
call mapPut type, name, ty
m.ty.ass = '='
return typeAtts(ty, val, stem, flds, types)
endProcedure typeNew
typeAtts: procedure expose m.
parse arg ty, val, st, flds, types
m.ty.value = firstNS(val, m.typeSimple)
if m.ty.value ^== m.typeSimple & left(m.ty.value, 1) ^= '*' then
call err 'value type must be a reference not' val
m.ty.stem = st
m.ty.0 = words(flds)
do y=1 to m.ty.0
m.ty.y = word(flds, y)
m.ty.y.cont = firstNS(word(types, y), m.typeSimple)
end
return ty
endProcedure typeAtts
firstNS: procedure
do ax=1 to arg()
if arg(ax) ^= '' then
return arg(ax)
end
call err 'all space'
endProcedure firstNS
typeShow: procedure expose m.
parse arg ty, a, lv
if lv='' then
lv = 0
pr = a
if lv > 0 & lastPos('.', pr) > 0 then
pr = left('', lv*2)substr(pr, lastPos('.', pr))
do while left(ty, 1) = '*'
say pr '-->' m.a '(to' ty')'
return
end
if m.ty.value = m.typeSimple then
say pr '=' m.a
else
say pr '==>' m.a '(to' m.ty.value')'
do y=1 to m.ty.0
call typeShow m.ty.y.cont, a'.'m.ty.y, lv+1
end
if m.ty.stem ^== '' then do
do y=1 to m.a.0
call typeShow m.ty.stem, a'.'y, lv+1
end
end
return
endProcedure typeShow
typeClear: procedure expose m.
parse arg ty, a, val
m.a = val
do y=1 to m.ty.0
call typeClear m.ty.type.y, a'.'m.ty.y
end
if m.ty.type ^== '' then
m.a.0 = 0
return
endProcedure typeClear
typeSay: procedure expose m.
parse arg t
say 'type' t'='m.t 'ass' m.t.ass '#' m.t.0 'fields' m.t.0
return
endProcedure typeSay
typeCopy: procedure expose m.
parse arg ty, t, f
m.t = m.f
if left(ty, 1) = '*' then
return
do x = 1 to m.ty.0
fld = m.ty.x
call typeCopy m.ty.x.cont, t'.'fld, f'.'fld
end
if m.ty.stem ^== '' then do
do y = 1 to m.f.0
call typeCopy m.ty.stem, t'.'y, f'.'y
end
m.t.0 = m.f.0
end
return t
endProcedure typeCopy
typeIni: procedure expose m.
parse arg force
if m.type.ini = 1 & force ^== 1 then
return
m.type.ini = 1
call mIni
call mapReset type, '='
m.typeSimple = 'TYPE.1'
siTy = typeNew('Simple')
if m.typeSimple ^== siTy then
call err 'm.typeSimple ^== siTy'
stTy = typeNew('Stem', , siTy)
tyTy = typeNew('Type')
tyFi = typeNew('TypeField', , , 'CONT', '*'tyTy)
tyTy = typeAtts(tyTy, , tyFi, 'ASS VALUE STEM',
, siTy '*'tyTy '*'tyTy)
ttTy = typeNew('StemType',, tyTy)
return
endProcedure typeIni
typeTest: procedure
call typeIni
si = 'Simple'
siTy = typeGet(si)
say si '==>' siTy m.type.si m.typeSimple
tyTy = typeGet('Type')
ttTy = typeGet('StemType')
say 'siTy' siTy 'tyTy' tyTy 'stTyTy' ttTy
call typeSay siTy
call typeShow tyTy, tyTy
call typeCopy siTy, nnn, siTy'.'ass
say 'm.nnn nach copy' m.nnn
call typeCopy tyTy, mmm, siTy
call typeSay mmm
call typeCopy tyTy, qqq, tyTy
call typeSay qqq
call typeShow tyTy, qqq
call typeShow ttTy, type
return
endProcedure typeTest
/* copy type end ****************************************************/
}¢--- A540769.WK.REXX.O08(TYPEGENE) cre=2008-12-09 mod=2008-12-09-17.57.16 F540769 ---
/*---------------------------------------------------------------------
type with generic Types
---------------------------------------------------------------------*/
call errReset 'h'
call typ3Test
exit
typ3Test: procedure expose m.
call typ3Ini
meta = typ3Make('t')
qq1 = typ3Make('u(f fEins pEins, f fZwei pZwei)',
, 'qq1', 'pEins pZwei')
say 'qq1 ' qq1
call typ3Say meta, qq1
pp1 = typ3Make('qq1(v, r v)')
say 'pp1 ' pp1
call typ3Say meta, pp1
call typ3Say pp1, 'v'
qq2 = typ3Make('u(f fEZ qq1(qEins,qZwei),f fZD qq1(qZwei,qDrei))',
, 'qq2', 'qEins qZwei qDrei')
say 'qq2 ' qq2
call typ3Say meta, qq2
pp2 = typ3Make('qq2(f ppEins v, f ppZwei r v, f ppDrei r r v)')
say 'pp2 ' pp2
call typ3Say meta, pp2
call typ3Say pp2, 'v'
exit
t1 = typ3Make('f eins f zwei v', 'tf12')
say 'f**2 ' t1
call typ3Say meta, t1
say 'f**2 ' typ3Make('f zwei v', 'tf2')
say 'f**2 ' typ3Make('f eins f zwei v ')
say 'r s f**2' typ3Make('r s f eins f zwei v ')
t2 = typ3Make('r s f eins f zwei v ','rs1')
call typ3Say meta, t2
call typ3Say meta, meta, 'meta'
say 'r s f**2' t2
say 'u ' typ3Make('u(f eins v, s u(f zwei v), r f drei v ) ')
say 'u ' typ3Make('u(f eins v,s u (f zwei v),r f drei v)')
say 's rs1 ' typ3Make('s rs1')
call typ3Say 's rs1 ' typ3Make('s rs1 ')
say 'union' m.x m.x.name m.x.type
say 'meta@u' typ3Make('meta@u', typ3Make(,'u',,
, typ3Make(,'f', v, 'name') ,
typ3Make(,'s', v)))
say 'meta@f' typ3Make('meta@f', typ3Make(,'u',,
, typ3Make(,'f', v, 'name') ,
typ3Make(,'f', v, 'field')))
return
/* copy typ3 begin *****************************************************
meta
c choice name type
f field name type
n name name type
g generic name type generic: forType = '', type->g.Type
resolved; forType=generic, type = re
p parameter name type formal: type='' name=paramName
actual: type=resolved, name=paramNam
in resoulution: name=formal type=''
r reference type
s stem type
u union stem
v value
***********************************************************************/
typ3Ini: procedure expose m.
if m.typ3.ini == 1 then
return
m.typ3.ini = 1
call mapIni
m.typ3.0 = 0
call mapReset 'TYP3.N2T'
v = mapAdd(typ3.n2t, 'v', typ3New('v'))
nm = typ3New('f', name, v)
meta = mapAdd(typ3.n2t, 't', typ3New('u', v))
tyR= typ3New('r', ,meta)
ty = typ3New('f', type, tyR)
fp = typ3New('f', ofType, tyR)
nt = typ3New('u', nm, ty)
st = typ3New('s', , tyR)
nst = typ3New('u', nm, st, ty)
u = typ3New('c', 'u', mapAdd(typ3.n2t, 'u', st))
c = typ3New('c', 'c', mapAdd(typ3.n2t, 'c', nt))
f = typ3New('c', 'f', mapAdd(typ3.n2t, 'f', nt))
n = typ3New('c', 'n', mapAdd(typ3.n2t, 'n', nt))
r = typ3New('c', 'r', mapAdd(typ3.n2t, 'r', ty))
s = typ3New('c', 's', mapAdd(typ3.n2t, 's', ty))
p = typ3New('c', 'p', mapAdd(typ3.n2t, 'p', nt))
g = typ3New('c', 'g', mapAdd(typ3.n2t, 'g', typ3New('u', fp,st,ty)))
call mAdd meta, typ3New('c', 'v', v), u, c, f, n, r, s, p, g
return
endProcedure typ3Ini
typ3New: procedure expose m.
parse arg t3, nm, ty
m = mAdd(typ3, t3)
m.m.name = ''
m.m.type = ''
m.m.0 = ''
if t3 = 'u' then do
do ux=1 to arg()-1
m.m.ux = arg(ux+1)
end
m.m.0 = arg()-1
end
else if pos(t3, 'cfgnprsv') > 0 then do
if t3 = 'g' then
m.m.ofType = nm
else
m.m.name = nm
m.m.type = ty
if pos(t3, 'g') > 0 then
m.m.0 = 0
end
else do
call err 'bad basicType' t3 'in typ3New'
end
if right(m.m.type, 5) = '.TYPE' then
call err '????????'
return m
endProcedure typ3New
typ3Copy: procedure expose m.
parse arg f
m = mAdd(typ3, m.f)
m.m.name = m.f.name
m.m.type = m.f.type
if m.f == 'g' then
m.m.ofType = m.f.ofType
if m.f.0 > 0 then
call mAddSt mCut(m, 0), f
else
m.m.0 = m.f.0
return m
endProcedure typ3Copy
typ3Make: procedure expose m.
parse arg tyEx, nm, parms
t = mapGet(typ3.n2t, tyEx, '')
if parms ^== '' then do
if nm == '' then
call err 'parms ('parms') without nm'
else if t ^== '' then
call err 'old type' tyEx 'with parms' nm'('parms')'
end
if t == '' then do
pp = ''
if parms ^== '' then do
pp = typ3New('g')
do px=1 to words(parms)
call mAdd pp, typ3New('p', word(parms, px))
end
end
sc = scanReset(typ3.sc)
call scanSrc sc, tyEx
t = typ3MakeScan(sc, pp, parms == '')
if ^ scanAtEnd(sc) then
call scanErr sc, 'end of type expression expected'
if parms ^== '' then do
m.pp.type = t
t = pp
end
end
if nm ^== '' then do
t = typ3New('n', nm, t)
call mapAdd typ3.n2t, nm, t
end
return t
endProcedure typ3Make
typ3MakeScan: procedure expose m.
parse arg sc, parms, final
call scanSkip sc
sPos = m.sc.pos
call scanBrackets sc, '(', ')', ','
ePos = m.sc.pos
if sPos >= ePos then
call scanErr sc, 'typeExpression expected'
if mapHasKey(typ3.n2t, m.sc.tok) then
return mapGet(typ3.n2t, m.sc.tok)
m.sc.pos = sPos
if ^ scanName(sc) then
call scanErr sc, 'type name expected'
tyNm = m.sc.tok
basic = length(tyNm) = 1 & pos(tyNm, 'vcfurspe') > 0
if basic then do
nn = typ3New(tyNm)
if pos(tyNm, 'cfp') > 0 then do
if ^ scanName(scanSkip(sc)) then
call scanErr sc, 'name in typeExpression expected'
m.nn.name = m.sc.tok
end
if pos(tyNm, 'cfrsp') > 0 then
m.nn.type = typ3MakeScan(sc, parms, final)
end
else do
if parms ^== '' then do
do px=1 to m.parms.0
p1 = m.parms.px
if m.p1 == 'p' & m.p1.name == tyNm then
return p1
end
end
ty = mapGet(typ3.n2t, tyNm, '')
if ty == '' then
call scanErr sc, 'undefined type' m.sc.tok
tg = ty
do while m.tg == 'n'
tg = m.tg.type
end
if m.tg ^== 'g' then
return ty
nn = typ3New('g', tg)
end
if ^ basic | tyNm == 'u' then do
if ^ scanLit(scanSkip(sc), '(') then
call scanErr sc, '( expected for type' tyNm
do forever
call mAdd nn, typ3MakeScan(sc, parms, final)
if ^ scanLit(scanSkip(sc), ')', ',') then
call scanErr sc, ', or ) in type list expected'
if m.sc.tok = ')' then
leave
end
if ^ basic then do
if m.tg.0 <> m.nn.0 then
call scanErr sc, tyNm 'has' m.tg.0 'formal parameters',
'but typeExpr' m.nn.0 'actuals'
do px=1 to m.tg.0
m.nn.px = typ3SearchFree(typ3New('p', m.tg.px, m.nn.px))
end
if final then
m.nn.type = typ3Parameterise(m.tg.type, nn)
end
end
call scanSkip sc
if m.sc.pos <> ePos then
call scanErr sc, 'end mismatch'
res = mapAdd(typ3.n2t, substr(m.sc.src, sPos, ePos-sPos),
, typ3SearchFree(nn))
if right(res, 5) = '.TYPE' then
call err '?????234'
return res
endProcedure typ3MakeScan
typ3Parameterise: procedure expose m.
parse arg ty, pa
if ty = 'TYP3?27' then
trace ?R
say 'typ3Parameterise' ty',' pa
do px=1 to m.pa.0
p1 = m.pa.px
if m.p1 ^== 'p' | m.p1.type == '' then
call err 'not a parm or empty' p1 m.p1 m.p1.type
if ty == m.p1.name then
return typ3Parameterise(m.p1.type, pa)
end
if m.ty == 'p' then
call err 'unresolved parameter' ty
if m.ty == 'g' then do
if m.ty.ofType == '' then
call err 'unparameterised generic type' ty
else if m.ty.type ^== '' then
return typ3Search(ty)
end
c = typ3Copy(ty)
if m.c ^== 'g' then do
if m.c.type ^== '' then
m.c.type = typ3Parameterise(m.ty.type, pa)
if m.c.0 > 0 then do
do sx=1 to m.c.0
m.c.sx = typ3Parameterise(m.c.sx, pa)
end
end
end
else do
do px=1 to m.c.0
p1 = typ3Copy(m.c.px)
m.p1.type = typ3Parameterise(m.p1.type, pa)
m.c.px = p1
end
ge = m.ty.ofType
m.c.type = typ3Parameterise(m.ge.type, c)
do px=1 to m.c.0
p1 = m.c.px
g1 = m.ge.px
m.p1.name = m.g1.name
m.c.px = typ3Search(p1)
end
end
return typ3SearchFree(c)
endProcedure typ3Parameterise
typ3Search: procedure expose m.
parse arg t
do vx=1 to m.typ3.0
v = typ3'.'vx
if typ3Equal(t, v) then
return v
end
return t
endProcedure typ3SearchFree
typ3SearchFree: procedure expose m.
parse arg t
f = typ3Search(t)
if f ^== t then
m.typ3.0 = substr(t, 6) - 1
return f
endProcedure typ3SearchFree
typ3Equal: procedure expose m.
parse arg l, r
if m.l ^== m.r | m.l.type ^== m.r.type | m.l.0 ^= m.r.0 then
return 0
if m.l.name ^== m.r.name then
return 0
if pos(m.l, 'hq') > 0 & m.l.ofType ^== m.r.ofType then
return 0
if m.l.0 == '' then
return 1
do sx=1 to m.l.0
if m.l.sx ^== m.r.sx then
return 0
end
return 1
endProcedure typ3Equal
if m.ty ^== 'q' then
call err 'bad type' m.ty '@'ty
if m.ty.type ^== '' then
return
?????
nn = m.typ3.0 + 1
t = 'typ3.'nn
m.t.name = nm
m.t.meta = ma
m.t.field = ''
m.t.type = ty
if ma = 'f' then
m.t.field = pl
if ma = 'u' then do
m.t.0 = words(pl)
do wx = 1 to m.t.0
m.t.wx = word(pl, wx)
end
end
if nm == '' then do
do tx=1 to m.typ3.0 until typ3eq(t, 'typ3.'tx)
end
if tx = nn then
m.typ3.0 = nn
else
t = 'typ3.'tx
end
else do
m.typ3.0 = nn
m.typ3.name.nm = t
end
say 'made' t m.t.name m.t.meta
return t
endProcedure typ3Make
typ3Eq: procedure expose m.
parse arg le, ri
if m.le.meta ^== m.ri.meta then
return 0
if m.le.name ^== m.ri.name | m.le.type ^== m.ri.type then
return 0
if m.le.meta == 'f' then
return m.le.field == m.ri.field
if m.le.meta == 'u' then do
if m.le.0 <> m.ri.0 then
return 0
do ix = 1 to m.le.0
if m.le.ix ^== m.ri.ix then
return 0
end
end
return 1
endProcedure typ3Eq
typeGet:
parse arg name
return mapGet(type, name)
endProcedure typeGet
typeNew: procedure expose m.
parse arg name, val, stem, flds, types
call typeIni
if pos(left(name, 1), '0123456789') > 0 | ^datatype(name, 'a') then
call err 'bad type name' name
ty = mapAdd(type, name)
call mapPut type, name, ty
m.ty.ass = '='
return typeAtts(ty, val, stem, flds, types)
endProcedure typeNew
typeAtts: procedure expose m.
parse arg ty, val, st, flds, types
m.ty.value = firstNS(val, m.typeSimple)
if m.ty.value ^== m.typeSimple & left(m.ty.value, 1) ^= '*' then
call err 'value type must be a reference not' val
m.ty.stem = st
m.ty.0 = words(flds)
do y=1 to m.ty.0
m.ty.y = word(flds, y)
m.ty.y.cont = firstNS(word(types, y), m.typeSimple)
end
return ty
endProcedure typeAtts
firstNS: procedure
do ax=1 to arg()
if arg(ax) ^= '' then
return arg(ax)
end
call err 'all space'
endProcedure firstNS
typeShow: procedure expose m.
parse arg ty, a, lv
if lv='' then
lv = 0
pr = a
if lv > 0 & lastPos('.', pr) > 0 then
pr = left('', lv*2)substr(pr, lastPos('.', pr))
do while left(ty, 1) = '*'
say pr '-->' m.a '(to' ty')'
return
end
if m.ty.value = m.typeSimple then
say pr '=' m.a
else
say pr '==>' m.a '(to' m.ty.value')'
do y=1 to m.ty.0
call typeShow m.ty.y.cont, a'.'m.ty.y, lv+1
end
if m.ty.stem ^== '' then do
do y=1 to m.a.0
call typeShow m.ty.stem, a'.'y, lv+1
end
end
return
endProcedure typeShow
typeClear: procedure expose m.
parse arg ty, a, val
m.a = val
do y=1 to m.ty.0
call typeClear m.ty.type.y, a'.'m.ty.y
end
if m.ty.type ^== '' then
m.a.0 = 0
return
endProcedure typeClear
typ3Say: procedure expose m.
parse arg t, a, pr
call typ3SayDone t, a, pr, pr
return
endProcedure typ3Say
typ3SayDone: procedure expose m. done.
parse arg t, a, pr, p1
if p1 == '' then
p1 = pr
if right(p1, 1) ^== ' ' then
p1 = p1' '
if done.t.a == 1 then do
say p1'done @'a
return 0
end
done.t.a = 1
if m.t == 'v' then do
say p1'=' m.a
return 0
end
if m.t == 'n' then
return typ3SayDoneDone(m.t.type, a, pr, p1'typeName' m.t.name)
if m.t == 'f' then
return typ3SayDone(m.t.type, a'.'m.t.name, pr, p1'.'m.t.name)
if m.t == 'r' then do
if m.a ^== '' then
return typ3SayDone(m.t.type, m.a, pr,
, p1'refTo' m.t.type '@'m.a)
say p1'refTo' m.t.type '@null@'
return 0
end
if m.t = 'u' then do
say p1'union' m.t.0 '@'a
do ux=1 to m.t.0
call typ3SayDone m.t.ux, a, pr' '
end
return 0
end
if m.t = 's' then do
say p1'stem' m.a.0 m.t.type '@'a
do ux=1 to m.a.0
call typ3SayDone m.t.type, a'.'ux, pr' ', pr' .'ux
end
return 0
end
if m.t = 'c' then do
if m.t.name = m.a then
call typ3SayDone m.t.type, a, pr, p1'c' m.t.name m.t.type
return 0
end
if m.t = 'g' then
return typ3SayDone(m.t.type, a, pr, p1'g')
call err 'bad basic type' m.t
return
endProcedure typ3SayDone
typeCopy: procedure expose m.
parse arg ty, t, f
m.t = m.f
if left(ty, 1) = '*' then
return
do x = 1 to m.ty.0
fld = m.ty.x
call typeCopy m.ty.x.cont, t'.'fld, f'.'fld
end
if m.ty.stem ^== '' then do
do y = 1 to m.f.0
call typeCopy m.ty.stem, t'.'y, f'.'y
end
m.t.0 = m.f.0
end
return t
endProcedure typeCopy
typeIni: procedure expose m.
parse arg force
if m.type.ini = 1 & force ^== 1 then
return
m.type.ini = 1
call mIni
call mapReset type, '='
m.typeSimple = 'TYPE.1'
siTy = typeNew('Simple')
if m.typeSimple ^== siTy then
call err 'm.typeSimple ^== siTy'
stTy = typeNew('Stem', , siTy)
tyTy = typeNew('Type')
tyFi = typeNew('TypeField', , , 'CONT', '*'tyTy)
tyTy = typeAtts(tyTy, , tyFi, 'ASS VALUE STEM',
, siTy '*'tyTy '*'tyTy)
ttTy = typeNew('StemType',, tyTy)
return
endProcedure typeIni
typeTest: procedure
call typeIni
si = 'Simple'
siTy = typeGet(si)
say si '==>' siTy m.type.si m.typeSimple
tyTy = typeGet('Type')
ttTy = typeGet('StemType')
say 'siTy' siTy 'tyTy' tyTy 'stTyTy' ttTy
call typeSay siTy
call typeShow tyTy, tyTy
call typeCopy siTy, nnn, siTy'.'ass
say 'm.nnn nach copy' m.nnn
call typeCopy tyTy, mmm, siTy
call typeSay mmm
call typeCopy tyTy, qqq, tyTy
call typeSay qqq
call typeShow tyTy, qqq
call typeShow ttTy, type
return
endProcedure typeTest
/* copy typ3 end ****************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanRead??(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.m.tok ==> last token
m.m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.m.pos ==> scan position
m.m.src ==> scan source
***********************************************************************/
scanIni: procedure expose m.
if m.scan.ini == 1 then
return
m.scan.ini = 1
m.scan.alfLC = 'abcdefghijklmnopqrstuvwxyz'
m.scan.alfUC = translate(m.scan.alfLC)
m.scan.alfa = m.scan.alfLC || m.scan.alfUC
m.scan.alfNum = m.scan.alfa || '0123456789'
return
endProcedure scanIni
scanReset: procedure expose m.
parse arg m, n1, np, co
m.m.tok = ''
m.m.val = ''
m.m.key = ''
m.m.read = ''
return scanOpts(m, n1, np, co)
endProcedure scanReset
scanOpts: procedure expose m.
parse arg m, m.m.scanName1, namePlus, m.m.scanComment
call scanIni
if m.m.scanName1 == '' then
m.m.scanName1 = m.scan.alfa
if namePlus == '' then
m.m.scanNameR = m.m.scanName1 || '0123456789'
else
m.m.scanNameR = m.m.scanName1 || namePlus
return m
endProcedure scanReset
/*--- begin scanning a single line -----------------------------------*/
scanSrc: procedure expose m.
parse arg m, m.m.src
m.m.atEnd = 1
m.m.pos = 1
return m
endProcedure scanSrc
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
if len == '' then
return substr(m.m.src, m.m.pos)
else
return substr(m.m.src, m.m.pos,
, min(len, 1 + length(m.m.src) - m.m.pos))
endProcedure scanLook
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m
do ax=2 to arg()
if abbrev(substr(m.m.src, m.m.pos), arg(ax)) then do
m.m.tok = arg(ax)
m.m.pos = m.m.pos + length(arg(ax))
return 1
end
end
m.m.tok = ''
return 0
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.m.src)
if len ^= '' then
nx = min(m.m.pos + len, nx)
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanChar
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, prefs
m.m.tok = ''
bx = m.m.pos
if prefs = '' then do
qu = substr(m.m.src, bx, 1)
if pos(qu, "'""") < 1 then
return 0
ax = bx + 1
end
else do
do px=1 until abbrev(substr(m.m.src, bx), p1)
p1 = word(prefs, px)
if p1 = '' then
return 0
end
qu = right(p1, 1)
ax = bx + length(p1)
end
m.m.val = ''
do forever
qx = pos(qu, m.m.src, ax)
if qx < 1 then
return scanErr(m, 'ending Apostroph('qu') missing')
m.m.val = m.m.val || substr(m.m.src, ax, qx-ax)
if qx >= length(m.m.src) then
leave
else if substr(m.m.src, qx+1, 1) <> qu then
leave
ax = qx+2
m.m.val = m.m.val || qu
end
m.m.tok = substr(m.m.src, bx, qx+1-bx)
m.m.pos = qx+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.scanName1, rest in *.scanNameR ----*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.m.src, m.m.pos, 1),
, m.m.scanName1) <= 0 then do
m.m.tok = ''
return 0
end
return scanVerify(m, m.m.scanNameR)
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.m.src, alpha, , m.m.pos)
else
nx = verify(m.m.src, alpha, vOpt, m.m.pos)
if nx = 0 then
nx = length(m.m.src) + 1
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
scanNat: procedure expose m.
parse arg m, chEn
if ^ scanVerify(m, '0123456789') then
return 0
if chEn^==0 & pos(substr(m.m.src, m.m.pos,1), m.m.scanNameR)>0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
scanInt: procedure expose m.
parse arg m, chEn
if scanNat(m, chEn) then
return 1
ox = m.m.pos
if pos(substr(m.m.src, ox, 1) , '+-') < 1 then
return 0
m.m.pos = ox + 1
if | scanNat(m) then do
m.m.pos = ox
return 0
end
m.tok =substr(m.m.src, ox, 1)|| m.tok
return 1
endProcedure scanInt
scanBrackets: procedure expose m.
parse arg m, op, cl, st
sx = m.m.pos
dep = 0
do forever
call scanVerify m, op || cl || st, 'm'
if ^ scanChar(m, 1) then
if dep = 0 then
leave
else
call scanErr m, 'closing bracket' cl 'missing'
if m.m.tok = op then
dep = dep + 1
else if dep < 1 then do
m.m.pos = m.m.pos - 1
leave
end
else if m.m.tok = cl then
dep = dep - 1
end
m.m.tok = substr(m.m.src, sx, m.m.pos-sx)
return m.m.tok ^== ''
endProcedure scanBrackets
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m) then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.m.val = m.m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.m.pos - length(tok)
if substr(m.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.m.key = m.m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.m.val = def
m.m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.m.key '=')
return 1
endProcedure scanKeyValue
scanAtEnd: procedure expose m.
parse arg m
return m.m.atEnd & m.m.pos > length(m.m.src)
endProcedure scanAtEnd
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.m.tok
if m.m.read ^== '' then
interpret 'res = ' oObjMethod(m, 'scanSpaceNl')
else
res = scanSpaceCom(m)
m.m.tok = lastTok
return res
endProcedure scanSpaceNL
scanSpaceCom: procedure expose m.
parse arg m
res = scanVerify(m, ' ')
if m.m.scanComment ^== '' then
if abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
m.m.pos = 1 + length(m.m.src)
return 1
end
return res
endProcedure scanSpaceCom
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
m.m.err.0 = 0
call err 'scanErr' txt'\n'scanInfo(m, m'.ERR')
return 0
endProcedure scanErr
scanPos: procedure expose m.
parse arg m
if m.m.read ^== '' then
interpret 'return' oObjMethod(m, 'scanPos')
else if scanAtEnd(m) then
return E
else
return 1 m.m.pos
endProcedure scanPos
scanInfo: procedure expose m.
parse arg m
msg = 'last token' m.m.tok 'scanPosition' ,
strip(left(substr(m.m.src, m.m.pos), 40), 't')
if m.m.read == '' then
return msg'\npos' m.m.Pos 'in string' strip(m.m.src, 't')
else
interpret 'return msg"\n" ||' oObjMethod(m, 'scanInfo')
endProcedure scanInfo
/* copy scan end ****************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, if opt <> '' maintain stem of keys
('K' in map.keys, '=' in a else in opt) --------------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = opt
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'a')
m.vv = val
return val
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'p')
m.vv = val
return val
endProcedure mapPut
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a if it exists,
else if called with a third argument return third argument
else issue an error ----------------------------------------*/
mapGet: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv ^== '' then
return m.vv
else if arg() > 2 then
return arg(3)
else
call err 'missing key in mapGet('a',' ky')'
endProcedure mapGet
/*--- return a stem of all keys --------------------------------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if m.map.keys ^== '' then
call err 'not implemented mapRemove('a',' ky')'
val = m.a.vv
drop m.a.ky
return val
endProcedure mapRemove
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
if length(k) > 200 then do
k = left(k, 201)
if symbol('m.a.k') == 'VAR' then/* ist noch hier */
call mapClear m.a.k
end
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
/*--- return the value pointer for a key, '' if non existing
with fun = 'a' add a key, with 'p' put a key ------------*/
mapValAdr: procedure expose m.
parse arg pA, pKy, fun
a = pA
ky = pKy
do forever
if length(ky) <= 200 then do
if symbol('m.a.ky') ^== 'VAR' then
leave
if fun == 'a' then
call err 'duplicate key' pKy 'in map' pA
return a'.'ky
end
k1 = left(ky, 201)
if symbol('m.a.k1') ^== 'VAR' then
leave
a = m.a.k1
ky = substr(ky, 202)
end
if fun == '' then
return ''
opt = left('K', m.map.keys.pA ^== '')
if opt == 'K' then
call mAdd m.map.Keys.pA, pKy
do while length(ky) > 200
k1 = left(ky, 201)
n = mapNew(opt)
m.a.k1 = n
if a ^== pA & opt == 'K' then
call mAdd m.map.keys.a, ky
a = n
ky = substr(ky, 202)
end
return a'.'ky
endProcedure mapValAdr
/* copy map end *******************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(TYP2) cre=2008-09-25 mod=2008-09-26-13.48.38 F540769 ---
call typ2Test
exit
typ2Test: procedure expose m.
call typ2Ini
v = typ2Make('v', 'v')
say 'value' v
say 'meta@u' typ2Make('meta@u', typ2Make(,'u',,
, typ2Make(,'f', v, 'name') ,
typ2Make(,'s', v)))
say 'meta@f' typ2Make('meta@f', typ2Make(,'u',,
, typ2Make(,'f', v, 'name') ,
typ2Make(,'f', v, 'field')))
return
/* copy type begin *****************************************************
meta
u union stem
f field type field
v value type
r reference type
s stem type
***********************************************************************/
typ2Ini: procedure expose m.
m.typ2.0 = 0
return
endProcedure typ2Ini
typ2Make: procedure expose m.
parse arg nm, ma, ty, pl
if nm ^== '' then
if symbol('m.typ2.name.nm') == 'VAR' then
call err 'duplicate type' nm
nn = m.typ2.0 + 1
t = 'TYP2.'nn
m.t.name = nm
m.t.meta = ma
m.t.field = ''
m.t.type = ty
if ma = 'f' then
m.t.field = pl
if ma = 'u' then do
m.t.0 = words(pl)
do wx = 1 to m.t.0
m.t.wx = word(pl, wx)
end
end
if nm == '' then do
do tx=1 to m.typ2.0 until typ2eq(t, 'TYP2.'tx)
end
if tx = nn then
m.typ2.0 = nn
else
t = 'TYP2.'tx
end
else do
m.typ2.0 = nn
m.typ2.name.nm = t
end
say 'made' t m.t.name m.t.meta
return t
endProcedure typ2Make
typ2Eq: procedure expose m.
parse arg le, ri
if m.le.meta ^== m.ri.meta then
return 0
if m.le.name ^== m.ri.name | m.le.type ^== m.ri.type then
return 0
if m.le.meta == 'f' then
return m.le.field == m.ri.field
if m.le.meta == 'u' then do
if m.le.0 <> m.ri.0 then
return 0
do ix = 1 to m.le.0
if m.le.ix ^== m.ri.ix then
return 0
end
end
return 1
endProcedure typ2Eq
typeGet:
parse arg name
return mapGet(type, name)
endProcedure typeGet
typeNew: procedure expose m.
parse arg name, val, stem, flds, types
call typeIni
if pos(left(name, 1), '0123456789') > 0 | ^datatype(name, 'a') then
call err 'bad type name' name
ty = mapAdd(type, name)
call mapPut type, name, ty
m.ty.ass = '='
return typeAtts(ty, val, stem, flds, types)
endProcedure typeNew
typeAtts: procedure expose m.
parse arg ty, val, st, flds, types
m.ty.value = firstNS(val, m.typeSimple)
if m.ty.value ^== m.typeSimple & left(m.ty.value, 1) ^= '*' then
call err 'value type must be a reference not' val
m.ty.stem = st
m.ty.0 = words(flds)
do y=1 to m.ty.0
m.ty.y = word(flds, y)
m.ty.y.cont = firstNS(word(types, y), m.typeSimple)
end
return ty
endProcedure typeAtts
firstNS: procedure
do ax=1 to arg()
if arg(ax) ^= '' then
return arg(ax)
end
call err 'all space'
endProcedure firstNS
typeShow: procedure expose m.
parse arg ty, a, lv
if lv='' then
lv = 0
pr = a
if lv > 0 & lastPos('.', pr) > 0 then
pr = left('', lv*2)substr(pr, lastPos('.', pr))
do while left(ty, 1) = '*'
say pr '-->' m.a '(to' ty')'
return
end
if m.ty.value = m.typeSimple then
say pr '=' m.a
else
say pr '==>' m.a '(to' m.ty.value')'
do y=1 to m.ty.0
call typeShow m.ty.y.cont, a'.'m.ty.y, lv+1
end
if m.ty.stem ^== '' then do
do y=1 to m.a.0
call typeShow m.ty.stem, a'.'y, lv+1
end
end
return
endProcedure typeShow
typeClear: procedure expose m.
parse arg ty, a, val
m.a = val
do y=1 to m.ty.0
call typeClear m.ty.type.y, a'.'m.ty.y
end
if m.ty.type ^== '' then
m.a.0 = 0
return
endProcedure typeClear
typeSay: procedure expose m.
parse arg t
say 'type' t'='m.t 'ass' m.t.ass '#' m.t.0 'fields' m.t.0
return
endProcedure typeSay
typeCopy: procedure expose m.
parse arg ty, t, f
m.t = m.f
if left(ty, 1) = '*' then
return
do x = 1 to m.ty.0
fld = m.ty.x
call typeCopy m.ty.x.cont, t'.'fld, f'.'fld
end
if m.ty.stem ^== '' then do
do y = 1 to m.f.0
call typeCopy m.ty.stem, t'.'y, f'.'y
end
m.t.0 = m.f.0
end
return t
endProcedure typeCopy
typeIni: procedure expose m.
parse arg force
if m.type.ini = 1 & force ^== 1 then
return
m.type.ini = 1
call mIni
call mapReset type, '='
m.typeSimple = 'TYPE.1'
siTy = typeNew('Simple')
if m.typeSimple ^== siTy then
call err 'm.typeSimple ^== siTy'
stTy = typeNew('Stem', , siTy)
tyTy = typeNew('Type')
tyFi = typeNew('TypeField', , , 'CONT', '*'tyTy)
tyTy = typeAtts(tyTy, , tyFi, 'ASS VALUE STEM',
, siTy '*'tyTy '*'tyTy)
ttTy = typeNew('StemType',, tyTy)
return
endProcedure typeIni
typeTest: procedure
call typeIni
si = 'Simple'
siTy = typeGet(si)
say si '==>' siTy m.type.si m.typeSimple
tyTy = typeGet('Type')
ttTy = typeGet('StemType')
say 'siTy' siTy 'tyTy' tyTy 'stTyTy' ttTy
call typeSay siTy
call typeShow tyTy, tyTy
call typeCopy siTy, nnn, siTy'.'ass
say 'm.nnn nach copy' m.nnn
call typeCopy tyTy, mmm, siTy
call typeSay mmm
call typeCopy tyTy, qqq, tyTy
call typeSay qqq
call typeShow tyTy, qqq
call typeShow ttTy, type
return
endProcedure typeTest
/* copy type 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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(TYP3) cre=2008-11-17 mod=2008-12-15-18.23.07 F540769 ---
/*---------------------------------------------------------------------
type with generic Types
---------------------------------------------------------------------*/
call errReset 'h'
call typ3Test
exit
typ3Test: procedure expose m.
call typ3Ini
meta = typ3New('t')
t1 = typ3New('n tf12 f eins f zwei v')
say 'f**2 ' t1
call typ3Say meta, t1
say 'f**2 ' typ3New('n tf2 f zwei v')
say 'f**2 ' typ3New('f eins f zwei v ')
say 'r s f**2' typ3New('r s f eins f zwei v ')
t2 = typ3New('n rs1 u s f eins f zwei v ',
, 'm', 'mEins mEins code','mEmpty')
call typ3Say meta, t2
call typ3Say meta, meta, 'meta'
say 'r s f**2' t2
say 's rs1 ' typ3New('s rs1')
m.qq.0 = 2
call typ3Dump
call typ3Say meta, typ3New(' rs1'), 't rs1 '
call typ3Say typ3New(' rs1 '), qq, 's rs1 '
say 'union' m.x m.x.name m.x.type
say 'meta@u' typ3New('meta@u', typ3New(,'u',,
, typ3New(,'f', v, 'name') ,
typ3New(,'s', v)))
say 'meta@f' typ3New('meta@f', typ3New(,'u',,
, typ3New(,'f', v, 'name') ,
typ3New(,'f', v, 'field')))
exit
qq1 = typ3New('u(f fEins pEins, f fZwei pZwei)',
, 'qq1', 'pEins pZwei')
say 'qq1 ' qq1
call typ3Say meta, qq1
pp1 = typ3New('qq1(v, r v)')
say 'pp1 ' pp1
call typ3Say meta, pp1
call typ3Say pp1, 'v'
qq2 = typ3New('u(f fEZ qq1(qEins,qZwei),f fZD qq1(qZwei,qDrei))',
, 'qq2', 'qEins qZwei qDrei')
say 'qq2 ' qq2
call typ3Say meta, qq2
pp2 = typ3New('qq2(f ppEins v, f ppZwei r v, f ppDrei r r v)')
say 'pp2 ' pp2
call typ3Say meta, pp2
call typ3Say pp2, 'v'
exit
return
/* copy typ3 begin *****************************************************
meta
c choice name type
f field name type
n name name type
p parameter name type
q param type name type stem
r reference type
s stem type
u union stem
v value
***********************************************************************/
typ3Ini: procedure expose m.
if m.typ3.ini == 1 then
return
m.typ3.ini = 1
call mapIni
m.typ3.0 = 0
m.typ3.tmp.0 = 0
call mapReset 'TYP3.N2T'
m.typ3.register = ''
meta = typ3New('n t u' ,
'c v v,' ,
'c r r,' ,
'c s n s r,' ,
'c u n u s r,',
'c f n f' typ3New('u f NAME v, f TYPE r')',',
'c n n n' typ3New('u f NAME v, f TYPE r')',',
'c c n c' typ3New('u f NAME v, f TYPE r')',',
'c m n m' typ3New('u f NAME v, f MET v') )
call typ3RegisterAdd "m.typ3.o2t.m = '"typ34Name('t')"'"
return
endProcedure typ3Ini
typ3Mutate: procedure expose m.
parse arg m, name
m.typ3.o2t.m = typ34Name(name)
return
endProcedure typ3Mutate
typ3Register: procedure expose m.
parse arg m
interpret m.typ3.register
return
endProcedure typ3Register
typ3RegisterAdd: procedure expose m.
parse arg code
call typ3Ini
regOld = m.typ3.register
m.typ3.register = code
do y = 1 to m.typ3.0
call typ3Register 'TYP3.'y
end
m.typ3.register = regOld code';'
return
endProcedure typ3RegisterAdd
typ3Dump: procedure expose m.
parse arg f, t
if f = '' then
f = 1
if t = '' then
t = m.typ3.0
do y=f to t
a = 'TYP3.'y
l = ''
if m.a.0 > 0 then
l = mCat(a, ', ')
say a m.a m.a.name m.a.type m.a.0 l
end
return
endProcedure typ3Dump
typ34Name: procedure expose m.
parse arg nm
if symbol('m.typ3.n2t.nm') == 'VAR' then
return m.typ3.n2t.nm
call err 'no type' nm
endProcedure typ34Name
typ34Obj: procedure expose m.
parse arg m
if symbol('m.typ3.o2t.m') == 'VAR' then
return m.typ3.o2t.m
call err 'typ34Obj('m') object not found'
endProcedure typ34Name
typ3New: procedure expose m.
parse arg tyEx
say left('typ3New', 20) tyEx
if arg() <= 1 then
if mapHasKey(typ3.n2t, tyEx) then
return mapGet(typ3.n2t, tyEx)
t = typ3NewTmp(tyEx)
if arg() > 1 then do
pr = copies(arg(2) || ' ', length(arg(2)) == 1)
u = t
do while m.u ^== 'u'
if m.u.type == '' then
call err 'no union found' tyEx
u = m.u.type
end
do ax = 2+(pr ^== '') to arg()
call mAdd u, typ3New(pr || arg(ax))
end
end
p = typ3Permanent(t, 1)
if arg() <= 1 then
call mapAdd typ3.n2t, tyEx, p
say left('typ3New' p, 20) tyEx
return p
endProcedure typ3New
typ3NewTmp: procedure expose m.
parse arg t3 nm re
if length(t3) > 1 then do
if nm ^== '' then
call err 'type' t3 'should stand alone:' t3 nm re
if abbrev(t3, 'TYP3.') then
return t3
if ^mapHasKey(typ3.n2t, t3) then
call err 'undefined type' t3
return mapGet(typ3.n2t, t3)
end
t = mAdd(typ3.tmp, t3)
m.t.name = ''
m.t.type = ''
m.t.met = ''
m.t.0 = ''
if pos(t3, 'v') > 0 then do
if nm ^== '' then
call err 'basicType' t3 'end of Exp expected:' t3 nm re
end
else if nm == '' & t3 ^== 'r' then do
call err 'basicType' t3 'name or type Exp expected:' t3 nm re
end
else if t3 = 'u' then do
fx = 0
m.t.0 = 0
re = nm re
do ux=1 until fx = 0
tx = pos(',', re, fx+1)
if tx > fx then
sub = strip(substr(re, fx+1, tx-fx-1))
else
sub = strip(substr(re, fx+1))
if sub = '' then
call err 'empty subType at' fx 'in' re
m.t.ux = typ3New(sub)
fx = tx
end
m.t.0 = ux
end
else do
if pos(t3, 'sr') > 0 then do
if nm ^== '' then
m.t.type = typ3NewTmp(nm re)
end
else do
if pos(t3, 'cfmn') < 1 then
call err 'unsupported basicType' t3 'in' t3 nm re
m.t.name = nm
if t3 = 'm' then
m.t.met = re
else if re = '' then
call err 'basicType' t3 'type Exp expected:' t3 nm re
else
m.t.type = typ3NewTmp(re)
end
end
return t
endProcedure typ3NewTmp
typ3Permanent: procedure expose m.
parse arg t, free
if ^ abbrev(t, 'TYP3.TMP.') then
return t
if m.t.type ^== '' then
m.t.type = typ3Permanent(m.t.type)
if m.t.0 ^== '' then do
do tx=1 to m.t.0
m.t.tx = typ3Permanent(m.t.tx)
end
end
/* search equal permanent type */
do vx=1 to m.typ3.0
p = typ3'.'vx
if typ3Equal(t, p) then
leave
end
if vx > m.typ3.0 then do
p = mAdd(typ3, m.t)
m.p.name = m.t.name
m.p.type = m.t.type
m.p.met = m.t.met
if m.t.0 > 0 then
call mAddSt mCut(p, 0), t
else
m.p.0 = m.t.0
if m.p = 'n' then do
if mapHasKey(typ3.n2t, m.p.name) then
call err 'type' m.p.name 'already defined'
else
call mapAdd typ3.n2t, m.p.name, p
end
end
if free == 1 then
m.typ3.tmp.0 = substr(t, 10) - 1
call typ3Register p
return p
endProcedure typ3Permanent
typ3Equal: procedure expose m.
parse arg l, r
if m.l ^== m.r | m.l.type ^== m.r.type | m.l.0 ^= m.r.0,
| m.l.name ^== m.r.name | m.l.met ^== m.r.met then
return 0
if m.l.0 == '' then
return 1
do sx=1 to m.l.0
if m.l.sx ^== m.r.sx then
return 0
end
return 1
endProcedure typ3Equal
typ3Say: procedure expose m.
parse arg t, a, pr
call typ3SayDone t, a, pr, pr
return
endProcedure typ3Say
typ3SayDone: procedure expose m. done.
parse arg t, a, pr, p1
if pos('.type', t a) > 0 then call err '?????? .type'
if p1 == '' then
p1 = pr
if right(p1, 1) ^== ' ' then
p1 = p1' '
if done.t.a == 1 then do
say p1'done @'a
return 0
end
done.t.a = 1
if m.t == 'v' then do
say p1'=' m.a
return 0
end
if m.t == 'n' then
return typ3SayDone(m.t.type, a, pr, p1'typeName' m.t.name)
if m.t == 'f' then
return typ3SayDone(m.t.type, a'.'m.t.name, pr, p1'.'m.t.name)
if m.t == 'r' then do
reTo = m.a
if reTo == '' then
say p1'refTo' m.t.type '@null@'
else if m.t.type ^== '' then
return typ3SayDone(m.t.type, reTo, pr,
, p1'refTo' m.t.type '@'m.a)
else if symbol('m.typ3.o2t.reTo') == 'VAR' then
return typ3SayDone(m.typ3.o2t.reTo, reTo, pr,
, p1'refTo dynType' m.typ3.o2t.reTo '@'reTo)
else
say p1'refTo noType' reTo '@'a
return 0
end
if m.t = 'u' then do
say p1'union' m.t.0 '@'a
do ux=1 to m.t.0
call typ3SayDone m.t.ux, a, pr' '
end
return 0
end
if m.t = 's' then do
say p1'stem' m.a.0 m.t.type '@'a
do ux=1 to m.a.0
call typ3SayDone m.t.type, a'.'ux, pr' ', pr' .'ux
end
return 0
end
if m.t = 'c' then do
if m.t.name = m.a then
call typ3SayDone m.t.type, a, pr, p1'c' m.t.name m.t.type
return 0
end
if m.t = 'm' then
return
call err 'bad basic type' m.t
return
endProcedure typ3SayDone
typeTest: procedure
call typeIni
si = 'Simple'
siTy = typeGet(si)
say si '==>' siTy m.type.si m.typeSimple
tyTy = typeGet('Type')
ttTy = typeGet('StemType')
say 'siTy' siTy 'tyTy' tyTy 'stTyTy' ttTy
call typeSay siTy
call typeShow tyTy, tyTy
call typeCopy siTy, nnn, siTy'.'ass
say 'm.nnn nach copy' m.nnn
call typeCopy tyTy, mmm, siTy
call typeSay mmm
call typeCopy tyTy, qqq, tyTy
call typeSay qqq
call typeShow tyTy, qqq
call typeShow ttTy, type
return
endProcedure typeTest
/* copy typ3 end ****************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanRead??(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.m.tok ==> last token
m.m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.m.pos ==> scan position
m.m.src ==> scan source
***********************************************************************/
scanIni: procedure expose m.
if m.scan.ini == 1 then
return
m.scan.ini = 1
m.scan.alfLC = 'abcdefghijklmnopqrstuvwxyz'
m.scan.alfUC = translate(m.scan.alfLC)
m.scan.alfa = m.scan.alfLC || m.scan.alfUC
m.scan.alfNum = m.scan.alfa || '0123456789'
return
endProcedure scanIni
scanReset: procedure expose m.
parse arg m, n1, np, co
m.m.tok = ''
m.m.val = ''
m.m.key = ''
m.m.read = ''
return scanOpts(m, n1, np, co)
endProcedure scanReset
scanOpts: procedure expose m.
parse arg m, m.m.scanName1, namePlus, m.m.scanComment
call scanIni
if m.m.scanName1 == '' then
m.m.scanName1 = m.scan.alfa
if namePlus == '' then
m.m.scanNameR = m.m.scanName1 || '0123456789'
else
m.m.scanNameR = m.m.scanName1 || namePlus
return m
endProcedure scanReset
/*--- begin scanning a single line -----------------------------------*/
scanSrc: procedure expose m.
parse arg m, m.m.src
m.m.atEnd = 1
m.m.pos = 1
return m
endProcedure scanSrc
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
if len == '' then
return substr(m.m.src, m.m.pos)
else
return substr(m.m.src, m.m.pos,
, min(len, 1 + length(m.m.src) - m.m.pos))
endProcedure scanLook
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m
do ax=2 to arg()
if abbrev(substr(m.m.src, m.m.pos), arg(ax)) then do
m.m.tok = arg(ax)
m.m.pos = m.m.pos + length(arg(ax))
return 1
end
end
m.m.tok = ''
return 0
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.m.src)
if len ^= '' then
nx = min(m.m.pos + len, nx)
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanChar
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, prefs
m.m.tok = ''
bx = m.m.pos
if prefs = '' then do
qu = substr(m.m.src, bx, 1)
if pos(qu, "'""") < 1 then
return 0
ax = bx + 1
end
else do
do px=1 until abbrev(substr(m.m.src, bx), p1)
p1 = word(prefs, px)
if p1 = '' then
return 0
end
qu = right(p1, 1)
ax = bx + length(p1)
end
m.m.val = ''
do forever
qx = pos(qu, m.m.src, ax)
if qx < 1 then
return scanErr(m, 'ending Apostroph('qu') missing')
m.m.val = m.m.val || substr(m.m.src, ax, qx-ax)
if qx >= length(m.m.src) then
leave
else if substr(m.m.src, qx+1, 1) <> qu then
leave
ax = qx+2
m.m.val = m.m.val || qu
end
m.m.tok = substr(m.m.src, bx, qx+1-bx)
m.m.pos = qx+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.scanName1, rest in *.scanNameR ----*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.m.src, m.m.pos, 1),
, m.m.scanName1) <= 0 then do
m.m.tok = ''
return 0
end
return scanVerify(m, m.m.scanNameR)
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.m.src, alpha, , m.m.pos)
else
nx = verify(m.m.src, alpha, vOpt, m.m.pos)
if nx = 0 then
nx = length(m.m.src) + 1
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
scanNat: procedure expose m.
parse arg m, chEn
if ^ scanVerify(m, '0123456789') then
return 0
if chEn^==0 & pos(substr(m.m.src, m.m.pos,1), m.m.scanNameR)>0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
scanInt: procedure expose m.
parse arg m, chEn
if scanNat(m, chEn) then
return 1
ox = m.m.pos
if pos(substr(m.m.src, ox, 1) , '+-') < 1 then
return 0
m.m.pos = ox + 1
if | scanNat(m) then do
m.m.pos = ox
return 0
end
m.tok =substr(m.m.src, ox, 1)|| m.tok
return 1
endProcedure scanInt
scanBrackets: procedure expose m.
parse arg m, op, cl, st
sx = m.m.pos
dep = 0
do forever
call scanVerify m, op || cl || st, 'm'
if ^ scanChar(m, 1) then
if dep = 0 then
leave
else
call scanErr m, 'closing bracket' cl 'missing'
if m.m.tok = op then
dep = dep + 1
else if dep < 1 then do
m.m.pos = m.m.pos - 1
leave
end
else if m.m.tok = cl then
dep = dep - 1
end
m.m.tok = substr(m.m.src, sx, m.m.pos-sx)
return m.m.tok ^== ''
endProcedure scanBrackets
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m) then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.m.val = m.m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.m.pos - length(tok)
if substr(m.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.m.key = m.m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.m.val = def
m.m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.m.key '=')
return 1
endProcedure scanKeyValue
scanAtEnd: procedure expose m.
parse arg m
return m.m.atEnd & m.m.pos > length(m.m.src)
endProcedure scanAtEnd
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.m.tok
if m.m.read ^== '' then
interpret 'res = ' oObjMethod(m, 'scanSpaceNl')
else
res = scanSpaceCom(m)
m.m.tok = lastTok
return res
endProcedure scanSpaceNL
scanSpaceCom: procedure expose m.
parse arg m
res = scanVerify(m, ' ')
if m.m.scanComment ^== '' then
if abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
m.m.pos = 1 + length(m.m.src)
return 1
end
return res
endProcedure scanSpaceCom
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
m.m.err.0 = 0
call err 'scanErr' txt'\n'scanInfo(m, m'.ERR')
return 0
endProcedure scanErr
scanPos: procedure expose m.
parse arg m
if m.m.read ^== '' then
interpret 'return' oObjMethod(m, 'scanPos')
else if scanAtEnd(m) then
return E
else
return 1 m.m.pos
endProcedure scanPos
scanInfo: procedure expose m.
parse arg m
msg = 'last token' m.m.tok 'scanPosition' ,
strip(left(substr(m.m.src, m.m.pos), 40), 't')
if m.m.read == '' then
return msg'\npos' m.m.Pos 'in string' strip(m.m.src, 't')
else
interpret 'return msg"\n" ||' oObjMethod(m, 'scanInfo')
endProcedure scanInfo
/* copy scan end ****************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, if opt <> '' maintain stem of keys
('K' in map.keys, '=' in a else in opt) --------------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = opt
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'a')
m.vv = val
return val
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'p')
m.vv = val
return val
endProcedure mapPut
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a if it exists,
else if called with a third argument return third argument
else issue an error ----------------------------------------*/
mapGet: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv ^== '' then
return m.vv
else if arg() > 2 then
return arg(3)
else
call err 'missing key in mapGet('a',' ky')'
endProcedure mapGet
/*--- return a stem of all keys --------------------------------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if m.map.keys ^== '' then
call err 'not implemented mapRemove('a',' ky')'
val = m.a.vv
drop m.a.ky
return val
endProcedure mapRemove
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
if length(k) > 200 then do
k = left(k, 201)
if symbol('m.a.k') == 'VAR' then/* ist noch hier */
call mapClear m.a.k
end
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
/*--- return the value pointer for a key, '' if non existing
with fun = 'a' add a key, with 'p' put a key ------------*/
mapValAdr: procedure expose m.
parse arg pA, pKy, fun
a = pA
ky = pKy
do forever
if length(ky) <= 200 then do
if symbol('m.a.ky') ^== 'VAR' then
leave
if fun == 'a' then
call err 'duplicate key' pKy 'in map' pA
return a'.'ky
end
k1 = left(ky, 201)
if symbol('m.a.k1') ^== 'VAR' then
leave
a = m.a.k1
ky = substr(ky, 202)
end
if fun == '' then
return ''
opt = left('K', m.map.keys.pA ^== '')
if opt == 'K' then
call mAdd m.map.Keys.pA, pKy
do while length(ky) > 200
k1 = left(ky, 201)
n = mapNew(opt)
m.a.k1 = n
if a ^== pA & opt == 'K' then
call mAdd m.map.keys.a, ky
a = n
ky = substr(ky, 202)
end
return a'.'ky
endProcedure mapValAdr
/* copy map end *******************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(VDPS) cre=2007-03-29 mod=2007-03-29-14.16.04 F540769 ---
mbr = vdpspe0
call readDsn '~wk.text('mbr')', i.
say 'read' i.0 'from' mbr
sum = 0
dlt = 1000000
nxt = dlt
laKy = ''
laSu = 0
m.fld = instrumentid
do i=1 to i.0
key = word(i.i, 1)
cnt = word(i.i, 2)
if translate(key) = 'FROM' then do
say 'from' cnt
m.table = cnt
iterate
end
if words(i.i) ^= 2 then do
if 0 then
say 'ignore words' strip(i.i)
iterate
end
if ^(datatype(key, 'N')& datatype(cnt, 'N')) then do
if 0 then
say 'ignore numbr' strip(i.i)
iterate
end
sum = sum + cnt
if 0 then
say i strip(i.i) 'sum' sum
if sum >= nxt then do
call emit laKy, key, sum - laSu
laKy = key
laSu = sum
nxt = sum + dlt
end
end
call emit laKy, , sum - laSu
if 0 then
call mShow o
call writeDsn '~wk.text('mbr'o)', m.o., , 1
exit
emit: procedure expose m.
parse arg prev, act, cc
r = ''
if prev ^= '' then
r = m.fld '>' prev'0000'
if act ^= '' then do
if r ^= '' then
r = r 'and'
r = r m.fld '<=' act'0000'
end
r = r'; --' cc
say '***' r
call mAdd o,
, 'UPDATE ' m.table 'SET PROVIDERTYPE = 1',
, ' where' r,
, ' commit;' ,
, ' select current timestamp from sysibm.sysdummy1;'
return r
endProcedure emit
err:
call errA arg(1), 1
endSubroutine err
/* copy m begin ********************************************************
stem and tree handling
***********************************************************************/
/*--- increase m.m and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg m, delta
if delta = '' then
m.m = m.m + 1
else
m.m = m.m + delta
return m.m
endProcedure mInc
/*--- increase m.m and return it (also if undefined) -----------------*/
mIncD: procedure expose m.
parse arg m, delta
if symbol('m.m') <> 'VAR' then
m.m = 0
return mInc(m)
endProcedure mIncD
/*--- return Ky of m ------------------------------------------------*/
mKy: procedure expose m.
parse arg m
return m.mKey.m
endProcedure mKy
/*--- return number of children of node m or 0 -----------------------*/
mSize: procedure expose m.
parse arg m
if symbol('m.m.0') == 'VAR' then
return m.m.0
else
return 0
endProcedure mSize
/*--- return parent of node m or '' ----------------------------------*/
mPar: procedure expose m.
parse arg m
dx = lastPos('.', m)
if dx <= 1 then
return ''
else
return left(m, dx - 1)
endProcedure mPar
/*--- create a new tree root -----------------------------------------*/
mRoot: procedure expose m.
parse arg m, Ky, val
if m == '' then
m = 'mRoot.' || mIncD('mRoot.0')
m.m = val
m.mKey.m = Ky
m.m.0 = 0
return m
endProcedure mRoot
/*--- add one or several values to stem m.m --------------------------*/
mAdd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
end
m.m.0 = ix
return m'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSeq: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
dx = mSize(dst)
do sx = begX to endX
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return dst
endProcedure mAddSeq
/*--- add one value to the stem m.m ----------------------------------*/
mAddNd: procedure expose m.
parse arg m
ix = mSize(m)
do ax = 2 to arg()
ix = ix + 1
m.m.ix = arg(ax)
m.m.ix.0 = 0
end
m.m.0 = ix
return m'.'ix
endProcedure mAddNd
/*--- add one Ky value pair to stem m.m -----------------------------*/
mAddKy: procedure expose m.
parse arg m, Ky, val
nn = mAddNd(m, val)
m.mKey.nn = Ky
return nn
endProcedure mAddKy
/*--- add one indexable Ky value pair to stem m.m -------------------*/
mAddK1: procedure expose m.
parse arg m, ky, val
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
call err 'duplicate Ky' ky 'for node' m
nn = mAddNd(m, val)
m.mKey.nn = ky
m.mIndex.m.mKey.ky = nn
return nn
endProcedure mAddK1
/*--- put value at Ky if it exists otherwise add the node -----------*/
mPut: procedure expose m.
parse arg m, Ky, val
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
m.ch = val
return ch
end
else do
return mAddK1(m, Ky, val)
end
return
endProcedure mPut
/*--- return the child of m at the given Ky, '' if not exists -------*/
mAtK1: procedure expose m.
parse arg m, ky
if symbol('m.mIndex.m.mKey.ky') == 'VAR' then
return m.mIndex.m.mKey.ky
else
return ''
endProcedure mAtK1
/*--- return the value of the child at Ky, fail if not exists -------*/
mVaAtK1: procedure expose m.
parse arg m, Ky
if symbol('m.mIndex.m.mKey.Ky') ^== 'VAR' then
call err 'no Ky' Ky 'at node' m
ch = m.mIndex.m.mKey.Ky
return m.ch
endProcedure mVaAtK1
/*--- return the value of the first defined ky in the list of nodes
def if ky isn't defined ---------------------------------------*/
mFirst: procedure expose m.
parse arg Ky, def
do ax=3 to arg()
m = arg(ax)
if symbol('m.mIndex.m.mKey.Ky') == 'VAR' then do
ch = m.mIndex.m.mKey.Ky
return m.ch
end
end
return def
endProcedure mFirst
/*--- return the child at sequenceNo seq of node m -------------------*/
mAtSq: procedure expose m.
parse arg m, seq
if symbol('m.m.seq') ^== 'VAR' then
return ''
else
return m'.'seq
endProcedure mAtSq
/*--- remove all or all after nwSz children --------------------------*/
mRemCh: procedure expose m.
parse arg pa, nwSz
if nwSz = '' then
nwSz = 0
do cx=nwSz+1 to mSize(pa)
ch = pa'.'cx
call mRemCh ch
ky = m.mKey.ch
drop m.mIndex.pa.mKey.ky m.mKey.ch m.ch m.ch.0
end
m.pa.0 = nwSz
return pa
endProcedure mRemCh
/*--- add to m.dst a (sub)tree of m.src.* ----------------------------*/
mAddTree: procedure expose m.
parse arg dst, src, begX, endX
if begX = '' then
begX = 1
if endX = '' then
endX = mSize(src)
do sx=begX to endX
sCh = src'.'sx
if symbol('m.mKey.sCh') ^= 'VAR' then do
dCh = mAddNd(dst, m.sCh)
end
else do
ky = m.mKey.sCh
if symbol('m.mIndex.src.mKey.ky') ^= 'VAR' then
dCh = mAddKy(dst, ky, m.sCh)
else
dCh = mAddK1(dst, ky, m.sCh)
end
call mAddTree dCh, sCh
end
return dst
endProcedure mAddTree
/*--- show from one node everything that is defined ------------------*/
mShowNd: procedure expose m.
parse arg m
pa = mPar(m)
t = 'node' m 'pa='pa
if symbol('m.m') == 'VAR' then
t = t 'va='m.m
if symbol('m.m.0') == 'VAR' then
t = t 'size='m.m.0
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
t = t 'ky='ky
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t = t 'index='m.mIndex.pa.mKey.ky
end
say t
return
endProcedure mShowNd
/*--- show the tree at m recursively ---------------------------------*/
mShow: procedure expose m.
parse arg m, lv
if lv = '' then
lv = 0
t = left('', lv)m
if symbol('m.mKey.m') == 'VAR' then do
ky = m.mKey.m
pa = mPar(m)
if symbol('m.mIndex.pa.mKey.ky') == 'VAR' then
t= t ky '>'
else
t= t ky '='
end
say t strip(m.m, 't')
do cx=1 to mSize(m)
call mShow mAtSq(m, cx), lv+1
end
return
endProcedure treeShow
/* copy m 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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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
m.dsnAlloc.dsn = ''
if left(spec, 1) = '=' then
return strip(substr(spec, 2))
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 to 3
w = word(spec, wx)
if w = '.' then do
wx = wx + 1
leave
end
if w = '' then
leave
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if m.dsnAlloc.dsn = '' then
m.dsnAlloc.dsn = dsn2jcl(w, addPref)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if m.dsnAlloc.dsn <> '' then
disp = disp "dsn('"m.dsnAlloc.dsn"')"
call adrTso 'alloc dd('dd')' disp subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(VPOOL) cre=2006-11-02 mod=2006-11-02-10.06.10 F540769 ---
/* rexx */
call adrIsp 'control errors return'
say adrIsp("vget (zscreen zsplit vProfile) profile", '*')
say 'got profile zscreen' zscreen 'zsplit' zsplit 'vProfile' vProfile
say adrIsp("vget (zscreen zsplit vShared vProfile) shared", '*')
say 'got shared zscreen' zscreen 'zsplit' zsplit ,
'vShared' vShared 'vProfile' vProfile
vShared = 'vShared ' time() 'zScreen' zScreen
say adrIsp("vput (vShared) shared")
say 'put vShared =' vShared
vProfile = 'vProfile' time() 'zScreen' zScreen
say adrIsp("vput (vProfile) profile")
say 'put vProfile =' vProfile
exit
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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 *************************************************/
}¢--- A540769.WK.REXX.O08(WAR) cre=2008-05-20 mod=2008-09-15-09.30.35 F540769 ---
/* rexx ****************************************************************
synopsis: WAR cf <warFile> ( -C<home> ¦ <ds> )*
WAR xf <warFile> ( -C<home> ¦ <pref> )*
creates a warFile from a list of datasets and or members of a PDS
or extracts datasets and or members from a warFile
arguments:
cf create warfile (lowercase)
xf extract members/datasets from warfile (lowercase)
<warfile> DSN of the warfile
<home> the prefix of added or extracted datasets, default userid
<ds> if <home><ds> is a PDS all members are added,
if a seqential dataset or a member of a PDS it is added
<pref> extract all pds-members or datasets with this prefix,
to a DSN <pref> replaced by <home>
which must already be catalogued
***********************************************************************/
parse arg args
call errReset 'hi'
call warIni
if pos('?', args) > 0 then
return help()
else if args <> '' then
nop
else if 1 then
args = 'cf ~zzz.backup(d'right(date(s), 6)') -C~WK',
'CLIST JCL MSGS PANELS PLI REXX REXX.OLD SKELS SQL' ,
'TESTCASE TESTDATA TESTCRES TEXV'
else if 0 then
args = 'cf ~zzz.backup(tst20) -C~WK',
'CLIST JCL MSGS PANELS PLI REXX REXX.OLD SKELS SQL TESTCASE'
else if 0 then
args = 'cf ~zzz.backup(tst10) -C~WK MSGS PANELS'
else if 0 then
args = 'xf ~zzz.backup(d'right(date(s), 6)') -::F' ,
'-C~tmpUlW2 ~WK'
else
return errHelp('no args')
call warRun war(), args
exit
warIni: procedure expose m.
if m.war.ini == 1 then
return
m.war.ini = 1
m.war.0 = 0
call catIni
return
endProcedure warIni
war: procedure expose m.
parse arg r, w
m = 'WAR.'mInc('WAR.0')
call warReset m, r, w
return m
endProcedure war
warReset: procedure expose m.
parse arg m, w, i
call warClose m
if w == '' then
w = catDsn()
if i == '' then
i = catDsn()
m.m.war = w
m.m.item = i
m.m.home = warPref('~.')
m.m.allocCreate = ''
m.mark = '!'
m.beg = 'beg '
m.end = 'end '
return
endProcedure warReset
warClose: procedure expose m.
parse arg m, r, w
if symbol('m.m.war') == 'VAR' then
call jClose m.m.war
m.m.cItem = 0
m.m.cSkip = 0
m.m.cRecs = 0
m.m.cBytes = 0
return
endProcedure warClose
warRun: procedure expose m.
parse arg m, args
if pos('?', args) > 0 then
exit help()
fun = word(args, 1)
if ^ (fun == 'xf' | fun == 'cf') then
call err 'warRun first arg must be cf or xf not:' args
fun = left(fun, 1)
m.m.warDs = word(args, 2)
call jReset m.m.war, m.m.warDs
started = 0
do wx=3 to words(args)
if jOpt(word(args, wx), '', 'C:') then do
if m.j.oOpt == 'C' then
m.m.home = warPref(m.j.oVal)
else if m.j.oOpt == ':' then
m.m.allocCreate = ':'m.j.oVal
end
else if fun = 'c' then do
it = m.j.oVal
if ^started then
call jOpen m.m.war, 'w'
started = 1
call warAdd m, it
end
else do
started = 1
call warExtract m, m.j.oVal
end
end
if fun = 'x' then do
if ^ started then
call warExtract m
call jOut 'skipped' m.m.cSkip 'and' ,
'extracted' m.m.cItem 'datasets/members with',
m.m.cRecs 'records and' m.m.cBytes 'bytes' ,
'from' dsn2jcl(m.m.warDs)
end
else do
call jOut 'skipped' m.m.cSkip 'and' ,
'added' m.m.cItem 'datasets/members with',
m.m.cRecs 'records and' m.m.cBytes 'bytes' ,
'to' dsn2jcl(m.m.warDs)
end
call warClose m
return
warRun
warPref: procedure
parse arg dsn
return translate(strip(dsn2Jcl(dsn), 't', '.')'.')
endProcedure warPref
warAdd: procedure expose m.
parse arg m, pDsn
dsn = dsn2Jcl(m.m.home || pDsn)
if pos('(', dsn) > 0 then do
sd = sysDsn("'"dsn"'")
if sd == 'OK' then do
call warAddOne m, dsn
end
else do
m.m.cSkip = m.m.cSkip + 1
call jOut dsn sd
end
end
else do
sd = sysDsn("'"dsnSetMbr(dsn, abc)"'")
if sd == 'OK' | sd = 'MEMBER NOT FOUND' then do
call warAddPds m, dsn
end
else if right(sd, 15) == 'NOT PARTITIONED' then do
call warAddOne m, dsn
end
else do
m.m.cSkip = m.m.cSkip + 1
call jOut dsn sd
end
end
return
endProcedure warAdd
warAddPds: procedure expose m.
parse arg m, dsn
oRecs = m.m.cRecs
oBytes =m.m.cBytes
lmm = lmmBegin(dsn)
cnt = 0
do forever
mbr = lmmNext(lmm)
if mbr = '' then
leave
call warAddOne m, dsnSetMbr(dsn, mbr)
cnt = cnt + 1
end
call lmmEnd lmm
call jOut right(cnt, 6) 'mbrs,' right(m.m.cRecs-oRecs,10) 'recs,',
right(m.m.cBytes -oBytes, 10) 'B from' dsn
return
endProcedure warAddPds
warAddOne: procedure expose m.
parse arg m, dsn
upper dsn
it = m.m.item
call jReset it, dsn
call jOpen it, 'r'
w = m.m.war
call jWrite w, m.mark || m.beg || dsn
lx = 0
bx = 0
do while jRead(it, li)
lx = lx + 1
bx = bx + length(m.li)
if abbrev(m.li, m.mark) then
m.li = m.mark || m.li
call jWrite w, m.li
end
call jClose it
call jWrite w, m.mark || m.end || dsn
m.m.cItem = m.m.cItem + 1
m.m.cRecs = m.m.cRecs + lx
m.m.cBytes = m.m.cBytes + bx
return
endProcedure warAddOne
warExtract: procedure expose m.
parse arg m, filt
filt = warPref(filt)
it = m.m.item
w = m.m.war
call jOpen w, 'r'
sta = 0
wMa = m.mark
wMM = wMa || wMa
wBe = wMa || m.beg
wEn = wMa || m.end
do while jRead(w, li)
if abbrev(m.li, wMa) then do
if abbrev(m.li, wMM) then do
m.li = substr(m.li, 1+length(wMa))
end
else if abbrev(m.li, wBe) then do
if sta ^== 0 then
call err 'item begin but sta ' sta ':' m.li
dsn = translate(strip(substr(m.li, 1 + length(wBe))))
if ^ abbrev(dsn, filt) then do
sta = 2
end
else do
sta = 1
toDs = m.m.home || substr(dsn, length(filt) + 1)
call jReset it, toDs m.m.allocCreate
call jOpen it, 'w'
end
iterate
end
else if abbrev(m.li, wEn) then do
if sta = 1 then do
m.m.cItem = m.m.cItem + 1
call jClose it
end
else if sta = 2 then do
m.m.cSkip = m.m.cSkip + 1
end
else do
call err 'item end but sta ' sta ':' m.li
end
cc = translate(strip(substr(m.li, 1 + length(wEn))))
if dsn ^== cc then
call err 'mismatch end' cc 'after begin' dsn
sta = 0
if (m.m.cSkip+m.m.cItem) // 100 = 0 then
call jOut 'skipped' m.m.cSkip 'and' ,
'extracted' m.m.cItem 'datasets/members with',
m.m.cRecs 'records and' m.m.cBytes 'bytes',
'last to' toDs
iterate
end
else do
call err 'bad line (sta' sta'):' m.li
end
end
if sta = 1 then do
call jWrite it, m.li
m.m.cRecs = m.m.cRecs + 1
m.m.cBytes = m.m.cBytes + length(m.li)
end
else if sta ^== 2 then do
call err 'data in bad sta' sta':' m.li
end
end
if sta ^== 0 then
call err 'bad sta' sta 'at end of extract'
call jClose w
return
endProcedure warAddOne
/* copy cat begin ****************************************************
***********************************************************************/
catOpt: procedure
parse arg opt, keep
if abbrev(opt, '<') then
o = 'r'substr(opt, 2)
else if abbrev(opt, '>>') then
o = 'a'substr(opt, 3)
else if abbrev(opt, '>') then
o = 'w'substr(opt, 2)
else if pos(left(opt, 1), 'rwa') > 0 then
o = opt
else
o = '?'opt
if keep ^== 1 then
o = translate(o, ' ', '£#')
return space(o, 0)
endProcedure catOpt
/*--- create and possibly open a reader or writer --------------------*/
catMake: procedure expose m.
parse arg opt, spec
o = catOpt(opt, 1)
if pos('£', o) > 0 then
return spec
else if pos('#', o) > 0 then do
if envhasKey(spec) then
return catMake(translate(opt, '£', '#'), envGet(spec))
else
return envPut(spec, jBuf())
end
else if pos('&', o) > 0 then
return catDsn('&'spec)
else
return catDsn(spec)
call err 'catMake implement' opt
if defDsn == '' then do
o = left(o, length(o)-1)
end
else if defDsn == '' then do
rw = catDsn(spec)
end
else do
rw = jReset(defDsn, spec)
end
if pos('-', o) < 1 then
call jOpen rw, o
return rw
endProcedure catMake
/*--- create a new cat -----------------------------------------------*/
cat: procedure expose m.
m = oNew('Cat')
m.m.catIx = -9
call catReset m
do ax=1 by 2 to arg()
call catWriteAll m, arg(ax), arg(ax+1)
end
return m
endProcedure cat
catReset: procedure expose m.
parse arg m
m.m.RWs.0 = 0
m.m.catWr = ''
m.m.catRd = ''
m.m.catToClose = ''
m.m.catIx = -9
call oSetTypePara m
do ax=2 by 2 to arg()
call catWriteAll m, arg(ax), arg(ax+1)
end
return m
endProcedure catReset
catClose: procedure expose m.
parse arg m
if m.m.catIx == -9 then
return
if m.m.catWr ^== '' then do
call jClose m.m.catWr
bx = mInc(m'.RWS.0')
m.m.opts.bx = ""
m.m.RWs.bx = m.m.catWr
m.m.catWr = ''
end
if m.m.catIx >= 0 then do
if m.m.catRd ^== '' then do
ix = m.m.catIx
if pos('-', m.m.opts.ix) < 1 then
call jClose m.m.catRd
m.m.catRd = ''
end
do wx = 1 to words(m.m.catToClose)
cl = word(m.m.catToClose, wx)
if cl ^== m then
call jClose cl
end
m.m.catToClose = ''
end
m.m.catIx = -9
return m
endProcedure catClose
catOpen: procedure expose m.
parse arg m, oo
call jClose m
if oo = 'r' then do
m.m.catIx = 0
m.m.catRd = catNextRdr(m)
m.m.jReading = 1
end
else if oo == 'w' | oo == 'a' then do
if oo == 'w' then
m.m.RWs.0 = 0
m.m.catIx = -7
m.m.jWriting = 1
end
else do
call err 'catOpen('m',' oo') bad opt'
end
return m
endProcedure catOpen
/*--- return and open next reader ------------------------------------*/
catNextRdr: procedure expose m.
parse arg m
cx = m.m.catIx
if cx > 0 & cx <= m.m.RWs.0 & pos('-', m.m.opts.cx) < 1 then
call jClose m.m.catRd
cx = cx + 1
m.m.catIx = cx
if cx > m.m.RWs.0 then
return ''
oo = overlay('r', m.m.opts.cx)
if pos('-', oo) < 1 then
call jOpen m.m.RWs.cx, oo
return m.m.RWs.cx
endProcedure catNextRdr
catRead: procedure expose m.
parse arg m, var
do while m.m.catRd ^== ''
if jRead(m.m.catRd, var) then
return 1
m.m.catRd = catNextRdr(m)
end
return 0
endProcedure catRead
catWrite: procedure expose m.
parse arg m, line
if m.m.catWr == '' then do
m.m.catWr = jOpen(jBuf(), 'w')
call oSetTypePara m.m.catWr, oGetTypePara(m)
end
call jWrite m.m.catWr, line
return
endProcedure catWrite
/*--- write contents of a reader to cat
or keep it for later reading -------------------------------*/
catWriteAll: procedure expose m.
parse arg m
if m.m.catIx >= 0 then
call err 'catWriteAll('m',' arg(2)',' arg(3)') but opened,',
'catIx='m.m.catIx
bx = m.m.RWs.0
if m.m.catWr ^== '' then do
call jClose m.m.catWr
bx=bx+1
m.m.opts.bx = ""
m.m.RWs.bx = m.m.catWr
m.m.catWr = ''
end
do ax=2 by 2 to arg()
bx=bx+1
m.m.opts.bx = catOpt(arg(ax))
m.m.RWs.bx = catMake(arg(ax), arg(ax+1))
call oSetTypePara m, oGetTypePara(m.m.RWs.bx)
end
m.m.RWs.0 = bx
return
endProcedure catWriteAll
/*--- store the list toClose to close them when closing cat ----------*/
catLazyClose: procedure expose m.
parse arg m, toClose
if m.m.catIx <> -7 then
call err 'catLazyClose with catIx' m.m.catIx
if m.m.RWs.0 = 0 then
return 0
if m.m.catToClose ^== '' then
call err 'catLazyClose with catToClose' m.m.catToClose
if m.m.catIx <> -7 | m.m.catToClose ^== '' then
m.m.catToClose = toClose
return 1
endProcedure catLazyClose
catSetTypePara: procedure expose m.
parse arg m, type
do ix=1 to m.m.RWs.0
call oSetTypePara m.m.RWs.ix, type
end
return
endProcedure catSetTypePara
/*--- create a reader/writer for a dsn -------------------------------*/
catDsn: procedure expose m.
parse arg spec
m = oNew('CatDsn')
m.m.readIx = 'c'
ix = mInc('CAT.BUF')
m.m.defDD = 'CAT'ix
m.m.buf = 'CAT.BUF'ix
call catDsnReset m, spec
return m
endProcedure catDsn
catDsnReset: procedure expose m.
parse arg m, sp
if symbol('m.m.defDD') ^== 'VAR' then
m.m.defDD = 'CDD' mInc('CAT.DEFDD')
m.m.spec = sp
return m
endProcedure catDsnReset
catDsnOpen: procedure expose m.
parse arg m, opt
call jClose m
buf = m.m.buf
if opt == 'r' then do
aa = dsnAlloc(m.m.spec, 'SHR', m.m.defDD)
if m.dsnAlloc.dsn <> '' then
if sysDsn("'"m.dsnAlloc.dsn"'") <> 'OK' then
call err 'cannot read' m.dsnAlloc.dsn':',
sysDsn("'"m.dsnAlloc.dsn"'")
call readDDBegin word(aa, 1)
m.m.jReading = 1
m.buf.0 = -1
m.m.readIx = 0
end
else do
if opt == 'w' then
aa = dsnAlloc(m.m.spec, 'OLD', m.m.defDD)
else if opt == 'a' then
aa = dsnAlloc(m.m.spec, 'MOD', m.m.defDD)
else
call err 'catDsnOpen('m',' opt') with bad opt'
call writeDDbegin word(aa, 1)
m.m.jWriting = 1
m.buf.0 = 0
m.m.readIx = 'w'
end
m.m.dd = word(aa, 1)
m.m.free = subword(aa, 2)
return m
endProcedure catDsnOpen
catDsnClose:
parse arg m
buf = m.m.buf
if m.m.readIx ^== 'c' then do
if m.m.readIx == 'w' then do
if m.buf.0 > 0 then
call writeDD m.m.dd, 'M.'BUF'.'
call writeDDend m.m.dd
end
else do
call readDDend m.m.dd
end
interpret m.m.free
end
m.buf.0 = 'closed'
m.m.readIx = 'c'
m.m.free = ''
m.m.dd = ''
return m
endProcedure catDsnClose
catDsnRead: procedure expose m.
parse arg m, var
ix = m.m.readIx + 1
buf = m.m.buf
if ix > m.buf.0 then do
res = readDD(m.m.dd, 'M.'buf'.')
if ^ res then
return 0
ix = 1
end
m.m.readIx = ix
m.var = m.buf.ix
return 1
endProcedure catDsnRead
catDsnWrite: procedure expose m.
parse arg m, var
buf = m.m.buf
ix = m.buf.0 + 1
m.buf.0 = ix
m.buf.ix = var
if ix > 99 then do
call writeDD m.m.dd, 'M.'buf'.'
m.buf.0 = 0
end
return
endProcedure catDsnWrite
catIni: procedure expose m.
if m.cat.ini == 1 then
return
m.cat.ini = 1
m.cat.buf = 0
call jIni
call oDecMethods oNewClass("Cat", "JRW"),
, "jOpen return catOpen(m, arg)",
, "jReset return catReset(m, '', arg)",
, "jClose call catClose m",
, "jWriteAll call err 'jWriteAll not opened w",
, "oSetTypePara call catSetTypePara m, type",
, "jRead return catRead(m, var)",
, "jWrite call catWrite m, line; return",
, "jWriteAll call catWriteAll m, opt, rdr; return"
call oDecMethods oNewClass("CatDsn", "JRW"),
, "jOpen return catDsnOpen(m, arg)",
, "jReset return catDsnReset(m, arg)",
, "jClose call catDsnClose m",
, "jRead return catDsnRead(m, var)",
, "jWrite call catDsnWrite m, line"
return
endProcedure catIni
/* copy cat end ****************************************************/
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jRead: procedure expose m.
parse arg m, var
if m.m.jReading then
interpret oObjMethod(m, 'jRead')
else
call err 'jRead('m',' var') but not opened r'
else
endProcedure jRead
jWrite: procedure expose m.
parse arg m, line
if m.m.jWriting then
interpret oObjMethod(m, 'jWrite')
else
call err 'jWrite('m',' line') but not opened w'
return
endProcedure jWrite
jWriteAll: procedure expose m.
parse arg m, opt, rdr
interpret oObjMethod(m, 'jWriteAll')
return
endProcedure jWriteAll
jWriteAllImpl: procedure expose m.
parse arg m, opt, rdr
if pos('-', opt) < 1 then
call jOpen rdr, catOpt(opt)
do while jRead(rdr, line)
call jWrite m, m.line
end
if pos('-', opt) < 1 then
call jClose rdr
return
endProcedure jWriteAll
jReset: procedure expose m.
parse arg m, arg
call jClose m
interpret oObjMethod(m, 'jReset')
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret oObjMethod(m, 'jOpen')
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
if m.m.jReading = 1 | m.m.jWriting = 1 then
interpret oObjMethod(m, 'jClose')
m.m.jReading = 0
m.m.jWriting = 0
return m
endProcedure jClose
/*--- analyze an option in oOpt and oVal -----------------------------*/
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jIni: procedure expose m.
if m.j.ini == 1 then
return
m.j.ini = 1
call oIni
call oDecMethods oNewClass("JRW"),
, "jRead call err 'jRead('m',' var') but not opened r'",
, "jWrite call err 'jWrite('m',' line') but not opened w'",
, "jWriteAll call jWriteAllImpl m, opt, rdr",
, "jRead drop m.arg; return 0",
, "jWrite say 'jOut:' line",
, "jReset ;",
, "jOpen ;",
, "jClose ;"
x = oNew("JRW")
m.j.jIn = x
m.x.jReading = 1
m.x.jWriting = 0
x = oNew("JRW")
m.j.jOut = x
m.x.jReading = 0
m.x.jWriting = 1
call oDecMethods oNewClass("Jbuf", "JRW"),
, "jOpen return jBufOpen(m, arg)",
, "jReset return jBufReset(m, arg)",
, "oSetTypePara call jBufSetTypePara m, type",
, "jRead return jBufRead(m, var)",
, "jWrite call jBufWrite m, line"
return
endProcedure jInit
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
/*--- jBuf: buffer read or write (supports datataypes) ---------------*/
jBuf: procedure expose m.
m = oNew('Jbuf')
call jBufReset m
do ax=1 to arg()
m.m.buf.ax = arg(ax)
end
m.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
m.m.stem = m'.BUF'
m.m.buf.0 = 0
call oSetTypePara m
do ax=1 to arg() - 1
m.m.buf.ax = arg(ax+1)
m.m.buf.0 = ax
end
return m
endProcedure jBufReset
jBufSetTypePara: procedure expose m.
parse arg m, type
if m.m.buf.0 <> 0 then
call err 'jBufSetTypePara but not empty'
return
endProcedure jBufSetTypePara
jBufOpen: procedure expose m.
parse arg m, opt
call jClose m
if opt == 'r' then do
m.m.readIx = 0
m.m.jReading = 1
return m
end
if opt == 'w' then
m.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
m.m.jWriting = 1
return m
endProcedure jBufOpen
jBufRead: procedure expose m.
parse arg m, var
nx = m.m.readIx + 1
if nx > m.m.buf.0 then
return 0
m.m.readIx = nx
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.var = m.m.buf.nx
else
call oTyCopy ty, var, m'.BUF.'nx
return 1
endProcedure jBufRead
jBufWrite: procedure expose m.
parse arg m, line
nx = mInc(m'.BUF.0')
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.m.buf.nx = line
else
call oTyCopy ty, m'.BUF.'nx, line
return 1
endProcedure jBufRead
/* copy j end *********************************************************/
/* copy oFld begin *****************************************************
defines classes with field names
is the base for the oo layer in copy o
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
oFldIni: procedure expose m.
if m.oFld.ini = 1 then
return
m.oFld.ini = 1
call mapIni
m.o.fldOnly = mapNew() /* map fields -> class */
m.o.cla.0 = 0 /* the stem for classes */
call oFldNew 'Class', '=', , , /* MetaClass definieren */
'INST = MET .<>= FLD .<>=Class STEM =Class'
return
endProcedure oFldIni
/*--- create a new class
name: name of new class, a star will be replaced by a number
va: type of value
st: type of stem
flds: pairs of field names and types
dup: duplicate resolver -----------------------------------*/
oFldNew: procedure expose m.
parse arg name, va, st, flds, dup
if pos('*', name) > 0 then
name = oPut('O.CLA', name, , '*')
else
call oPut 'O.CLA', name, , 'n'
m.o.cla.name.inst = 0
m.o.cla.name.val = va
m.o.cla.name.stem = st
m.o.cla.name.FLD.0 = 0
m.o.cla.name.MET.0 = 0
return oFldAdd(name, flds, dup)
endProcedure oFldNew
/*--- create or find a class with only simple fields fs --------------*/
oFldOnly: procedure expose m.
parse arg fs, dup
kk = space(fs '?'dup, 1)
if mapHasKey(m.o.fldOnly, kk) then
return mapGet(m.o.fldOnly, kk)
if dup ^== 'e' then do
ll = space(fs, 1)
end
else do
ll = ''
do wx=1 to words(fs)
w = word(fs, wx)
v = w
do x=2 while wordPos(v, ff) > 0
v = w || x
end
ll = space(ll v, 1)
end
end
if mapHasKey(m.o.fldOnly, ll) then do
nn = mapGet(m.o.fldOnly, ll)
end
else do
nn = oFldNew('FldType*')
st = 'O.CLA.'nn'.FLD'
do lx=1 to words(ll)
call oPut st, word(ll, lx), '=', dup
end
call mapPut m.o.fldOnly, ll, nn
end
call mapPut m.o.fldOnly, kk, nn
return nn
endProcedure oFldOnly
/*--- return the stem of flds of class type --------------------------*/
oFlds: procedure expose m.
parse arg type
return 'O.CLA.'type'.FLD'
/*--- return the concatenation of the fields of type ty in stem st
formated by fmt -------------------------------------------*/
oFldCat: procedure expose m.
parse arg ty, st, fmt
flds = oFlds(ty)
res = ''
do ix=1 to m.flds.0
f = m.flds.ix
if fmt == '' then
res = res m.st.f
else
res = res fmt(m.st.f, m.fmt.ix)
end
return substr(res, 2)
endProcedure oFldCat
/*--- add fields to class cl given as name type pairs in fs ----------*/
oFldAdd: procedure expose m.
parse arg cla, fs, dup
st = 'O.CLA.'cla'.FLD'
do ix=1 by 2 to words(fs)
call oPut st, word(fs, ix), word(fs, ix+1), dup
end
return cla
endProcedure oFldAdd
/*--- add/put key k with value v to stem st
duplicate handling dup:
* replace * in k by a number until it is new
e add a number in it is not new
o replace old value at existing key
= add a new key, fail if key exists and value is different
------------------------------------------------------------*/
oPut: procedure expose m.
parse arg st, k, v, dup
if dup = '*' then do
cx = pos('*', k)
if cx < 1 then
call err 'no * in key' k
k = oPutDupResolve(st, left(k, cx-1), 1)
end
else if symbol('m.st.k') = 'VAR' then do
if dup = '' | dup = 'o' then do
m.st.k = v
return k
end
if dup = '=' then do
if v <> m.st.k | ^ (v = '' & datatype(m.st.k, 'n')) then
call err 'not =: m.'st'.'k '=>' m.st.k '<>' v
return k
end
if dup = 'e' then
k = oPutDupResolve(st, k, 2)
else
call err 'key' k 'exists in' st 'but dup' dup
end
else if dup = 'o' then
call err 'old key' k 'does not exist in' st
if datatype(k, 'n') | words(k) <> 1 | pos('.', k) > 0 then
call err 'illegal name' k
x = m.st.0 + 1
m.st.0 = x
m.st.x = k
if v == '' then
m.st.k = x
else
m.st.k = v
return k
endProcedure oPut
oPutDupResolve: procedure expose m.
parse arg st, k, b
do ix=b
a = k || ix
if symbol('m.st.a') <> 'VAR' then
return a
end
endProcedure oPutDupResolve
/*--- parameterized types --------------------------------------------*/
oGetTypePara: procedure expose m.
parse arg m
if symbol('m.o.tyPa.m') == 'VAR' then
return m.o.tyPa.m
else
return '='
endProcedure oGetTypePara
oSetTypePara: procedure expose m.
parse arg m, type, noCall
if type = '' then
type = '='
if oGetTypePara(m) == type then
return
if noCall ^== 'noCall' then
interpret oObjMethod(m, 'oSetTypePara')
m.o.tyPa.m = type
return
endProcedure oSetTypePara
/* copy oFld end ***************************************************/
/* copy o begin ********************************************************
object layer has three freatures
* an object may have a class which has methods
* an object may have a parmeterized type
* a class may contain field descriptions
***********************************************************************/
oClaMethod: procedure expose m.
parse arg cl, me
if symbol('m.o.cla.cl.met.me') = 'VAR' then
return m.o.cla.cl.met.me
else
call err 'no method' me 'in class' cl
endProcedure oClaMethod
oHasMethod: procedure expose m.
parse arg obj, me
cla = oGetClass(obj)
return symbol('m.o.cla.cl.met.me') = 'VAR'
endProcedure oHasMethod
oGetClass: procedure expose m.
parse arg Obj
if symbol('m.o.obj2cla.Obj') = 'VAR' then
return m.o.obj2cla.Obj
call err 'no class found for object' obj
endProcedure oGetClass
oObjMethod: procedure expose m.
parse arg obj, me
if symbol('m.o.obj2cla.obj') = 'VAR' then
return oClaMethod(m.o.obj2cla.obj, me)
if abbrev(obj, 'oCast:') then do
cx = pos(':', obj, 7)
return 'M="'substr(obj, cx+1)'";' ,
oClaMethod(substr(obj, 7,cx-7), me)
end
call err 'no class found for object' obj
endProcedure oObjMethod
oCast: procedure
parse arg obj, cl
if abbrev(obj, 'oCast:') then
obj = substr(obj, 1 + pos(':', obj, 7))
return 'oCast:'cl':'obj
endProcedure oCast
oNewClass: procedure expose m.
parse arg name, super
/* call oIni */
name = oFldNew(name)
neMe = 'O.CLA.'name'.MET'
neFi = 'O.CLA.'name'.FLD'
do sx=1 to words(super)
sup = word(super, sx)
if symbol('m.o.cla.sup') ^== 'VAR' then
call err 'superclass' sup 'is not defined'
if m.o.cla.sup.val ^== '' then
m.o.cla.name.val = m.o.cla.sup.val
if m.o.cla.sup.stem ^== '' then
m.o.cla.name.stem = m.o.cla.sup.stem
st = 'O.CLA.'sup'.MET'
do x=1 to m.st.0
olMe = m.st.x
call oPut neMe, olMe, m.st.olMe
end
st = 'O.CLA.'sup'.FLD'
do x=1 to m.st.0
olFi = m.st.x
call oPut neFi, olFi, m.st.olFi
end
end
call oMutate 'O.CLA.'name, 'Class'
return name
endProcedure oNewClass
oValStemFldsWKOLD: procedure expose m.
parse arg cl, m.o.cla.cl.val, m.o.cla.cl.stem, flds
st = 'O.CLA.'cl'.FLD'
do wx=1 by 2 to words(flds)
call oPut st, word(flds, wx), word(flds, wx+1)
end
return cl
endProcedure oValStemFlds
oNewTypeWKOLD: procedure expose m.
parse arg cl, va, st, flds
return oValStemFlds(oNewClass(cl), va, st, flds)
/*--- a field type has only fields of type '='
finds or creates a field Type with the fields of types tps
and the field list aFl.
if dup = 'e' duplicate field names are resolved ------------*/
oFiTypeWKOLD: procedure expose m.
parse arg tps, aFl, dup
if symbol('m.o.cla.fiType.tps.aFl.dup') = 'VAR' then
return m.o.cla.fiType.tps.aFl.dup
fs = ''
do wx=1 to words(tps)
t1 = oFlds(word(tps, wx))
do fx=1 to m.t1.0
fs = fs m.t1.fx
end
end
fs = fs aFl
fd = ''
do wx=1 to words(fs)
f1 = word(fs, wx)
if wordPos(f1, fd) < 1 then do
fd = fd f1
end
else if dup == 'e' then do
do dx=2 by 1 while wordPos(f1 || dx, fn fs) > 0
end
fd = fd f1 || dx
end
end
fd = space(fd aFl)
if symbol('m.o.cla.fiType.fd') = 'VAR' then do
res = m.o.cla.fiType.fd
end
else do
res = oNewClass("FiType*")
m.o.cla.fiType.fd = res
st = 'O.CLA.'res'.FLD'
do wx=1 to words(fd)
call oPut st, word(fd, wx), '='
end
end
m.o.cla.fiType.tps.aFl = res
return res
endProcedure oFiType
oDecMethods: procedure expose m.
parse arg cla
st = 'O.CLA.'cla'.MET'
do ax=2 to arg()
call oPut st, word(arg(ax), 1), subWord(arg(ax), 2)
end
return
endProcedure oDecMethods
oNew: procedure expose m.
parse arg cla
st = 'O.CLA.'cla
if symbol('M.st') ^== 'VAR' then
call err 'class' cla 'is not initialized'
nn = m.st.inst + 1
m.st.inst = nn
nn = 'O.C' || m.st || 'I' || nn
if symbol('m.o.obj2cla.nn') == 'VAR' then
call err 'oNew already defined:' nn
m.o.obj2cla.nn = cla
return nn
endProcedure oNew
oMutate: procedure expose m.
parse arg obj, class
if obj == 'O.C13I12' then do
end
if symbol('M.O.CLA.class') ^== 'VAR' then
call err 'class' class 'is not initialized'
m.o.obj2cla.obj = class
return obj
endProcedure oMutate
oSay: procedure expose m.
parse arg type, a, aPr, mPr
ty = 'O.CLA.'type
msg = mPr || substr(a, length(aPr)+1)
redir = 0
do forever
if type == '=' then do
say msg '=' m.a
return
end
else if abbrev(type, '=') then do
a = m.a
msg = msg '==>' a
redir = 1
type = substr(type, 2)
end
else if left(type, 2) = '<>' then do
k = m.a
a = left(a, lastPos('.', a))k
msg = msg '=<>' k
redir = 1
type = substr(type, 3)
end
else if left(type, 1) = '.' then do
if ^ datatype(m.a.0, 'n') then
call err 'type' type 'not stem but m.'a'.0 is' m.a.0
type = substr(type, 2)
if redir then do
say msg 'stem 1..'m.a.0':' type
end
else do
do y=1 to m.a.0
call oSay type, a'.'y, a'.', mPr' '
end
end
return
end
else if redir then do
say msg':' type
return
end
else do
leave
end
end
if m.ty.val = '=' then
say msg '=' m.a
else
say msg '=' m.a':' m.ty.val
/* call oSay m.ty.val, a,==>' m.a '(to' m.ty.val')' */
do y=1 to m.ty.fld.0
f = m.ty.fld.y
call oSay m.ty.fld.f , a'.'f, a'.', mPr' '
end
if m.ty.stem ^== '' then
call oSay '.'m.ty.stem, a, a, mPr
return
endProcedure oSay
oClear: procedure expose m.
parse arg type, a, val
if abbrev(type, '.') then do
m.a.0 = 0
end
else if abbrev(type, '<>') then do
m.a = val
call oClear substr(type, 3), left(a, lastPos('.', a))val, val
end
else if abbrev(type, '=') then do
m.a = ''
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.a = val
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oClear m.ty.fld.k, a'.'k, val
end
if m.ty.stem ^== '' then
call m.a.0 = 0
end
return a
endProcedure oClear
oCopy: procedure expose m.
parse arg t, f
if symbol('m.o.obj2cla.f') ^== 'VAR' then
call err f 'has no class'
cl = m.o.obj2cla.f
m.o.obj2cla.t = m.o.obj2cla.f
return oTyCopy(cl, t, f)
endProcedure oCopy
oTyCopy: procedure expose m.
parse arg type, t, f
if abbrev(type, '.') then do
do y=1 to m.f.0
call oTyCopy substr(type, 2), t'.'y, f'.'y
end
m.t.0 = m.f.0
end
else if abbrev(type, '<>') then do
k = m.f
m.t = k
call oTyCopy substr(type, 3), left(t, lastPos('.', t))k,
, left(f, lastPos('.', f))k
end
else if abbrev(type, '=') then do
m.t = m.f
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.t = m.f
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oTyCopy m.ty.fld.k, t'.'k, f'.'k
end
if m.ty.stem ^== '' then
call oTyCopy '.'m.ty.stem, t, f
end
return t
endProcedure oTyCopy
/*--- Run ------------------------------------------------------------*/
oRunner: procedure expose m.
parse arg code
return oRunnerReset(oNew('ORunner'), code)
oRunnerReset: procedure expose m.
parse arg m, pCode
m.m.code = pCode
return m
endProcedure oRunnerReset
oRun: procedure expose m.
parse arg m
interpret m.m.code
return
endProcedure oRun
oIni: procedure expose m.
if m.o.ini = 1 then
return
m.o.ini = 1
call oFldIni
call mapIni
m.o.paTy.0 = 0
call oFldNew '=', '='
call oDecMethods oNewClass('ORunner'), 'oRun call oRun m'
return
endProcedure oIni
/* copy o end *********************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = ''
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
drop m.a.k m.st.kx
end
m.st.0 = 0
if abbrev(a, 'MAP.') then do
do kx=1 to m.map.loKy.a.0
drop m.map.loKy.a.kx m.map.loVa.a.kx
end
m.map.loKy.a.0 = 0
end
return a
endProcedure mapClear
/*--- return a stem of all keys (including removed ones) -------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
if mapValAdr(a, ky) ^== '' then
call err 'duplicate key in mAdd('a',' ky',' val')'
if length(ky) < 200 then do
m.a.ky = val
end
else do
kx = mInc('MAP.LOKY.'a'.0')
m.map.loKy.a.kx = ky
m.map.loVa.a.kx = val
end
if m.map.keys.a ^== '' then
return mAdd(m.map.keys.a, ky)
return
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky)
if vv ^== '' then
m.vv = val
else
call mapAdd a, ky, val
return val
endProcedure mapPut
/*--- return the value pointer for a key, '' if non existang ---------*/
mapValAdr: procedure expose m.
parse arg a, ky
if length(ky) < 200 then do
if symbol('m.a.ky') == 'VAR' then
return a'.'ky
end
else if ^ abbrev(a, 'MAP.') then do
call err 'key too long mapValAdr('a',' ky')'
end
else do
do kx=1 to m.map.loKy.a.0
if m.map.loKy.a.kx == ky then
return 'MAP.LOVA.'a'.'kx
end
end
return ''
endProcedure mapValAdr
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
val = m.a.ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if abbrev(vv, 'MAP.LOVA.') then
call err 'not implemented mapRemove('a',' ky')'
drop m.a.ky
return val
endProcedure mapRemove
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a,
fail if it does not exist ----------------------------------*/
mapGet: procedure expose m.
parse arg a, ky, noKey
vv = mapValAdr(a, ky)
if vv == '' then
call err 'missing key in mapGet('a',' ky')'
return m.vv
endProcedure mapGet
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m end *********************************************************/
/* 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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
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 expose m.
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 by 1
alRc = adrTso(c rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for' c rest
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
endProcedure tsoAlloc
dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
bl = 32760
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
recfm='f b'
bl = bl - (bl // rl)
end
else do
if rl = '' then
rl = bl-4
recfm = substr(atts, 2, 1) 'B'
end
end
if pos('(', dsn) > 0 then
po = 'dsntype(library) dsorg(po)'
else
po = ''
dsn = dsnSetMbr(dsn)
if forCsm == 1 then
return "dataset('"dsn"')" po,
"recfm("space(recfm, 0)") lrecl("rl") blkSize("bl")" ,
"mgmtclas(s005y000) space(10, 1000) cylinder"
else
return "dsn('"dsn"')" po,
"recfm("recfm") lrecl("rl") block("bl")" ,
"mgmtclas(s005y000) 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
copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
call readDDBegin word(frDD, 1)
call writeDDBegin word(toDD, 1)
cnt = 0
do while readDD(word(frDD, 1), r.)
call writeDD word(toDD, 1), r.
cnt = cnt + r.0
end
call readDDEnd word(frDD, 1)
call writeDDEnd word(toDD, 1)
interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
if ggSay == 1 | m.debug == 1 then
say cnt 'records copied from' frSpec 'to' to toSpec
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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(WC) cre=2006-07-27 mod=2006-07-27-12.06.10 F540769 ---
/* rexx ****************************************************************
line- word and character count
***********************************************************************/
parse arg dsn
if dsn = '' then
dsn = "'A540769.KS09A1P.A841H.D2006221.ARCHIVE'"
call adrTso 'alloc dd(wcDD) shr reuse dsn('dsn')'
call readDDBegin wcDD
cc = 0
lc = 0
wc = 0
do bc=1 by 1 while readDD(wcDD, r.)
lc = lc + r.0
do rx = 1 to r.0
cc = cc + length(r.rx)
wc = wc + words(r.rx)
end
if (bc // 1000) == 0 then
say 'lc' lc 'wc' wc 'cc' cc 'lRecL' (cc/lc) 'block' bc
if bc > 200000 then
leave
end
call readDDEnd wcDD
call adrTso 'free dd(wcDD)'
say 'lc' lc 'wc' wc 'cc' cc 'for' dsn
exit
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
/* copy adrTso begin *************************************************/
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
/**********************************************************************
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 */
readDDall:
parse arg ggDD, ggSt
call adrTso 'execio * diskr' ggDD '(stem' ggSt' finis)'
return
endSubroutine readDDall
readDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(readDsn) shr dsn('dsn')'
call readDDall readDsn, ggSt
call adrTso 'free dd(readDsn)'
return
endSubroutine readDsn
/*--- 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 */
/*--- end write a stem to a dsn -------------------------------------*/
writeDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(wriDsn) shr dsn('dsn')'
call adrTso 'execio' value(ggSt'0') ,
'diskw wriDsn (stem' ggSt 'finis)'
call adrTso 'free dd(wriDsn)'
return
/*--- 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 */
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
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 zIspfRc
back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say 'help for rexx' s3
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
return 4
endProcedure help
/* copy err end *****************************************************/
}¢--- A540769.WK.REXX.O08(WK) cre=2007-12-11 mod=2007-12-11-14.07.20 F540769 ---
/* rexx */ 00010000
parse arg a 00020000
if a = '' then 00030000
a = wk 00040000
address tso "exec 'A540769.wk.rexx(alib)' '"a"'" 00050001
exit 00060000
}¢--- A540769.WK.REXX.O08(WKUTIL) cre=2008-01-10 mod=2008-11-24-17.34.32 F540769 ---
/* REXX ********************************************************** 00010012
00020012
Sample DB2 Stored procedure, as described in 00030012
Application Programming Guide 00040012
00050012
SP executes db2 Utilities via dsnUtils: 00060012
the list of TS received as argument is copied 00070012
00080012
warning: see wiki for authorization problems 00090012
e.g. we call A540769.DSNUTILS and not SYSPROC.DSNUTILS| 00100012
00110012
CREATE PROCEDURE A540769.WKUTIL 00120012
(IN CMDTEXT VARCHAR(254) FOR SBCS DATA CCSID EBCDIC , 00130012
OUT CMDRESULT VARCHAR(32704) FOR SBCS DATA CCSID EBCDIC ) 00140012
DYNAMIC RESULT SETS 1 00150012
EXTERNAL NAME 'WKUTIL' 00160012
LANGUAGE REXX PARAMETER STYLE GENERAL NOT DETERMINISTIC FENCED 00170012
CALLED ON NULL INPUT MODIFIES SQL DATA NO DBINFO 00180012
COLLID DSNREXDE WLM ENVIRONMENT DB2DSNR ASUTIME LIMIT 60 00190012
STAY RESIDENT NO PROGRAM TYPE MAIN SECURITY DB2 00200012
INHERIT SPECIAL REGISTERS STOP AFTER SYSTEM DEFAULT FAILURES 00210012
RUN OPTIONS 'TRAP(ON)' COMMIT ON RETURN NO ; 00220012
00230012
put rexx into TSS.SKA.DATA.DB2.STORPROC.EXEC 00240012
00250012
***********************************************************************/00260012
00270012
PARSE ARG arg /* Get the DB2 command text */ 00280000
00290000
call errReset 'h' 00300016
say 'db2UtilP --- wkutil start v1.2' time() 00310012
say 'wkutil arg' arg 'userid' userid() 00320000
/*call sqlConnect 'DBAF' ????????? */ 00330015
call sqlConnect '-' 00340015
call sqlShow 'wkUtil' 00350000
if 1 then
call autTest 00360015
if 0 then do
st = "wkUtil calls wkUtilSub" 0037
rst = 'NO' 0038
say 'before call st='st 'rst='rst 0039
call sqlExec "call A540769.WKUTILSUB ( :st, :rst)" 0040
say 'after call st='st 'rst='rst 0041
end
prc = 'DB2ADMIN.dsnUtils' 00420009
id = m.user'.DB2UT' 00420009
rst = 'NO' 00430000
retcode = -9876 00440000
e = '' 00450000
z = 0 00460000
st = "TEMPLATE TCOPYD", 00470000
"DSN('&SSID..&DB..&TS..P&PART..&UQ.')", 00480011
"DATACLAS(NULL12) MGMTCLAS(COM#A011) STORCLAS(FAR$N)", 00490000
"SPACE (150,3750) TRK UNCNT 59; listdef lst" 00500009
do wx=1 to words(arg) 00510009
st = st "include tablespace" word(arg, wx) "partlevel" 00520009
end 00530009
st = st"; copy list lst copyddn(tcopyd) shrlevel change;" 00540009
upper st 00550000
say timing() 'call' prc 'utility statements' st 00560014
call sqlExec "call" prc "( :id, :rst,", 00570012
":st,:retcode, :ANY" copies(',:e,:e,:z',12) ")" 00580000
say timing() 'utility retCode' retCode 00590014
call sqlExec , 00600009
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE' prc 00610000
say 'results' results 00620000
if 1 then do
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS' 0063
say 'allocated c111' 0064
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0 0065
say 'sysPrint' seq strip(txt, 't') 0066
end 0067
call sqlExec 'close c111' 0068
say 'closed c111' 0069
end
sst='SELECT SEQNO,TEXT FROM SYSIBM.SYSPRINT ORDER BY SEQNO' 00700000
call sqlExec "PREPARE S2 FROM :sst" 00710009
call sqlExec "DECLARE C2 CURSOR FOR S2" 00720009
call sqlExec "OPEN C2" 00730009
say 'wkUtil opened c2 ending' 00740000
return 00750012
endMain stored procedure 00760012
00770015
autTest: procedure expose m. 00780015
call sqlExec 'set :oldPkgSet = current packageset', '*' 00790015
say '*** autTest oldPkgSet =' oldPkgSet 00800015
call autTestOne '' 00810016
call autTestOne 'DSNREXCS' 00810016
call autTestOne 'DB2ADMIN' 00820016
/* call sqlExec 'set current packageset = :oldPkgSet', '*' 00840015
say '*** autTest switche back to PkgSet =' oldPkgSet 00860015
*/ call sqlExec 'set :act = current packageset', '*' 00850015
say '*** autTest returning with PkgSet =' act 00860015
return 00870015
endProcedure autTest 00880015
00890015
autTestOne: procedure expose m. 00900015
parse arg pkgSet 00910015
if sqlExec('set current packageset = :pkgSet', '*') < 0 then 00920015
say ' set packageSet' pkgSet sqlMsg() 01080016
call sqlExec 'set :act = current packageset', '*' 00930015
say '*** autTestOne with pkgSet' pkgSet '=' act 00940015
se = 'select WK011CH20 from A540769A.TWK011A' 00950015
call autTestSel se 00960015
call autTestSel se 'where 1 = 0' 00970015
up = "update A540769A.TWK011A set WK011CH2 = 'q'" 00980015
call autTestUpd up 00990015
call autTestUpd up 'where 1 = 0' 01000015
return 01010015
endProcedure autTestOne 01020015
01030015
autTestSel: procedure expose m. 01040015
parse arg sel 01050015
v='' 01130015
if sqlExec('prepare s7 from :sel', '*') < 0 then 01070016
res = 'prepare' sqlMsg()
else if sqlExec('declare c7 cursor for s7', '*') < 0 then 01090016
res = 'declare c7'sqlMsg() 01100016
else if sqlExec('open c7', '*') < 0 then 01110015
res = 'open' sqlMsg() 01120015
else if sqlExec('fetch c7 into :v', '*') < 0 then 01140015
res = 'fetch' sqlMsg() 01120015
else
res = 'fetched' sqlCode 'v='strip(v) 01150015
if sqlExec('close c7', '*') < 0 then 01160015
res = res '(close' sqlCode')'
say ' testSel' sel res 01170015
return 01180015
endTestSel 01190015
01200015
autTestUpd: procedure expose m. 01210015
parse arg upd 01220015
if sqlExec('prepare s7 from :upd', '*') < 0 then 01070016
res = 'prepare s7' sqlMsg()
else if sqlExec('execute s7', '*') < 0 then 01240015
res = 'execute s7' sqlMsg()
else
res = 'ok sqlCode' sqlCode
say ' testUpd' upd res 01250015
return 01260015
endTestUpd 01270015
timing: procedure 01280014
return time() sysvar('syscpu') 01290014
01300014
sqlShow: procedure expose m. 01310000
parse arg pr 01320000
call sqlPreAllCl 5,'SELECT current sqlid, user, current packageset',01330009
'from sysibm.sysDummy1' , st , ':id, :us, :pa' 01340009
if m.st.0 <> 1 then 01350009
call err 'sysDummy1 <> 1' 01360009
say pr 'sqlId' id 'user' us 'pkg' pa 01370009
m.user = us
return 01380000
endProcedure sqlShow 01390009
/* copy sql begin ***************************************************01400009
sql interface 01410009
***********************************************************************/01420009
sqlIni: procedure expose m. 01430009
m.sqlNull = '---' 01440009
return 01450009
endProcedure sqlIni 01460009
01470009
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/01480009
sqlPrepare: procedure expose m. 01490009
parse arg cx, src, descOut, descInp 01500009
s = '' 01510009
if descOut == 1 then 01520009
s = 'into :M.SQL.'cx'.D' 01530009
call sqlExec 'prepare s'cx s 'from :src' 01540009
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then 01550009
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I' 01560009
else 01570009
m.sql.cx.i.sqlD = 0 01580009
return 01590009
endProcedure 01600009
01610009
/*--- prepare and declare 'c'cx from sql src -------------------------*/01620009
sqlPreDeclare: procedure expose m. 01630009
parse arg cx, src, descOut, descInp 01640009
call sqlPrepare cx, src, descOut, descInp 01650009
call sqlExec 'declare c'cx 'cursor for s'cx 01660009
return 01670009
endProcedure sqlPreDeclare 01680009
01690009
/*--- prepare, declare and open 'c'cx from sql src -------------------*/01700009
sqlPreOpen: procedure expose m. 01710009
parse arg cx, src, descOut, descInp 01720009
call sqlPreDeclare cx, src, descOut, descInp 01730009
call sqlOpen cx 01740009
return 01750009
endProcedure sqlPreOpen 01760009
01770009
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/01780009
sqlOpen: procedure expose m. 01790009
parse arg cx, ggRet 01800015
do ix=1 to arg()-1 01810009
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1) 01820009
end 01830009
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I', ggRet 01840015
return 01850009
endProcedure sqlOpen 01860009
01870009
/*--- close cursor 'c'cx ---------------------------------------------*/01880009
sqlClose: procedure expose m. 01890009
parse arg cx, ggRet 01900015
return sqlExec('close c'cx, ggRet) 01910015
endProcedure sqlClose 01920009
01930009
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/01940009
sqlFetchInto: 01950009
parse arg ggCx, ggVars 01960009
if ggVars == '' then 01970009
ggVars = 'descriptor :M.SQL.'ggCX'.D' 01980009
/* accept sqlCodes > 0 except 100 */ 01990009
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100 02000009
endProcedure sqlFetchInto 02010009
02020009
/*--- return sql variable list for stem st and fields the word in vars 02030009
if withInd == 1 then with sqlIndicator variables 02040009
sqlVars('S', 'A B') --> ':S.A, :S.B' 02050009
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND' 02060009
----------------------------------------------------------------------*/02070009
sqlVars: procedure expose m. 02080009
parse arg st, vars, withInd 02090009
res = '' 02100009
if st ^== '' then 02110009
st = st'.' 02120009
do ix=1 to words(vars) 02130009
res = res', :'st || word(vars, ix) 02140009
if withInd == 1 then 02150009
res = res ':'st || word(vars, ix)'.SQLIND' 02160009
end 02170009
return substr(res, 3) 02180009
endProcedure sqlVars 02190009
02200009
sqlVarsNull: procedure expose m. 02210009
parse arg st, vars 02220009
hasNulls = 0 02230009
do ix = 1 to words(vars) 02240009
fld = word(vars, ix) 02250009
if m.st.fld.sqlInd < 0 then do 02260009
m.st.fld = m.sqlNull 02270009
hasNulls = 1 02280009
end 02290009
end 02300009
return hasNulls 02310009
endProcedure sqlVarsNull 02320009
02330009
sqlDescNull: procedure expose m. 02340009
parse arg cx 02350009
desc = 'SQL.'ggCX'.D', 02360009
hasNulls = 0 02370009
do ix=1 to m.desc.SQLD 02380009
if m.desc.ix.sqlInd < 0 then do 02390009
m.desc.ix.sqlData = m.sqlNull 02400009
hasNulls = 1 02410009
end 02420009
end 02430009
return hasNulls 02440009
endProcedure sqlDescNull 02450009
02460009
/*--- open cursor 'c'cx fetch all into variables vars and close 02470009
st = passed stem, sx = row number 02480009
return number of rows fetched ----------------------------------*/02490009
sqlOpAllCl: 02500009
parse arg ggCx, st, ggVars 02510009
do ggAx=4 to arg() 02520009
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx) 02530009
end 02540009
call sqlOpen ggCx 02550009
do sx = 1 while sqlFetchInto(ggCx, ggVars) 02560009
end 02570009
m.st.0 = sx - 1 02580009
call sqlClose ggCx 02590009
return m.st.0 02600009
endProcedure sqlOpAllCl 02610009
02620009
sqlDataSet: procedure expose m. 02630009
parse arg da, ix, val 02640009
m.da.ix.sqlData = val 02650009
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull) 02660009
return 02670009
endProcedure sqlDataSet 02680009
/*--- prepare, declare open cursor 'c'cx, fetch all and close 02690009
return number of rows fetched ----------------------------------*/02700009
sqlPreAllCl: 02710009
parse arg ggCx, ggSrc, st, ggVars 02720009
call sqlPreDeclare ggCx, ggSrc 02730009
return sqlOpAllCl(ggCx, st, ggVars) 02740009
endProcedure sqlPreAllCl 02750009
02760009
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/02770009
sqlExecute: 02780009
parse arg ggCx 02790009
do ggAx=2 to arg() 02800009
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx) 02810009
end 02820009
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I' 02830009
return 02840009
endProcedure 02850009
02860009
/*--- execute immediate the sql src ----------------------------------*/02870009
sqlExImm: procedure expose m. 02880009
parse arg src 02890009
call sqlExec 'execute immediate :src' 02900009
return 02910009
endProcedure sqlExImm 02920009
02930009
sqlCommit: procedure expose m. 02940009
parse arg src 02950009
return sqlExec('commit') 02960009
endProcedure sqlCommit 02970009
02980009
/*--- execute sql thru the dsnRexx interface -------------------------*/02990009
sqlExec: /* no procedure, to keep variables sql... */ 03000009
parse arg ggSqlStmt, ggRet, ggNo 03010009
if ggNo <> '1' then 03020009
ggSqlStmt = 'execSql' ggSqlStmt 03030009
address dsnRexx ggSqlStmt 03040009
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */ 03050009
if rc = 0 then 03060009
return 0 03070009
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then 03080009
return sqlCode 03090009
else if rc < 0 then 03100009
call err sqlmsg() 03110009
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then 03120009
call errSay sqlMsg(), ,'w' 03130009
return sqlCode 03140009
endSubroutine sqlExec 03150009
03160009
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure
parse arg ggSys, ggRetCon
call sqlIni
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
if ggSys = '-' then
return 0
return sqlExec("connect" ggSys, ggRetCon ,1)
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure 03320009
parse arg ggRet 03330009
call sqlExec "disconnect ", ggRet, 1 03340009
return 03350009
endProcedure sqlDisconnect 03360009
03370009
/*--- issue an sql error message -------------------------------------*/03380009
sqlMsg: /* no procedure, to keep variables sql... */ 03390009
signal on syntax name sqlMsgOnSyntax 03400009
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' , 03410009
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',', 03420009
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10) 03430009
if 0 then 03440009
sqlMsgOnSyntax: do 03450009
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x), 03460009
'<<rexx sqlCodeT not found or syntax>>\nwarnings' 03470009
do ggX=0 to 10 03480009
if sqlWarn.ggx <> '' then 03490009
ggRes = ggRes ggx'='sqlWarn.ggx 03500009
end 03510009
end 03520009
signal off syntax 03530009
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt 03540009
ggPref = '\nwith' 03550009
ggXX = pos(':', ggSqlStmt)+1 03560009
do 12 while ggXX > 1 03570009
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX) 03580009
if ggYY < 1 then 03590009
ggYY = length(ggSqlStmt) + 1 03600009
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX) 03610009
if ggVar <> '' then do 03620009
ggRes = ggRes || ggPref ggVar '=' value(ggVar) 03630009
ggPref = '\n ' 03640009
end 03650009
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1 03660009
end 03670009
return ggRes 03680009
endSubroutine sqlMsg 03690009
03700009
/*--- send a command to db2 through the TSO dsn processor ------------*/03710009
sqlDsn: procedure expose m. 03720009
parse arg st, sys, cmd, rcOk 03730009
x = outtrap('M.'st'.') 03740009
push 'END' 03750009
push cmd 03760009
rr = adrTso('DSN SYSTEM('sys')', '*') 03770009
x = outtrap(off) 03780009
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then 03790009
return rr 03800009
fl = max(1, m.st.0 - 10) 03810009
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd, 03820009
'\nOuputlines' fl '-' m.st.0':' 03830009
do lx=fl to m.st.0 03840009
em = em '\n' strip(m.st.lx, 't') 03850009
end 03860009
call err em 03870009
endProcedure sqlDsn 03880009
/* copy sql end **************************************************/03890009
/* copy adrTso begin *************************************************/ 03900009
/*--- send ggTsoCmd to tso, fail if rc <> 0 or not listed in ggRet ---*/03910009
adrTso: 03920009
parse arg ggTsoCmd, ggRet 03930009
address tso ggTsoCmd 03940009
if rc == 0 then return 0 03950009
else if ggRet == '*' then return rc 03960009
else if wordPos(rc, ggRet) > 0 then return rc 03970009
else 03980009
call err 'adrTso rc' rc 'for' ggTsoCmd 03990009
return /* end adrTso */ 04000009
04010009
/*--- format dsn from tso format to jcl format -----------------------*/04020009
dsn2jcl: procedure 04030009
parse arg dsn ., addPrefix 04040009
if left(dsn,1) = "'" then 04050009
return strip(dsn, 'b', "'") 04060009
sp = sysvar('SYSPREF') 04070009
if sp == '' then 04080009
sp = userid() 04090009
cx = pos('~', dsn) 04100009
if cx < 1 & addPrefix == 1 then 04110009
return sp'.'dsn 04120009
do while cx ^== 0 04130009
le = left(dsn, cx-1) 04140009
ri = substr(dsn, cx+1) 04150009
if right(le, 1) == '.' | left(ri, 1) == '.' then 04160009
dsn = le || sp || ri 04170009
else 04180009
dsn = le || left('.', le ^== '') || sp , 04190009
|| left('.', ri ^== '') || ri 04200009
cx = pos('~', spec, cx) 04210009
end 04220009
return dsn 04230009
endProcedure dsn2Jcl 04240009
04250009
/*--- format dsn from jcl format to tso format -----------------------*/04260009
jcl2dsn: procedure 04270009
parse arg dsn . 04280009
return "'"dsn"'" 04290009
endProcedure jcl2dsn 04300009
04310009
dsnSetMbr: procedure 04320009
parse arg dsn, mbr 04330009
bx = pos('(', dsn) 04340009
if bx > 0 then 04350009
dsn = strip(left(dsn, bx-1)) 04360009
if mbr <> '' then 04370009
dsn = dsn'('strip(mbr)')' 04380009
return dsn 04390009
endProcedure dsnSetMbr 04400009
04410009
dsnGetMbr: procedure 04420009
parse arg dsn 04430009
lx = pos('(', dsn) 04440009
rx = pos(')', dsn, lx+1) 04450009
if lx < 1 then 04460009
return '' 04470009
else if lx < rx then 04480009
return substr(dsn, lx+1, rx-lx-1) 04490009
else 04500009
return strip(substr(dsn,lx+1)) 04510009
endProcedure dsnGetMbr 04520009
/********************************************************************** 04530009
io: read or write a dataset with the following callsequences: 04540009
read: readDDBegin, readDD*, readDDEnd 04550009
write: writeBegin, writeDD*, writeEnd 04560009
04570009
readDD returns true if data read, false at eof 04580009
***********************************************************************/04590009
04600009
/*--- prepare reading from a DD --------------------------------------*/04610009
readDDBegin: procedure 04620009
return /* end readDDBegin */ 04630009
04640009
/*--- read from DD ggDD into ggSt, return false at eof ---------------*/04650009
readDD: 04660009
parse arg ggDD, ggSt, ggCnt 04670009
if ggCnt = '' then 04680009
ggCnt = 100 04690009
call adrTso 'execio' ggCnt 'diskr' ggDD '(stem' ggSt')', 2 04700009
return (value(ggSt'0') > 0) 04710009
return /* end readDD */ 04720009
04730009
/*--- finish reading DD ggDD ----------------------------------------*/04740009
readDDEnd: procedure 04750009
parse arg ggDD 04760009
call adrTso 'execio 0 diskr' ggDD '(finis)' 04770009
return /* end readDDEnd */ 04780009
04790009
/*--- prepare writing to DD ggDD -------------------------------------*/04800009
writeDDBegin: procedure 04810009
parse arg ggDD 04820009
/* ensure file is erased, if no records are written */04830009
call adrTso 'execio' 0 'diskw' ggDD '(open)' 04840009
return /* end writeDDBegin */ 04850009
04860009
/*--- write to gg ggDD from stem ggSt, ggCnt records -----------------*/04870009
writeDD: 04880009
parse arg ggDD, ggSt, ggCnt 04890009
if ggCnt == '' then 04900009
ggCnt = value(ggst'0') 04910009
call adrTso 'execio' ggCnt 'diskw' ggDD '(stem' ggSt')' 04920009
return 04930009
endSubroutine writeDD 04940009
04950009
/*--- end writing to dd ggDD (close) --------------------------------*/ 04960009
writeDDEnd: procedure 04970009
parse arg ggDD 04980009
call adrTso 'execio 0 diskw' ggDD '(finis)' 04990009
return /* end writeDDEnd */ 05000009
05010009
/*--- alloc a dsn or a dd 05020009
spec '-'<ddName> 05030009
datasetName? disposition? '.'? attributes? (':' newAtts)?05040009
disp default disposition 05050009
dd default dd name 05060009
retRc erlaubte ReturnCodes (leer = 0) 05070009
returns if ok then ddName <rexx for free> otherwise rc -----*/05080009
dsnAlloc: procedure expose m. 05090009
parse upper arg spec, disp, dd, retRc 05100009
ds = '' 05110009
m.dsnAlloc.dsn = ds 05120009
if left(spec, 1) = '-' then 05130009
return strip(substr(spec, 2)) 05140009
if left(spec, 1) = '&' then /* external spec is handled ok */ 05150009
spec = strip(substr(spec, 2)) 05160009
do wx=1 by 1 05170009
w = word(spec, wx) 05180009
if w = '' | abbrev(w, '.') | abbrev(w, ':') then 05190009
leave 05200009
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then05210009
disp = w 05220009
else if w = 'CATALOG' then 05230009
disp = disp w 05240009
else if abbrev(w, 'DD(') then 05250009
dd = substr(w, 4, length(w)-4) 05260009
else if abbrev(w, 'DSN(') then 05270009
ds = strip(substr(w, 5, length(w)-5)) 05280009
else if ds = '' then 05290009
ds = dsn2jcl(w) 05300009
else 05310009
leave 05320009
end 05330009
rest = subword(spec, wx) 05340009
if abbrev(rest, '.') then 05350009
rest = substr(rest, 2) 05360009
parse var rest rest ':' nn 05370009
if dd <> '' & ds = '' & rest = '' & ^ abbrev(disp, 'SYSO') then 05380009
call err "'return" dd"' no longer supported please use ="dd 05390009
if dd = '' then do 05400009
if symbol('m.adrTso.ddNum') = 'VAR' then 05410009
dd = m.adrTso.ddNum + 1 05420009
else 05430009
dd = 1 05440009
m.adrTso.ddNum = dd 05450009
dd = 'DD' || dd 05460009
end 05470009
if disp = '' then 05480009
disp = 'SHR' 05490009
else if pos('(', ds) < 1 then 05500009
nop 05510009
else if disp = 'MOD' then 05520009
call err 'disp mod for' ds 05530009
else 05540009
disp = 'SHR' 05550009
m.dsnAlloc.dsn = ds 05560009
if pos('/', ds) > 0 then 05570009
return csmAlloc(dd, disp, ds, rest, nn, retRc) 05580009
else 05590009
return tsoAlloc(dd, disp, ds, rest, nn, retRc) 05600009
endProcedure dsnAlloc 05610009
05620009
tsoAlloc: procedure expose m. 05630009
parse arg dd, disp, dsn, rest, nn, retRc 05640009
c = 'alloc dd('dd')' disp 05650009
if dsn <> '' then 05660009
c = c "DSN('"dsn"')" 05670009
if retRc <> '' | nn = '' then do 05680009
alRc = adrTso(c rest, retRc) 05690009
if alRc <> 0 then 05700009
return alRc 05710009
return dd 'call adrTso "free dd('dd')";' 05720009
end 05730009
do retry=0 to 1 05740009
alRc = adrTso(c rest, '*') 05750009
if alRc = 0 then 05760009
return dd 'call adrTso "free dd('dd')";' 05770009
if nn = '' | wordPos(disp, 'OLD SHR') < 1 , 05780009
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then 05790009
leave 05800009
say 'tsoAlloc rc' alRc 'for' c rest '...trying to create' 05810009
call adrTso 'alloc dd('dd') new catalog' dsnCreateAtts(dsn, nn) 05820009
call adrTso 'free dd('dd')' 05830009
end 05840009
call err 'tsoAlloc rc' alRc 'for' c rest 05850009
endProcedure tsoAlloc 05860009
05870009
dsnCreateAtts: procedure expose m. 05880009
parse arg dsn, atts 05890009
if abbrev(atts, ':') then do 05900009
rl = substr(atts, 3) 05910009
if abbrev(atts, ':F') then do 05920009
if rl = '' then 05930009
rl = 80 05940009
atts = 'recfm(f b) lrecl('rl')' , 05950009
'block(' (32760 - 32760 // rl)')' 05960009
end 05970009
else do 05980009
if rl = '' then 05990009
rl = 32756 06000009
atts = 'recfm('substr(atts, 2, 1) 'b) lrecl('rl')' , 06010009
'block(32760)' 06020009
end 06030009
end 06040009
if pos('(', dsn) > 0 then 06050009
atts = atts 'dsntype(library) dsorg(po)' , 06060009
"dsn('"dsnSetMbr(dsn)"')" 06070009
else 06080009
atts = atts "dsn('"dsn"')" 06090009
return atts 'mgmtclas(s005y000) space(10, 1000) cyl' 06100009
endProcedure dsnCreateAtts 06110009
06120009
/*--- read the dataset specified in ggDsnSpec to stem ggSt -----------*/06130009
readDSN: 06140009
parse arg ggDsnSpec, ggSt 06150009
ggAlloc = dsnAlloc(ggDsnSpec, 'SHR', 'readDsN') 06160009
call adrTso 'execio * diskr' word(ggAlloc, 1) '(stem' ggSt' finis)' 06170009
interpret subword(ggAlloc, 2) 06180009
return 06190009
endSubroutine readDsn 06200009
06210009
/*--- write the dataset specified in ggDsnSpec from stem ggSt 06220009
write ggCnt records if not empty otherwise ggst0 06230009
if ggSay 1 then say ... records written to ... -------------*/06240009
writeDSN: 06250009
parse arg ggDsnSpec, ggSt, ggCnt, ggSay 06260009
if ggCnt == '' then 06270009
ggCnt = value(ggst'0') 06280009
ggAlloc = dsnAlloc(ggDsnSpec, 'OLD', 'readDsN') 06290009
call adrTso 'execio' ggCnt 'diskw' word(ggAlloc, 1) , 06300009
'(stem' ggSt 'open finis)' 06310009
interpret subword(ggAlloc, 2) 06320009
if ggSay == 1 | m.debug == 1 then 06330009
say ggCnt 'records written to' ggDsnSpec 06340009
return 06350009
endSubroutine writeDsn 06360009
/* copy adrTso end ****************************************************/06370009
/* copy err begin ******************************************************06380009
messages, errorhandling,help 06390009
***********************************************************************/06400009
/* configure err -----------------------------------------------------*/06410009
errReset: procedure expose m. 06420009
parse arg oo, ha 06430009
if pos('I', translate(oo)) > 0 then 06440009
call adrIsp 'control errors return' 06450009
m.err.opt = translate(oo, 'h', 'H') 06460009
if ha == '' then 06470009
drop m.err.handler 06480009
else 06490009
m.err.handler = ha 06500009
return 06510009
endSubroutine errReset 06520009
06530009
/*--- error routine: abend with message ------------------------------*/06540009
err: 06550009
parse arg ggTxt, ggOpt 06560009
drop err handler opt 06570009
if ggOpt == '' & symbol('m.err.handler') == 'VAR' then 06580009
interpret m.err.handler 06590009
call errSay ggTxt 06600009
parse source . . ggS3 . /* current rexx */06610009
if ggOpt == '' | ggOpt == '*' then 06620009
ggOpt = translate(value('m.err.opt'), 'ht', 'HT') 06630009
if pos('h', ggOpt) > 0 then do 06640009
say 'fatal error in' ggS3': divide by zero to show stackHistory'06650009
x = 1 / 0 06660009
end 06670009
say 'fatal error in' ggS3': exit(12)' 06680009
exit errSetRc(12) 06690009
endSubroutine err 06700009
06710009
/*--- assert that the passed rexx expression evaluates to true -------*/06720009
assert: 06730009
interpret 'assertRes =' arg(1) 06740009
if ^ assertRes then 06750009
call err 'assert failed' arg(1)':' arg(2) 06760009
return 06770009
endProcedure assert 06780009
06790009
/*--- say an errorMessage msg with pref pref 06800009
split message in lines at '/n' 06810009
say addition message in stem st ---------------------------*/06820009
errSay: procedure expose m. 06830009
parse arg msg, st, pref 06840009
parse source . . ggS3 . /* current rexx */06850009
if pref == 'e' | (pref == '' & st == '') then 06860009
msg = 'fatal error:' msg 06870009
else if pref == 'w' then 06880009
msgf = 'warning:' msg 06890009
else if pref == 0 then 06900009
nop 06910009
else if right(pref, 1) ^== ' ' then 06920009
msg = pref':' msg 06930009
else 06940009
msg = pref || msg 06950009
sx = 0 06960009
bx = -1 06970009
do lx=1 until bx >= length(msg) 06980009
ex = pos('\n', msg, bx+2) 06990009
if ex < 1 then 07000009
ex = length(msg)+1 07010009
if st == '' then do 07020009
say substr(msg, bx+2, ex-bx-2) 07030009
end 07040009
else do 07050009
sx = sx+1 07060009
m.st.sx = substr(msg, bx+2, ex-bx-2) 07070009
m.st.0 = sx 07080009
end 07090009
bx = ex 07100009
end 07110009
return 07120009
endProcedure errSay 07130009
07140009
/*--- abend with Message after displaying help -----------------------*/07150009
errHelp: procedure expose m. 07160009
parse arg msg, op 07170009
say 'fatal error:' msg 07180009
call help 07190009
call err msg, op 07200009
endProcedure errHelp 07210009
07220009
/*--- set rc for ispf: -------------------------------------------------07230009
if a cmd is run by ispStart, its RC is ignored, 07240009
but ISPF passes the value of the shared varible 3IspfRc 07250009
back as return code 07260009
----------------------------------------------------------------------*/07270009
errSetRc: procedure 07280009
parse arg zIspfRc 07290009
if sysVar('sysISPF') = 'ACTIVE' then do 07300009
address ispExec vput 'zIspfRc' shared 07310009
end 07320009
return zIspfRc 07330009
endProcedure errSetRc 07340009
07350009
/*--- output a trace message if m.trace is set -----------------------*/07360009
trc: procedure expose m. 07370009
parse arg msg 07380009
if m.trace == 1 then 07390009
say 'trc:' msg 07400009
return 07410009
endProcedure trc 07420009
07430009
/*--- quote string txt using quoteChar qu ("""" ==> ") ---------------*/07440009
quote: procedure 07450009
parse arg txt, qu 07460009
if qu = '' then 07470009
qu = '"' 07480009
res = qu 07490009
ix = 1 07500009
do forever 07510009
qx = pos(qu, txt, ix) 07520009
if qx = 0 then 07530009
return res || substr(txt, ix) || qu 07540009
res = res || substr(txt, ix, qx-ix) || qu || qu 07550009
ix = qx + length(qu) 07560009
end 07570009
endProcedure quote 07580009
07590009
debug: procedure expose m. 07600009
parse arg msg 07610009
if m.debug == 1 then 07620009
say 'debug' msg 07630009
return 07640009
endProcedure debug 07650009
07660009
/*--- return current time and cpu usage ------------------------------*/07670009
timing: procedure 07680009
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */ 07690009
07700009
/--- display the first comment block of the source as help -----------*/07710009
help: procedure 07720009
parse source . . s3 . 07730009
say right(' help for rexx' s3, 79, '*') 07740009
do lx=1 by 1 07750009
if pos('/*', sourceLine(lx)) > 0 then 07760009
leave 07770009
else if lx > 10 then do 07780009
say 'initial commentblock not found for help' 07790009
return 07800009
end 07810009
end 07820009
do lx=lx+1 by 1 07830009
li = strip(sourceLine(lx), 't', ' ') 07840009
if pos('*/', li) > 0 then 07850009
leave 07860009
say li 07870009
end 07880009
say right(' end help for rexx' s3, 79, '*') 07890009
return 4 07900009
endProcedure help 07910009
/* copy err end *****************************************************/07920009
}¢--- A540769.WK.REXX.O08(WL) cre=2006-06-28 mod=2006-06-30-11.42.29 F540769 ---
/* rexx ****************************************************************
merge two files
**********************************************************************/
mapDsn = "wk.sql(tsListMR)"
inDsn = "'dsn.dblf.chg.wkl(wkcmpdav)'"
outDsn = "'dsn.dblf.chg.wkl(wkcmpdaw)'"
if 0 then do
x = " und wie geht es dir ? "
say 'orig ' x
say 'r 0 abcdefghi' repWord(x, 0, 'abcdefghi')
say 'r 1 abcdefghi' repWord(x, 1, 'abcdefghi')
say 'r 3 abcdefghi' repWord(x, 3, 'abcdefghi')
say 'r 6 abcdefghi' repWord(x, 6, 'abcdefghi')
say 'r 9 abcdefghi' repWord(x, 9, 'abcdefghi')
exit
end
call readDsn mapDsn, m.mre.
do mx=1 to m.mre.0
tb = strip(substr(m.mre.mx, 3, 12))
ts = strip(substr(m.mre.mx,65,10))'.'strip(substr(m.mre.mx,55,10))
if ts <> '.' then
m.mr.tb = ts
end
call wlReadBegin s, inDsn
do forever
l = wlRead(s, 1)
if l = '' then
leave
w1 = word(m.l, 3)
w2 = word(m.l, 4)
if w2 = 'TABLE' then do
tb = word(m.l, 5)
cx = pos('.', tb)
if cx > 0 then
tNm = substr(tb, cx+1)
else
tNm = tb
ts = ''
if w1 ^= 'CREATE' then
nop /* say w1 w2 m.l */
else do
do forever
l = wlRead(s)
if l = '' then
call err 'no in found'
if word(m.l, 1) = 'IN' then do
ts = word(m.l, 2)
leave
end
end
end
if ts <> '' & symbol("m.mr.tNm") = 'VAR' then do
db = left(ts, pos('.', ts) - 1)
nwTs = m.mr.tNm
nwDb = left(nwTs, pos('.', nwTs) - 1)
if db <> nwDb then
say 'dbChange' db ts '==>' nwDb nwTs
else
m.mt.ts = nwTs
end
end
end
call wlReadEnd s
call wlReadBegin s, inDsn, outDsn
l = wlRead(s, 1)
do while l <> ''
doRead = 1
w1 = word(m.l, 3)
w2 = word(m.l, 4)
if w2 = 'TABLE' then do
tb = word(m.l, 5)
ts = ''
if w1 ^= 'CREATE' then
nop /* say w1 w2 m.l */
else do
do forever
l = wlRead(s)
if l = '' then
call err 'no in found'
if word(m.l, 1) = 'IN' then do
ts = word(m.l, 2)
leave
end
end
end
if symbol("m.mt.ts") = 'VAR' & ts <> m.mt.ts then do
say 'change create table' tb 'ts' ts '==>' m.mt.ts
m.l = strip(repWord(m.l, 2, m.mt.ts), 't')
end
end
else if w2 = 'TABLESPACE' then do
ts = word(m.l, 7)'.'word(m.l, 5)
if w1 ^= 'CREATE' then
say w1 w2 m.l
else if symbol("m.mt.ts") ^= 'VAR' then
say 'keeping new ts' ts symbol("m.mt.ts")
else if ts = m.mt.ts then
nop /* say 'ignoring ts' ts */
else do
nwTs = m.mt.ts
say 'renaming create ts' ts '==>' nwTS
m.l = strip(repWord(m.l, 5,
, substr(nwTs, pos('.', nwTs)+1)), 't')
end
end
if doRead then
l = wlRead(s)
end
call wlReadEnd s
exit
wlReadBegin: procedure expose m.
parse arg m, dsn, cp
dd = 'wlRe'm
call adrTso "alloc dd("dd") shr dsn("dsn")"
call readDDBegin dd
m.m.0 = 0
m.m.blockX = 0
m.m.lineX = 99
m.m.copy = cp <> ''
if m.m.copy then do
call adrTso "alloc dd(wlCp"m") shr dsn("cp")"
call writeDDBegin 'wlCp'm
m.m.cpMark = ''
end
return
endProcedure wlReadBegin
wlRead: procedure expose m.
parse arg m, sql
dd = 'wlRe'm
lx = m.m.lineX
do forEver
if m.m.copy then
if lx > 0 & m.m.cpMark <> '' then
m.m.lx = overlay(m.m.cpMark, m.m.lx, 1)
lx = lx + 1
if lx > m.m.0 then do
m.m.blockX = m.m.blockX + m.m.0
if m.m.copy then
call writeDD 'wlCp'm, 'M.'m'.'
if ^ readDD(dd, 'M.'m'.') then
return ""
lx = 0
end
else do
w1 = word(m.m.lx, 1)
if w1 = '' | left(w1, 1) = '*' then do
end
else if w1 = '-SQL' | sql ^= 1 then do
m.m.lineX = lx
return m'.'lx
end
end
end
endProcedure wlRead
wlReadEnd: procedure expose m.
parse arg m
dd = 'wlRe'm
call readDDEnd dd
call adrTso "free dd("dd")"
if m.m.copy then do
call writeDDEnd 'wlCp'm
call adrTso "free dd(wlCp"m")"
end
return
endProcedure wlReadEnd
say of m.of.0 lf m.lf.0
ox=1
lx=1
mx=0
do while ox <= m.of.0 & lx <= m.lf.0
tof = substr(m.of.ox, 11, 12)
iof = left(m.of.ox, 10)substr(m.of.ox, 31, 20)
tlf = substr(m.lf.lx, 11, 12)
ilf = left(m.lf.lx, 10)substr(m.lf.lx, 31, 20)
if tof << tlf then do
m = 'o' tof || iof
ox = ox + 1
end
else if tof == tlf then do
if substr(iof, 11, 10) == substr(ilf, 11, 10) then
m = '='
else
m = '*'
m = m tlf || iof || ilf
lx = lx + 1
ox = ox + 1
end
else do
m = 'l' tlf || left(' ', 30) || ilf
lx = lx + 1
end
mx = mx + 1
m.mr.mx = m
end
m.mr.0 = mx
call writeDsn "wk.sql(tsListMr)", m.mr.
exit
repWord: procedure
parse arg src, wx, new
if wx < 1 then
return new src
else if wx > words(src) then
return src new
sx = wordIndex(src, wx)
return left(src, sx-1) || new ,
|| substr(src, sx + length(word(src, wx)))
endProcedure repWord
/* copy adrTso begin *************************************************/
/*--- format dsn from tso format to jcl format -----------------------*/
dsn2jcl: procedure
parse arg dsn .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'dsn
endProcedure dsn2Jcl
/*--- format dsn from jcl format to tso format -----------------------*/
dsnFromJcl: procedure
parse arg dsn .
return "'"dsn"'"
endProcedure dsnFromJcl
/**********************************************************************
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 */
readDDall:
parse arg ggDD, ggSt
call adrTso 'execio * diskr' ggDD '(stem' ggSt' finis)'
return
endSubroutine readDDall
readDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(readDsn) shr dsn('dsn')'
call readDDall readDsn, ggSt
call adrTso 'free dd(readDsn)'
return
endSubroutine readDsn
/*--- 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 */
/*--- end write a stem to a dsn -------------------------------------*/
writeDSN:
parse arg dsn, ggSt
call adrTso 'alloc dd(wriDsn) shr dsn('dsn')'
call adrTso 'execio' value(ggSt'0') ,
'diskw wriDsn (stem' ggSt 'finis)'
call adrTso 'free dd(wriDsn)'
return
/*--- 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 */
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
parse arg ggMsg
call errA ggMsg
exit 12
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
x = x / 0
exit setRc(12)
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
say 'fatal error:' ggMsg
call help
call err ggMsg
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 zIspfRc
back as return code
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- display the first comment block of the source as help -----------*/
help: procedure
parse source . . s3 .
say 'help for rexx' s3
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
return 4
endProcedure help
/* copy err end *****************************************************/
}¢--- A540769.WK.REXX.O08(WR) cre= mod= ----------------------------------------
/* copy wr begin *****************************************************
out interface
define a current output destination (a writerDescriptor)
manage them in a stack
convenience function to write to current output
***********************************************************************/
/*--- write stem stem to current output ------------------------------*/
out: procedure expose m.
parse arg stem
call write m.wr.out, stem
return
endProcedure
/*--- write up to 3 strings to current output ------------------------*/
outLn: procedure expose m.
m = m.wr.out
ox=m.wr.wrBuf.m.0
do ax=1 to arg()
ox = ox + 1
m.wr.wrBuf.m.ox = arg(ax)
end
m.wr.wrBuf.m.0 = ox
if ox > 100 then
call write m
return
endProcedure
/*--- write to current output from datasetSpec dss -------------------*/
outDS: procedure expose m.
parse arg dss
call wrFromDS m.wr.out, dss
return
endProcedure outDS
/*--- write reader rx to out -----------------------------------------*/
outReader: procedure expose m.
parse arg rx
call wrReader m.wr.out, rx
return
endProcedure outReader
/*--- redirect current output ----------------------------------------*/
outPush: procedure expose m.
parse arg o, p
x = m.wr.out.0 + 1
m.wr.out.0 = x
m.wr.out.x = m.wr.out
m.wr.prc.x = m.wr.prc
if o ^== '' then
m.wr.out = o
if p ^== '' then
m.wr.prc = p
return
endProcedure outPush
/*--- redirect current output to previous ----------------------------*/
outPop: procedure expose m.
parse arg o
x = m.wr.out.0
m.wr.out.0 = x - 1
m.wr.out = m.wr.out.x
m.wr.prc = m.wr.prc.x
return
endProcedure outPop
/**********************************************************************
writer interface
a writerDescriptor wx is allocated with wrNew
we can define the write and wrClose functionality arbitrarily
***********************************************************************/
/*--- create a new writeDescriptore ----------------------------------*/
wrNew: procedure expose m.
parse arg typ, reuseOK
if m.wr.free.0 < 1 | reuseOK == 0 then do
nn = m.wr.new + 1
m.wr.new = nn
end
else do
fx = m.wr.free.0
m.wr.free.0 = fx - 1
nn = m.wr.free.fx
end
m.wr.prcTyp.nn = typ
m.wr.prcSta.nn = ''
m.wr.wrBuf.nn.0 = 0
return nn
endProcedure wrNew
/*--- free the writeDescriptors arg(1)... ----------------------------*/
wrFree: procedure expose m.
fx = m.wr.free.0
do i = 1 to arg()
fx = fx + 1
m.wr.free.fx = arg(i)
end
m.wr.free.0 = fx
return
endProcedure wrFree
/*--- for writeDescriptor m define write and close -------------------*/
wrDefine: procedure expose m.
parse arg m, m.wr.write.m, m.wr.close.m, wr2, wr3
if wr2 ^== '' then
m.wr.write.m = 'do;' m.wr.write.m'; end;',
'do ggLX=1 to m.stem.0;',
'line = stem"."ggLx;' wr2,
'; end; do;' wr3'; end'
else if wr3 ^== '' then
m.wr.write.m = 'do;' m.wr.write.m'; end; do;' wr3'; end'
return m
endProcedure wrDefine
/*--- write stem m.stem. to writeDescriptor m ------------------------*/
write: procedure expose m.
parse arg m, stem
if m.wr.write.m == 'b' then do
if stem ^== '' then
call wrStem 'WR.WRBUF.'m, , stem
return
end
if m.wr.wrBuf.m.0 ^== 0 then do
ggOrigStem = stem
stem = 'WR.WRBUF.'m
interpret m.wr.write.m
m.wr.wrBuf.m.0 = 0
stem = ggOrigStem
end
if stem ^== '' then
interpret m.wr.write.m
return
endProcedure write
/*--- write up to 3 strings to writeDescriptor m ---------------------*/
writeLn: procedure expose m.
parse arg m
ox=m.wr.wrBuf.m.0
do ax=2 to arg()
ox = ox + 1
m.wr.wrBuf.m.ox = arg(ax)
end
m.wr.wrBuf.m.0 = ox
if ox > 100 then
call write m
return
endProcedure writeLn
/*--- close writeDescriptor m ----------------------------------------*/
wrClose: procedure expose m.
parse arg m
if m.wr.wrBuf.m.0 ^== 0 then
call write m
m.wr.wrbuf.pp.0 = 0 /* in case it was buffering */
interpret m.wr.close.m
return
endProcedure wrClose
/*--- initialisation writer and output -------------------------------*/
wrIni: procedure expose m.
parse arg tr
m.wr.trace = tr = 1
m.wr.new = 0
m.wr.free.0 = 0
m.wr.out = wrNew()
m.wr.sysout = m.wr.out
m.wr.prc = wrNew()
m.wr.rootPrc = m.wr.prc
if m.wr.trace then
m.wr.sysOut = wrDefine(m.wr.out,,,'say "sysout:" quote(m.line)')
else
m.wr.sysOut = wrDefine(m.wr.out,,, 'say strip(m.line, "T")')
m.wr.out.0 = 0
return
endProcedure wrIni
/**** simple convience function for stems *****************************/
/*--- fill stem st from index dx with lines from stem src ------------*/
wrStem: procedure expose m.
parse arg dst, dx, src
if dx == '' then
dx = m.dst.0
do ix = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.ix
end
m.dst.0 = dx
return dst
endProcedure wrStem
/*--- strip trailing spaces from stem dst ----------------------------*/
wrStrip: procedure expose m.
parse arg dst
do ix=1 to m.dst.0
m.dst.ix = strip(m.dst.ix, 't')
end
return dst
endProcedure wrStrip
/*--- fill stem dst from index dx with arguments ---------------------*/
wrArgs: procedure expose m.
parse arg dst, dx
if dx == '' then
dx = m.dst.0
do ix = 3 to arg()
dx = dx + 1
m.dst.dx = arg(ix)
end
m.dst.0 = dx
return dst
endProcedure wrArgs
/***********************************************************************
reader interface
define, read and close
***********************************************************************/
/*--- define read function -------------------------------------------*/
reDefine: procedure expose m.
parse arg m, m.wr.read.m, m.wr.readCLose.m, m.wr.readInfo.m
m.wr.readLX.m = ''
m.wr.readSX.m = 0
m.wr.readEOF.m = 0
return m
endProcedure reDefine
/*--- read from readDescriptor into stem stem
return true if data read, false at eof --------------------*/
read: procedure expose m.
parse arg m, stem
if m.wr.readEOF.m then
return 0
do forever
interpret m.wr.read.m
if ^ res then
return reClose(m)
if m.stem.0 > 0 then do
m.wr.readSX.m = m.wr.readSX.m + m.stem.0
return 1
end
end
endProcedure write
/*--- close readDescriptor m, if not already done --------------------*/
reClose: procedure expose m.
parse arg m
if ^ m.wr.readEOF.m then do
m.wr.readEOF.m = 1
interpret m.wr.readClose.m
end
return 0
endProcedure reClose
/*--- put next line into m.line, return false at eof -----------------*/
readLn: procedure expose m.
parse arg m, line
if m.wr.readLx.m == '' | m.wr.readLx.m >= m.wr.readStem.m.0 then do
if ^ read(m, 'WR.READSTEM.'m) then
return 0
lx = 1
end
else do
lx = 1 + m.wr.readLx.m
end
m.wr.readLx.m = lx
m.line = m.wr.readStem.m.lx
return 1
endProcedure readLn
/*--- return readInfo for line lx ------------------------------------*/
readInfo: procedure expose m.
parse arg m, lx
if m.wr.readEof.m then
txt = 'eof after line' m.wr.readSx.m
else if lx == '' then
txt = 'last line of stem' m.wr.readSx.m
else if lx == '*' then
txt = 'line' (m.wr.readSx.m - m.wr.readStem.m.0 + m.wr.readLX.m)
else
txt = 'line' (m.wr.readSx.m + lx)
return txt 'from dss' m.wr.readInfo.m
endProcedure readInfo
/***********************************************************************
Input-Ouput
transfer data betweeen stems and datasets
these are specified using a DataSetSpec DSS see wrAlloc:
***********************************************************************/
/*--- define writeDescriptor m to write to the datasetSpec dss */
wr2DS: procedure expose m.
parse arg m, dss
ty = wrAlloc(m, 'o', dss)
stmt = ''
if m.wr.allocStrip.m then
stmt = 'call wrStrip stem;'
if ty == 's' then do
call wrDefine m,
, stmt 'call wrStem' quote(m.wr.allocStem.m) ', , stem',
, m.wr.allocFree.m
end
else if ty == 'd' then do
dd = m.wr.allocDD.m
call writeDDBegin dd
call wrDefine m,
, stmt 'call writeDD' quote(dd) ', "M."'stem'"."',
, 'call writeDDEnd' quote(dd)';' m.wr.allocFree.m
end
else
call err 'wr2Ds bad allocType' ty 'from' dss
return m
endProcedure
/*--- define m as reader to read from datasetSpec dss ---------------*/
readDS: procedure expose m.
parse arg m, dss
if dss = '' then
call err 'wrFromDS empty datasetSpecification'
iTyp = wrAlloc(m, 'i', dss)
strp = ''
if m.wr.allocStrip.m then
strp = 'if res then call wrStrip stem;'
if iTyp == 's' then do
m.wr.readDone.m = 0
call reDefine m,
, 'if m.wr.readSX.m ^== 0 then res = 0;else do;' ,
'call wrStem stem, 0,' quote(m.wr.allocStem.m)';' ,
'res = m.stem.0 > 0;' strp 'end', , dss
end
else if iTyp = 'd' then do
dd = quote(m.wr.allocDD.m)
call reDefine m, 'res = readDD('dd', "m."stem".");' strp,
, 'call readDDEnd' dd';' m.wr.AllocFree.m, dss
end
else
call err 'readDS: bad allocTyp' iTyp 'from' dss
return m
endProcedure readDS
/*--- write to writeDescriptor m from readDescriptor r ---------------*/
wrReader: procedure expose m.
parse arg m, r
st = 'WR.FROMREAD.'m
do while read(r, st)
call write m, st
end
return
endProcedure wrReader
/*--- write to writeDescriptor m from datasetSpec dss ----------------*/
wrFromDS: procedure expose m.
parse arg m, dss
rx = wrNew('wrFromDS')
call wrReader m, readDS(rx, dss)
call wrFree rx
return
endProcedure wrFromDS
/*--- write to datasetSpec toSp from datasetSpec arg(2)... -----------*/
wrDSFromDS: procedure expose m.
parse arg toSP
m = wrNew('wrDSFromDS')
call wr2DS m, toSp
do ax=2 to arg()
frSp = arg(ax)
if ax ^= '' then
call wrFromDs m, frSp
end
call wrClose m
call wrFree m
return
endProcedure wrFromDS
/*----------------------------------------------------------------------
wrAlloc: allocate a file or stem withe default ioa
from datasetSpecification dss
dss in key=value syntax, either tso alloc attributes or
disp=...,
dsj= DatasetName in Jcl format (dsn= for tso format)
stem=xyz to allocate a stem m.xyz.*
strip=1 to strip trailing blanks before writing
ioa= i, o or a (input, output or append)
----------------------------------------------------------------------*/
wrAlloc: procedure expose m.
parse arg m, ioa, dss
s = 'WR.ALLOC'
m.wr.allocDD.m = ''
stem = ''
at = ''
disp = ''
m.wr.allocStrip.m = 0
m.wr.allocFree.m = ''
call scanBegin s, dss
do while scanKeyValue(s, 1, 0)
k = m.s.key
if k == 'DD' then m.wr.allocDD.m = m.s.val
else if k == 'DSJ' then at = at "dsn('"m.s.val"')"
else if k == 'STEM' then stem = m.s.val
else if k == 'DISP' then disp = m.s.val
else if k == 'STRIP' then m.wr.allocStrip.m = m.s.val
else if k == 'IOA' then ioa = m.s.val
else if left(m.s.val, 1) = '(' then
at = at m.s.key || m.s.val
else at = at m.s.key"("m.s.val")"
end
if ^scanAtEOL(s) then
call scanErr s, 'wrAlloc bad clause'
upper ioa
if stem ^= '' then do
m.wr.allocStem.m = stem
if ioa == 'O' then /* overrite existing lines */
m.stem.0 = 0
m.wr.allocType.m = 's'
end
else if at = '' then do
if m.wr.allocDD.m = '' then
call err 'dd or attribute must be specified:' dss
m.wr.allocType.m = 'd'
end
else do
m.wr.allocType.m = 'd'
if m.wr.allocDD.m = '' then
m.wr.allocDD.m = 'ALL'm
if disp ^= '' then nop
else if ioa == 'A' then disp = 'mod'
else if ioa == 'O' then disp = 'old'
else disp = 'shr'
if m.wr.allocApp.m = 1 then do
d3 = translate(strip(left(disp, 3)))
if d3 == 'OLD' | d3 == 'SHR' then
disp = 'mod' || substr(strip(disp), 4)
end
call adrTso "alloc dd("m.wr.allocDD.m")" disp at
m.wr.allocFree.m = 'call adrTso' ,
quote('free dd('m.wr.allocDD.m')')
end
return m.wr.allocType.m
endProcedure wrAlloc
/* copy wr end ****************************************************/
}¢--- A540769.WK.REXX.O08(WSH) cre=2007-11-14 mod=2008-11-24-17.34.34 F540769 ---
/* rexx ****************************************************************
wsh
***********************************************************************/
call errReset h
parse arg arg
call sqlOIni
call compIni
if arg = '' then do
if adrEdit('macro (mArgs) NOPROCESS', '*') == 0 then do
if mArgs = '' then do
call adrEdit '(d) = dataset'
call adrEdit '(m) = member'
IF dsnSetMbr(d, m) = 'A540769.WK.REXX(WSH)' then
exit tstAct()
else
exit wshEditMacro(mArgs)
end
arg = mArgs
end
end
parse var arg fun rest
upper fun
if fun = '' then
exit wshBatch('S')
if fun = 'S' | fun = 'D' then
exit wshBatch(fun)
if wordPos(fun, 'R E S D') > 0 then
exit wshInter('-'fun rest)
if wordPos(fun, '-R -E -S -D') > 0 then
exit wshInter(fun rest)
if abbrev(fun, 'T') then
if fun <> 'T' then
c = call fun rest
else do
c = ''
do wx=1 to words(rest)
c = c 'call tst'word(rest, wx)';'
end
if c = '' then
c = call 'tstAct;'
else
c = c 'call tstTotal;'
end
else
call err 'bad fun' fun 'in arg' arg
say 'wsh interpreting' c
interpret c
exit 0
endMain wsh
tstAct: procedure expose m.
return tstSqlStoredWk()
return wshInter('-e')
return tstAll()
return tstMatch()
return tstSql()
call tstPlus
return tstSqlO()
return tstMap()
call tstCsi
return tstCatDsn()
return 0
endProcedure tstAct
wshInter: procedure expose m.
parse arg inp
call compIni
call sqlOini
do forever
w1 = translate(word(inp, 1))
if abbrev(w1, '-') then do
mode = substr(w1, 2)
inp = subWord(inp, 2)
if mode = '' then
return 0
end
if inp <> '' then do
say 'as' mode 'interpreting' inp
if mode = 'R' then
interpret inp
else if mode = 'E' then
interpret 'say' inp
else if mode = 'S' | mode = 'D' then do
call errReset 'h', 'say "******* intercepting error";',
'call errSay ggTxt; return "";'
call oRun compile(comp(jBuf(inp)),
, translate(mode, 'ds', 'DS'))
call errReset 'h'
end
else
say 'mode' mode 'not implemented yet'
end
say 'enter' mode 'expression, - for end, -r or -e for Rexx' ,
'-s or -d for WSH'
parse pull inp
end
endProcedure wshInter
wshBatch: procedure expose m.
parse upper arg ty
call compIni
call sqlOini
i = catDsn("-WSH")
cmp = comp(i)
if pos('D', mArgs) > 0 then
ty = 'd'
else
ty = 's'
r = compile(cmp, ty)
useOut = listDsi('OUT FILE')
useOut = ^ (useOut = 16 & sysReason = 2)
if useOut then
call envPush env('>', '-OUT')
call oRun r
if useOut then
call envPop
return 0
endProcedure wshBatch
/*-- edit macro to call wsh ------------------------------------------*/
wshEditMacro: procedure expose m.
parse upper arg mArgs
call adrIsp 'control errors return'
pc = adrEdit("process dest range Q", 0 4 8 12 16)
dst = ''
if pc = 0 | pc = 8 then do
call adrEdit "(rFi) = lineNum .zFrange"
call adrEdit "(rLa) = lineNum .zLrange"
if pc = 0 then
call adrEdit "(dst) = lineNum .zDest"
else
dst = rLa
end
else if pc = 12 then do
if adrEdit("find first '$***out' 1", 4) = 0 then do
call adrEdit "(dst) = cursor"
call adrEdit "(li) = line" dst
li = overlay(date(s) time(), li, 20)
call adrEdit "line_before" dst "= (li)"
rFi = 1
rLa = dst-1
end
end
if dst = '' then
msg = 'bitte Bereich mit q oder qq auswaehlen ???' rc ,
'oder $***out Zeile einfuegen'
else if rLa < rFi then
msg = 'firstLine' rFi 'before last' rLa
else
msg = ''
if msg ^== '' then do
say msg
return 4
end
/* say 'range' c1 'rc' pc':' rFi '-' rLa 'after' dst */
call compIni
i = jBuf()
o = jBuf()
call jOpen i, 'w'
do lx=rFi to rLa
call adrEdit "(li) = line" lx
call jWrite i, li
end
cmp = comp(i)
if pos('D', mArgs) > 0 then
ty = 'd'
else
ty = 's'
call errReset 'h',
, 'return wshEditCompErrH(ggTxt, ' rFi',' rLa')'
r = compile(cmp, ty)
call errReset 'h',
, 'return wshEditRunErrH(ggTxt, ' quote(o)',' dst')'
call envPush env('>£', o)
call oRun r
call envPop
lab = wshEditInsLinSt(dst+1, , o'.BUF')
call wshEditLocate dst-7
return 0
endProcedure wshEditMacro
wshEditLocate: procedure
parse arg ln
call adrEdit '(la) = linenum .zl'
if la < 40 then
return
if ln < 7 then
ln = 1
else
ln = min(ln, la - 40)
call adrEdit 'locate ' ln
return
endProcedure wshEditLocate
wshEditCompErrH: procedure expose m.
parse arg ggTxt, rFi, rLa
call errReset 'h'
call errSay 'compErr' ggTxt
call errSay ggTxt, ggStem
parse var m.ggStem.3 "pos " pos . " in line " lin":"
if pos = '' then do
parse var m.ggStem.3 " line " lin":"
pos = 0
end
lab = rFi + lin
if pos ^= '' then
lab = wshEditInsLin(lab, 'msgline', right('*',pos))
lab = wshEditInsLinSt((rFi+lin), 'msgline', ggStem)
call wshEditLocate rFi+lin-25
exit 0
endSubroutine wshEditCompErrH
wshEditRunErrH: procedure expose m.
parse arg ggTxt, so, dst
call errReset 'h'
call errSay ggTxt, , '*** run error: '
lab = wshEditInsLinSt(dst+1, , so'.BUF')
call errSay ggTxt, ggStem, '*** run error: '
call wshEditInsLinSt dst+1, msgline, ggStem
exit 0
endSubroutine wshEditRunErrH
wshEditInsLinCmd: procedure
parse arg wh
if datatype(wh, 'n') then do
if adrEdit("label" wh "= .a", 0 8 12) ^= 12 then
return 'line_before .a ='
else
return 'line_after .zl ='
end
else if left(wh, 1) == '.' then
return 'line_before' wh '='
else
return wh
endProcedure wshEditInsLinCmd
wshEditInsLin: procedure
parse arg wh, type
cmd = wshEditInsLinCmd(wh)
do ax=3 to arg()
li = strip(arg(ax), 't')
if li == '' then
iterate
if translate(type) = 'MSGLINE' then do while length(li) > 72
sx = lastPos(' ', li, 72)
if sx < 10 then
sx = 72
one = left(li, sx)
li = ' 'strip(substr(li, sx))
call adrEdit cmd type "(one)"
end
call adrEdit cmd type "(li)", 0 4
end
return cmd
endProcedure wshEditInsLin
wshEditInsLinSt: procedure expose m.
parse arg wh, type, st
cmd = wshEditInsLinCmd(wh)
do ax=1 to m.st.0
call wshEditInsLin cmd, type, m.st.ax
end
return cmd
endProcedure wshEditInsLinSt
listCatClass: procedure expose m. /* ???wkTst remove or move */
parse upper arg dsn
call outtrap x., '*'
call adrTso "listcat volume entry('"dsn"')", 4
rt = rc
call outtrap off
/* say 'listct rc =' rt 'lines' x.0 */
cl = ''
vo = ''
if word(x.1, 3) ^== dsn then
call jOut 'err ??? for dsn' dsn 'bad first line' x.1
else if pos('NOT FOUND', x.1) > 0 then
return 'notFound'
else if word(x.1, 1)^== 'NONVSAM' then
call jOut 'err ??? for dsn' dsn 'bad first line' x.1
do x=2 to x.0 while vo = '' & left(x.x, 1) = ' '
/* say x.x */
p = pos('MANAGEMENTCLASS-', x.x)
if p > 0 then
vo = strip(word(substr(x.x, p+16), 1), 'l', '-')
p = pos('VOLSER--', x.x)
if p > 0 then
vo = strip(word(substr(x.x, p+6), 1), 'l', '-')
p = pos('DEVTYPE--', x.x)
dt = strip(word(substr(x.x, p+8), 1), 'l', '-')
end
/* say 'lc' cl 'vo' vo 'dt' dt 'dsn' dsn */
if vo = '' then
call jOut '??? err no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl = '' then
res = 'tape'
else
res = cl
if abbrev(res, 'ar') ^= abbrev(dt, "X'0") ,
| abbrev(res, 'ta') ^= abbrev(dt, "X'7") ,
| (left(res, 1) >= 'A') ^= abbrev(dt, "X'3") then
call jOut 'err ??? mismatch cl' cl 'vo' vo 'dt' dt 'dsn' dsn
return res
endProcedure listCatClass
/* copy tstAll begin *************************************************/
/* copx tstSql end ***************************************************/
tstAll: procedure expose m.
call sqlOIni
call compIni
call tstBase
call tstComp
call tstPlus
return 0
endProcedure tstAll
tstPlus:
call tstSort
call tstMatch
call sqlIni
call tstSql
call tstSqlO
call tstSqlEnv
call tstTotal
return
tstWshBatch:
call adrTso 'alloc dd(WSH) shr dsn(WK.TEXT(WSHBATCH))'
call wshBatch
return adrTso('free dd(WSH)')
tstCsi: procedure expose m.
if 0 then do
call lmd 'A540769.*K'
call tstCsiCla 'A540769.WK.REXX'
call tstCsiCla 'A540769.AAA.DATASETS'
call tstCsiCla 'A540769.RRR.DATASETS'
end
if 0 then do
call tstCsiOpNx 'A540769.WK.*E*'
call tstCsiOpNx 'A540769.AAA.DATASETS'
call tstCsiOpNx 'A540769.RRR.DATASETS'
end
if 1 then do
call tstCsiNxCl 'A540769.WK.**'
call tstCsiNxCl 'DBTF.M*.**'
call tstCsiNxCl 'DBTF.BE*.**'
end
return
tstCsi: procedure expose m.
/* call lmd 'A540769.*K' */
call tstCsi1 'A540769.WK.REXX'
call tstCsi1 'A540769.AAA.DATASETS'
call tstCsi1 'A540769.RRR.DATASETS'
return
tstCsiCla:
parse arg ds
say ds '-->' csiCla(ds)
return
tstCsiOpNx: procedure expose m.
parse arg ds
m = 'NUE123'
s = 'res89'
flds = 'devtyp volser mgmtclas comudsiz NOBYTTRK UDATASIZ HARBA'
say 'csiOpen' ds
call csiOpen m, ds, flds
do while csiNext(m, s)
say m.s.dsn 'dev' c2x(m.s.devTyp) ,
'vol' m.s.volSer 'cla' m.s.mgmtclas,
'comuDsiz' m.s.comuDsiz 'noBytTrk' m.s.noBytTrk,
'udatasiz' c2x(m.s.udatasiz) ,
'harba' c2x(m.s.harba)
end
return
tstCsiNxCl: procedure expose m.
parse arg ds
m = 'ABC123'
s = 'efg89'
flds = 'devtyp volser mgmtclas'
say 'csiOpen' ds
call csiOpen m, ds, flds
say timing() 'begin'
do i=1 while csiNext(m, s)
nn = csiArcTape(m.s.volser, m.s.mgmtClas, m.s.devtyp, m.s.dsn)
/* oo = csiCla(strip(m.s.dsn))
if oo <> nn then
say nn '<>' oo m.s.dsn
*/ if i // 1000 = 0 then
say timing() i nn m.s.dsn
end
say timing() (i-1) nn m.s.dsn
return
tstTypePara:
b = jBuf()
say 'b typePara undef' oGetTypePara(b)
ty = oFldNew('Ty*', '=', '=', 'A = B =')
call oSetTypePara b, ty
say 'b argCla def' oGetTypePara(b)
call tstJ2
return
tstSort: procedure expose m.
call tst t, "tstSort" ,
, "sort 29 c ACHT DREI DREIZEHN EINS ELF FUENF M.I.25 M.I.26",
|| " M.I.27 M.I.29 NEUN SECHS SIEBEN VIER VIERZEHN ZEHN ZWEI Z",
|| "WOELF 0 1 1 1 2 2 3 3 4 4",
, "sort 22 c ACHT DREIZEHN ELF M.I.25 M.I.26 M.I.27 M.I.29 N",
|| "EUN VIERZEHN ZEHN ZWOELF 0 1 1 1 2 2 3 3 4 4",
, "sort 15 c M.I.25 M.I.26 M.I.27 M.I.29 0 1 1 1 2 2 3 3 4 4",
, "sort 8 c M.I.25 M.I.26 M.I.27 M.I.29 0 1 1",
, "sort 1 M.I.29"
m.i.1 = eins
m.i.2 = zwei
m.i.3 = drei
m.i.4 = vier
m.i.5 = fuenf
m.i.6 = sechs
m.i.7 = sieben
m.i.8 = acht
m.i.9 = neun
m.i.10 = zehn
m.i.11 = elf
m.i.12 = zwoelf
m.i.13 = dreizehn
m.i.14 = vierzehn
m.i.15 = 1
m.i.16 = 2
m.i.17 = 3
m.i.18 = 4
m.i.19 = 4
m.i.20 = 3
m.i.21 = 2
m.i.22 = 1
m.i.23 = 0
m.i.24 = 1
m.i.28 = 'c'
yy = 29
do while yy > 0
do x = 0 to yy
m.i.0 = x
call sort i, o
m = ''
la = ''
if x <> m.o.0 then
call err 'size mismatch' x '<>' m.o.0
do y=1 to m.o.0
m = m m.o.y
if ^ (la << m.o.y) then
call err 'sort mismatch' yy x y '^' la '<<' m.o.y
end
end
if yy // 7 = 1 then
call tstOut t, 'sort' yy m
do x = 2 to yy
x1 = x-1
m.i.x1 = m.i.x
end
yy = yy-1
end
call tstEnd t
return
endProcedure tstSort
tstMatch: procedure expose m.
call tst t, "tstMatch" ,
, "match(eins, e?n*) 1 1 2,i,s trans(E?N*) EiNs",
, "match(eins, eins) 1 1 0 trans(EINS) EINS",
, "match(e1nss, e?n*) 1 1 2,1,ss trans(?*) 1ss",
, "match(eiinss, e?n*) 0 0 -9",
, "match(einss, e?n *) 0 0 -9",
, "match(ein s, e?n *) 1 1 2,i,s trans(E?N *) EiN s",
, "match(ein abss , ?i*b*) 1 1 3,e,n a,ss trans(?I*B*) eIn",
|| " aBss ",
, "match(ein abss wie gehtsssxdirx und auch , ) 0 0 -9",
, "match(ies000, *000) 1 1 1,ies trans(*000) ies000",
, "match(xx0x0000, *000) 1 1 1,xx0x0 trans(*000) xx0x0000",
, "match(000x00000xx, 000*) 1 1 1,x00000xx trans(000*) 000x00",
|| "000xx",
, "match(000xx, *0*) 1 1 2,00,xx trans(ab*cd*ef) ab00cdxxef"
call tstOut t, matchTest1('eins', 'e?n*' )
call tstOut t, matchTest1('eins', 'eins' )
call tstOut t, matchTest1('e1nss', 'e?n*', '?*' )
call tstOut t, matchTest1('eiinss', 'e?n*' )
call tstOut t, matchTest1('einss', 'e?n *' )
call tstOut t, matchTest1('ein s', 'e?n *' )
call tstOut t, matchTest1('ein abss ', '?i*b*' )
call tstOut t, matchTest1('ein abss wie gehtsssxdirx und auch ' )
call tstOut t, matchTest1('ies000', '*000' )
call tstOut t, matchTest1('xx0x0000', '*000' )
call tstOut t, matchTest1('000x00000xx', '000*' )
call tstOut t, matchTest1('000xx', '*0*', 'ab*cd*ef' )
call tstEnd t
return
matchTest1:
parse arg w, m, m2
r = 'match('w',' m')' match(w, m) match(w, m, vv) m.vv.0
do x=1 to m.vv.0
r = r','m.vv.x
end
if m2 = '' then
m2 = translate(m)
if m.vv.0 >= 0 then
r = r 'trans('m2')' matchTrans(m2, vv)
return r
endProcedure matchTest1
tstSqlUtils: procedure expose m.
call sqlConnect 'DBAF'
id = 'A540769.dsnUtils'
rst = 'NO'
retcode = -9876
e = ''
z = 0
st = "TEMPLATE TCOPYD",
"DSN('&SSID..&JO..&US..P&PART(2)..D&DATE(3)..T&TIME.')",
"DATACLAS(NULL12) MGMTCLAS(COM#A011) STORCLAS(FAR$N)",
"SPACE (150,3750) TRK UNCNT 59;",
"listdef abc include tablespace DA540769.A002* partlevel;",
"listdef mf include tablespace MF01A1A.A110A partlevel;",
"copy list abc copyddn(tcopyd) shrlevel change;"
upper st
call sqlExec "call SYSPROC.DSNUTILS ( :id, :rst,",
":st,:retcode, :ANY" copies(',:e,:e,:z',12) ")"
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE SYSPROC.DSNUTILS'
say 'results' results
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say 'allocated c111'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say 'closed'
call sqlDisconnect
exit
endProcedure tstSqlUtils
tstSqlStored: procedure expose m.
call sqlConnect 'DBAF'
rst = 'NO'
retcode = -9876
e = ''
z = 0
st = "abc"
call sqlExec "call SYSPROC.COMMAND ( :st, :rst)"
say 'after call st='st 'rst='rst
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE SYSPROC.COMMAND'
say 'results' results
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say 'allocated c111'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say 'closed'
call sqlDisconnect
return
endProcedure tstSqlStored
tstSqlStoredWK: procedure expose m.
call sqlConnect 'DBAF'
/* st = "direct wkUtiSub"
rst = 'NO'
say 'before call st='st 'rst='rst
call sqlExec "call A540769.WKUTILSUB ( :st, :rst)"
say 'after call st='st 'rst='rst
*/ rst = 'NO'
retcode = -9876
e = ''
z = 0
prc = 'DB2UTIL.DB2UTIL'
st = "DA540769.A2*" /* DA540769.A1*" */
say "call" prc "("st", ...)"
call sqlExec "call" prc "(:st, :rst)"
say 'after call st='st 'rst='rst
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE' prc
/* say 'results' results */
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say ''
say '***** utility output'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say '***** end output'
call sqlDisconnect
return 0
endProcedure tstSqlStoredWK
tstSqlStoredSQL1: procedure expose m.
call sqlConnect 'DBIA'
rst = 'NO'
retcode = -9876
e = ''
z = 0
st = "DA540769.A2* DA540769.A1*"
call sqlExec "call A540769.WKSQL1 ( :st, :rst)"
say 'after call st='st 'rst='rst
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE A540769.WKUTIL'
say 'results' results
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say 'allocated c111'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say 'closed'
call sqlDisconnect
return
endProcedure tstSqlStoredSQL1
tstSqlTriggerTiming:
parse upper arg tb ni
m.noInsert = ni == 0
cnt = 200000
if tb = '' then
TB = 'GDB9998.TWK511TRI'
call sqlConnect dbaf
say timing() 'noInsert' m.noInsert 'tb' tb
call sql2St 49, '*', cc, 'select max(pri) MX from' tb
if m.cc.1.mx == m.sqlNull then
m.cc.1.mx = 0
von = m.cc.1.mx + 1
bis = m.cc.1.mx + cnt
say m.cc.0 'max' m.cc.1.mx 'von' von 'bis' bis 'count' cnt tb
if right(tb, 2) = 'A1' then do
call sqlPrepare 3, 'insert into' tb '(pri, short, long, par)' ,
'values (?, ?, ?, ?)'
do ax=von to bis
call sqlExecute 3, ax,
, ax 'wsh short', ax 'wsh long long long long long ',
, (ax-1) // 1000 + 1
end
end
else do
call sqlPrepare 3, 'insert into' tb '(pri, short, long)' ,
'values (?, ?, ?)'
do ax=von to bis
call sqlExecute 3, ax,
, ax 'wsh short', ax 'wsh long long long long long ',
, (ax-1) // 1000 + 1
end
end
/* call sqlLn 5,,, 'select * from' tb 'where pri >=' von */
call sqlExImm 'commit'
say timing()
call sqlDisconnect
return
endProcedure tstSqlTriggerTiming
tstSql: procedure expose m.
cx = 2
call tst t, "tstSql",
, "*** err: sqlCode -204 A540769.SYSDUMMY IS AN UNDEFINED NAM",
|| "E ",
, " e 1: warnings",
, " e 2: state 42704",
, " e 3: stmt = execSql prepare s7 from :src",
, " e 4: with src = select * from sysdummy",
, "fetchA 1 ab= m.abcdef.123.AB abc ef= efg",
, "fetchA 0 ab= m.abcdef.123.AB abc ef= efg",
, "sqlVars :M.STST.A :M.STST.A.SQLIND, :M.STST.B :M.STST.B.SQ",
|| "LIND, :M.STST.C :M.STST.C.SQLIND",
, "1 all from dummy1",
, "a=a b=2 c=0",
, "sqlVarsNull 1",
, "a=a b=2 c=---",
, "fetchBT 1 SYSTABLES",
, "fetchBT 0 SYSTABLES",
, "fetchBI 1 SYSINDEXES",
, "fetchBI 0 SYSINDEXES"
call mAdd t.cmp,
, "opAllCl 3",
, "fetchC 1 SYSTABLES",
, "fetchC 2 SYSTABLESPACE",
, "fetchC 3 SYSTABLESPACESTATS",
, "PreAllCl 3",
, "fetchD 1 SYSIBM.SYSTABLES",
, "fetchD 2 SYSIBM.SYSTABLESPACE",
, "fetchD 3 SYSIBM.SYSTABLESPACESTATS"
call sqlConnect 'DBAF'
src = 'select * from sysdummy'
call sqlExec 'prepare s7 from :src'
call sqlPrepare cx, "select 'abc' , 'efg'",
'from sysibm.sysDummy1'
call sqlExec 'declare c'cx 'cursor for s'cx
call sqlOpen cx
a = 'abcdef'
b = 123
do i=1 to 2
call jOut 'fetchA' sqlFetchInto(cx, ':m.a.b.ab, :m.a.b.ef') ,
'ab= m.'a'.' || b'.'ab m.a.b.ab 'ef=' m.a.b.ef
end
call sqlClose cx
drop stst a b c m.stst.a m.stst.b m.stst.c
sv = sqlVars('M.STST', A B C , 1)
call jOut 'sqlVars' sv
call jOut sqlPreAllCl(cx,
, "select 'a', 2, case when 1=0 then 1 else null end ",
"from sysibm.sysDummy1",
, stst, sv) 'all from dummy1'
call jOut 'a='m.stst.a 'b='m.stst.b 'c='m.stst.c
call jOut 'sqlVarsNull' sqlVarsNull(stst, A B C)
call jOut 'a='m.stst.a 'b='m.stst.b 'c='m.stst.c
call sqlPreDeclare cx, "select name" ,
"from sysibm.sysTables" ,
"where creator = 'SYSIBM' and name = ?"
call sqlOpen cx, 'SYSTABLES'
call jOut 'fetchBT' sqlFetchInto(cx, ':NM') nm
call jOut 'fetchBT' sqlFetchInto(cx, ':NM') nm
call sqlClose cx
call sqlOpen cx, 'SYSINDEXES'
a = 'a b c'
b = 1234565687687234
call jOut 'fetchBI' sqlFetchInto(cx, ':NM') nm
call jOut 'fetchBI' sqlFetchInto(cx, ':NM') nm
call sqlClose cx
src = "select name" ,
"from sysibm.sysTables" ,
"where creator = 'SYSIBM' and name like 'SYSTABLES%'",
"fetch first 3 rows only"
call sqlPreDeclare cx, src
st = 'wie geht'' s'
call jOut 'opAllCl' sqlOpAllCl(cx, st, ':M.ST.SX.NAME')
do x=1 to m.st.0
call jOut 'fetchC' x m.st.x.name
end
st = 'auch noch'
src = "select strip(creator) || '.' || strip(name)" substr(src,12)
call jOut 'PreAllCl' sqlPreAllCl(cx+11, src, st, ':M.ST.SX.NAME')
do x=1 to m.st.0
call jOut 'fetchD' x m.st.x.name
end
call sqlDisconnect
call tstEnd t
return
endProcedure tstSql
tstSqlO: procedure expose m.
call tst t, "tstSqlO",
, "*** err: sqlCode -204 A540769.SYSDUMMY IS AN UNDEFINED NAM",
|| "E ",
, " e 1: warnings",
, " e 2: state 42704",
, " e 3: stmt = execSql prepare s7 from :src",
, " e 4: with src = select * from sysdummy",
, "REQD=Y col=123 case=--- col5=anonym",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE ",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE ",
, "SYSTABLEPART_HI T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE ",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_HIST T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE"
call sqlConnect 'DBAF'
src = 'select * from sysdummy'
call sqlExec 'prepare s7 from :src'
call sql2Cursor 13,
, 'select d.*, 123, current timestamp "jetzt und heute",',
'case when 1=0 then 1 else null end caseNull,',
"'anonym'" ,
'from sysibm.sysdummy1 d'
call sqlOpen 13
do while sqlFetch(13, abc)
call jOut 'REQD='m.ABC.IBMREQD 'col='m.ABC.col2,
'case='m.ABC.CASENULL,
'col5='m.ABC.col5
je = 'jetzt'
jetzt = m.ABC.je
dd = date('s')
dd = left(dd, 4)'-'substr(dd, 5, 2)'-'right(dd, 2)'-' ,
|| left(time(), 2)'.'
say 'jetzt='jetzt 'date time' dd
if ^ abbrev(jetzt, dd) then
call err 'date mismatch abbrev' dd
end
call sqlClose 13
call sql2Cursor 13 ,
, 'select name, type, dbName, tsName' ,
/* ,alteredTS, obid, cardf'*/ ,
'from sysibm.systables' ,
"where creator = 'SYSIBM' and name like 'SYSTA%'" ,
"fetch first 5 rows only",
, , 'sl<15'
call sqlOpen 13
call jOut fmtFldTitle(m.sql.13.fmt)
do while sqlFetchLn(13, li)
call jOut m.li
end
call sqlClose 13
call sqlGenFmt m.sql.13.fmt, 13, 'sst'
call sqlOpen 13
do ix=1 while sqlFetch(13, fe.ix)
end
m.fe.0 = ix-1
call fmtFldSquash sqFmt, sqlType(13), fe
call jOut fmtFldTitle(sqFmt)
do ix=1 to m.fe.0
call jOut oFldCat(sqlType(13), fe.ix, sqFmt)
end
call sqlClose 13
if 0 then do
call sql2Cursor 13 ,
, 'select *',
'from sysibm.systables' ,
"where creator = 'SYSIBM' and name like 'SYSTA%'" ,
"fetch first 1 rows only",
, , 'sl<15'
call sqlOpen 13
call jOut fmtFldTitle(m.sql.13.fmt)
do while sqlFetchLn(13, li)
call jOut m.li
end
call sqlClose 13
end
call sqlDisconnect
call tstEnd t
return
endProcedure tstSqlO
tstSqlEnv: procedure expose m.
call tst t, "tstSqlEnv",
, "REQD=Y COL2=123 case=--- COL5=anonym",
, "sql fmtFldRw sl<15",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE ",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE ",
, "SYSTABLEPART_HI T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE ",
, "sql fmtFldSquashRW",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_HIST T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE",
, "sqlLn sl=",
, "COL1 T DBNAME COL4 ",
, "SYSTABAUTH T DSNDB06 SYSDBASE"
call mAdd t.cmp,
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_ T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE",
, "sqlLn ---",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_HIST T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE"
call sqlConnect 'DBAF'
call envBarBegin
call jOut 'select d.*, 123, current timestamp "jetzt und heute",'
call jOut 'case when 1=0 then 1 else null end caseNull,'
call jOut "'anonym'"
call jOut 'from sysibm.sysdummy1 d'
call envBar
call sql 13
call envBarLast
do while envRead(abc)
call jOut 'REQD='envGet('ABC.IBMREQD'),
'COL2='envGet('ABC.COL2'),
'case='envGet('ABC.CASENULL'),
'COL5='envGet('ABC.COL5')
jetzt = envGet('ABC.jetzt')
say 'jetzt='jetzt
dd = date('s')
dd = left(dd, 4)'-'substr(dd, 5, 2)'-'right(dd, 2)'-' ,
|| left(time(), 2)'.'
if ^ abbrev(jetzt, dd) then
call err 'date mismatch abbrev' dd
end
call envBarEnd
call jOut 'sql fmtFldRw sl<15'
call envBarBegin
call jOut 'select name, type, dbName, tsName'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBar
call sql 13
call envBarLast
call fmtFldRW sqlGenFmt(fmtAbc, 13, 'sl<15')
call envBarEnd
call jOut 'sql fmtFldSquashRW'
call envBarBegin
call jOut 'select name, type, dbName, tsName'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBar
call sql 13
call envBarLast
call fmtFldSquashRW
call envBarEnd
call jOut 'sqlLn sl='
call envBarBegin
call jOut 'select char(name, 13), type, dbName, char(tsName, 8)'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBarLast
call sqlLn 13, , ,'sl='
call envBarEnd
call jOut 'sqlLn ---'
call envBarBegin
call jOut 'select name, type, dbName, tsName'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBarLast
call sqlLn 13
call envBarEnd
call sqlDisconnect
call tstEnd t
return
endProcedure tstSqlEnv
/* copx tstSql end ***************************************************/
/* copx tstComp begin **************************************************
test the wsh comp
***********************************************************************/
tstComp: procedure expose m.
call compIni
call tstCompDataConst
call tstCompDataVars
call tstCompShell
call tstCompPrimary
call tstCompStmt
call tstCompDataIO
call tstCompPipe
call tstCompRedir
call tstCompComp
call tstTotal
return
endProcedure tstComp
tstCompRun: procedure expose m.
parse arg type cnt
src = jBuf()
call jOpen src, 'w'
do sx=2 to arg()
call jWrite src, arg(sx)
end
cmp = comp(src)
call jOut 'compile' type',' (sx-2) 'lines:' arg(2)
r = compile(cmp, type)
say "compiled: >>>>" r "<<<<" m.r.code
call jOut "run without input"
call mCut 'T.IN', 0
call oRun r
if cnt == 3 then do
call jOut "run with 3 inputs"
call mAdd 'T.IN', "eins zwei drei", "zehn elf zwoelf?",
, "zwanzig 21 22 23 24 ... 29|"
m.t.inIx = 0
call oRun r
end
return
endProcedure tstCompRun
tstCompDataConst: procedure expose m.
call tst t, 'tstCompDataConst',
, "compile d, 8 lines: Lline one, $** asdf",
, "run without input",
, " Lline one, ",
, "line two.",
, "line threecontinued on 4",
, "line five fortsetzung",
, "line six fortsetzung"
call tstCompRun 'd' ,
, ' Lline one, $** asdf',
, 'line two.',
, 'line three$*+ bla bla' ,
, 'continued on 4',
, 'line five $*( und so',
, 'weiter $abc $? $''$*)'' $"$*)" und weiter $*) fortsetzung',
, 'line six $*( und $*( $** $*( so',
, 'weiter $abc $? $*)'' $"$*)" und weiter $*) fortsetzung'
call tstEnd t
return
endProcedure tstCompDataComm
tstCompDataVars: procedure expose m.
call tst t, 'tstCompDataVars',
, "compile d, 4 lines: Lline one, $** asdf",
, "run without input",
, " Lline one, ",
, "lline zwei output",
, "lline 3 ",
, "variable v1 = valueV1 ${v1}= valueV1| "
call tstCompRun 'd' ,
, ' Lline one, $** asdf',
, ' $$ lline zwei output',
, 'lline 3 $=v1= valueV1 ' ,
, 'variable v1 = $v1 $"${v1}=" ${ v1 }| '
call tstEnd t
return
endProcedure tstCompDataVars
tstCompShell: procedure expose m.
call tst t, 'tstCompShell',
, "compile s, 9 lines: $$ Lline one, $** asdf",
, "run without input",
, "Lline one,",
, "lline zwei output",
, "v1 = valueV1 ${v1}= valueV1|",
, "REXX JOUT L5 CONTINUED L6 CONTINUED L7",
, "L8 ONE",
, "L9 END"
call tstCompRun 's' ,
, ' $$ Lline one, $** asdf',
, ' $$ lline zwei output',
, ' $=v1= valueV1 ' ,
, '$$ v1 = $v1 $"${v1}=" ${ v1 }| ' ,
, 'call jOut rexx jout l5, ' ,
, ' continued l6 , ' ,
, ' continued l7 ' ,
, 'call jOut l8 one ' ,
, 'call jOut l9 end'
call tstEnd t
return
endProcedure tstCompDataVars
tstCompPrimary: procedure expose m.
call tst t, 'tstCompPrimary',
, "compile d, 11 lines: Strings $""$""""$""""""""$"""""" $'$'",
|| "'$''''$'''",
, "run without input",
, "Strings $""$""""$"" $'$''$'",
, "rexx 3*5 = 15",
, "data line three line four bis hier",
, "shell line five line six bis hier",
, "var get v1 value Eins, v1 value Eins ",
, "var isDef v1 1, v2 0 ",
, "jIn eof 1",
, "var read >1 0 rr undefined",
, "jIn eof 2",
, "var read >2 0 rr undefined",
, "run with 3 inputs",
, "Strings $""$""""$"" $'$''$'",
, "rexx 3*5 = 15",
, "data line three line four bis hier",
, "shell line five line six bis hier",
, "var get v1 value Eins, v1 value Eins "
call mAdd t.cmp,
, "var isDef v1 1, v2 0 ",
, "<jIn 1< eins zwei drei",
, "var read >1 1 rr eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "var read >2 1 rr zehn elf zwoelf?"
call envRemove 'v2'
call tstCompRun 'd' 3 ,
, 'Strings $"$""$""""$"""' "$'$''$''''$'''",
, 'rexx 3*5 = $( 3 * 5 $)',
, 'data $-¢ line three',
, 'line four $! bis hier',
, 'shell $-{ $$ line five',
, '$$ line six $} bis hier',
, '$= v1 = value Eins $=rr=undefined',
, 'var get v1 $v1, v1 ${ v1 } ',
, 'var isDef v1 ${? v$( 1 * 1 + 0 $) }, v2 ${?v2 } ',
, 'var read >1 ${> rr} rr $rr' ,
, 'var read >2 ${> rr} rr $rr'
call tstEnd t
return
endProcedure tstCompPrimary
tstCompStmt: procedure expose m.
call tst t, 'tstCompStmt1',
, "compile s, 8 lines: $= v1 = value eins $= v2 £ 3*5*7 ",
, "run without input",
, "data v1 value eins v2 105",
, "eins",
, "zwei",
, "drei",
, "vier",
, "fuenf",
, "elf",
, "zwoelf dreiZ ",
, "vierZ ",
, "fuenfZ",
, "lang v1 value eins v2 945",
, "oRun ouput 1"
call envPut 'oRun', oRunner('call jOut "oRun ouput" (1*1)')
call envRemove 'v2'
call tstCompRun 's' ,
, '$= v1 = value eins $= v2 £ 3*5*7 ',
, '$$ data v1 $v1 v2 ${ v2 }',
, '$$eins $@{$$ zwei $$ drei ',
, ' $@{ $} $@{ $@{ $$vier $} $} $} $$fuenf',
, '$$elf $@¢ zwoelf dreiZ ',
, ' $@¢ $! $@¢ $@¢ vierZ $! $! $! $$fuenfZ',
, '$£ "lang v1" $v1 "v2" ${v2}*9',
, '$@run $oRun'
call tstEnd t
call tst t, 'tstCompStmt2',
, "compile s, 1 lines: $@for qq $$ loop qq $qq",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "loop qq eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "loop qq zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "loop qq zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4"
call tstCompRun 's' 3 ,
, '$@for qq $$ loop qq $qq'
call tstEnd t
return
endProcedure tstCompStmt
tstCompDataIO: procedure expose m.
call tst t, 'tstCompDataHereData',
, "compile d, 13 lines: herdata $<<stop ",
, "run without input",
, " herdata ",
, "heredata 1 $x",
, "heredata 2 $y",
, "nach heredata",
, " herdata ¢ ",
, "heredata 1 xValue",
, "heredata 2 yValueY",
, "nach heredata ¢",
, " herdata { ",
, "HEREDATA 1 xValue",
, "heredata 2 yValueY",
, "nach heredata {"
call tstCompRun 'd' ,
, ' herdata $<<stop ',
, 'heredata 1 $x',
, 'heredata 2 $y',
, 'stop $$ nach heredata',
, ' herdata ¢ $<<¢stop ',
, '$=x=xValue$=y=yValueY',
, 'heredata 1 $x',
, 'heredata 2 $y',
, 'stop $$ nach heredata ¢',
, ' herdata { $<<{st',
, 'call jOut heredata 1 $x',
, '$$heredata 2 $y',
, 'st $$ nach heredata {'
call tstEnd t
dsn = tstDsn('lib37', 'r')'(readInp)'
call mAdd mCut(abc, 0), 'readInp line 1', 'readInp line 2'
call writeDsn dsn '::f37', m.abc., ,1
call envPut 'dsn', dsn
call tst t, 'tstCompDataIO',
, "compile d, 4 lines: input 1 $<$dsn ::fb ",
, "run without input",
, " input 1 ",
, "readInp line 1 ",
, "readInp line 2 ",
, " nach dsn input und nochmals mit & ",
, "readInp line 1 ",
, "readInp line 2 ",
, " und schluiss."
call tstCompRun 'd' ,
, ' input 1 $<$dsn ::fb ',
, ' nach dsn input und nochmals mit & ' ,
, ' $<&dsn('dsn2jcl(dsn)') dd(xyz)',
, ' und schluiss.'
call tstEnd t
return
endProcedure tstCompDataIO
tstCompPipe: procedure expose m.
call tst t, 'tstCompPipe1',
, "compile s, 1 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "(1 eins zwei drei 1)",
, "<jIn 2< zehn elf zwoelf?",
, "(1 zehn elf zwoelf? 1)",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "(1 zwanzig 21 22 23 24 ... 29| 1)",
, "jIn eof 4"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"'
call tstEnd t
call tst t, 'tstCompPipe2',
, "compile s, 2 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "¢2 (1 eins zwei drei 1) 2!",
, "¢2 (1 zehn elf zwoelf? 1) 2!",
, "¢2 (1 zwanzig 21 22 23 24 ... 29| 1) 2!"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $¨ call envPreSuf "¢2 ", " 2!"'
call tstEnd t
call tst t, 'tstCompPipe3',
, "compile s, 3 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "<3 ¢2 (1 eins zwei drei 1) 2! 3>",
, "<3 ¢2 (1 zehn elf zwoelf? 1) 2! 3>",
, "<3 ¢2 (1 zwanzig 21 22 23 24 ... 29| 1) 2! 3>"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $¨ call envPreSuf "¢2 ", " 2!"',
, ' $¨ call envPreSuf "<3 ", " 3>"'
call tstEnd t
call tst t, 'tstCompPipe4',
, "compile s, 7 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "<3 ¢222 ¢221 ¢21 ¢20 (1 eins zwei drei 1) 20! 21! 221! 222",
|| "! 3>",
, "<3 ¢222 ¢221 ¢21 ¢20 (1 zehn elf zwoelf? 1) 20! 21! 221! 22",
|| "2! 3>",
, "<3 ¢222 ¢221 ¢21 ¢20 (1 zwanzig 21 22 23 24 ... 29| 1) 20!",
|| " 21! 221! 222! 3>"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $¨ $@{ call envPreSuf "¢20 ", " 20!"',
, ' $¨ call envPreSuf "¢21 ", " 21!"',
, ' $¨ $@{ call envPreSuf "¢221 ", " 221!"',
, ' $¨ call envPreSuf "¢222 ", " 222!"',
, '$} $} ',
, ' $¨ call envPreSuf "<3 ", " 3>"'
call tstEnd t
return
endProcedure tstCompPipe
tstCompRedir: procedure expose m.
call tst t, 'tstCompRedir',
, "compile s, 5 lines: $>#eins $@for vv $$<$vv> $; ",
, "run without input",
, "jIn eof 1",
, "output eins ",
, "output piped zwei ",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "output eins <eins zwei drei> <zehn elf zwoelf?> <zwanzig 2",
|| "1 22 23 24 ... 29|>",
, "output piped zwei ab<eins zwei drei>yz ab<zehn elf zwoelf?",
|| ">yz ab<zwanzig 21 22 23 24 ... 29|>yz"
dsn = tstDsn('libvb', 'r')'(redir1)'
call envPut 'dsn', dsn
call tstCompRun 's' 3 ,
, ' $>#eins $@for vv $$<$vv> $; ',
, ' $$ output eins $-{$<#eins$}$; ',
, ' $@for ww $$b${ww}y ',
, ' $> $dsn ::v $¨ call envPreSuf "a", "z" $<# eins',
, '$;$$ output piped zwei $-{$<$dsn$} '
call tstEnd t
return
endProcedure tstCompRedir
tstCompComp: procedure expose m.
call tst t, 'tstCompCompShell',
, "compile s, 5 lines: $$compiling shell $; $= rrr = $-cmpShe",
|| "ll $<<aaa",
, "run without input",
, "compiling shell",
, "running einmal",
, "RUN 1 COMPILED einmal",
, "jIn eof 1",
, "running zweimal",
, "RUN 1 COMPILED zweimal",
, "jIn eof 2",
, "run with 3 inputs",
, "compiling shell",
, "running einmal",
, "RUN 1 COMPILED einmal",
, "<jIn 1< eins zwei drei",
, "compRun eins zwei dreieinmal"
call mAdd t'.CMP',
, "<jIn 2< zehn elf zwoelf?",
, "compRun zehn elf zwoelf?einmal",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "compRun zwanzig 21 22 23 24 ... 29|einmal",
, "jIn eof 4",
, "running zweimal",
, "RUN 1 COMPILED zweimal",
, "jIn eof 5"
call tstCompRun 's' 3 ,
, "$$compiling shell $; $= rrr = $-cmpShell $<<aaa",
, "call jOut run 1*1*1 compiled $cc; $@for v $$ compRun $v$cc",
, "aaa $;",
, "$=cc=einmal $$ running $cc $@run $rrr",
, "$=cc=zweimal $$ running $cc $@run $rrr"
call tstEnd t
call tst t, 'tstCompCompData',
, "compile s, 5 lines: $$compiling data $; $= rrr = $-cmpData",
|| " $<<aaa",
, "run without input",
, "compiling data",
, "running einmal",
, "call jOut run 1*1*1 compiled einmal",
, "running zweimal",
, "call jOut run 1*1*1 compiled zweimal",
, "run with 3 inputs",
, "compiling data",
, "running einmal",
, "call jOut run 1*1*1 compiled einmal",
, "running zweimal",
, "call jOut run 1*1*1 compiled zweimal"
call tstCompRun 's' 3 ,
, "$$compiling data $; $= rrr = $-cmpData $<<aaa",
, "call jOut run 1*1*1 compiled $cc",
, "aaa $;",
, "$=cc=einmal $$ running $cc $@run $rrr",
, "$=cc=zweimal $$ running $cc $@run $rrr"
call tstEnd t
return
endProcedure tstCompComp
/* copx tstComp end *************************************************/
/* copx tstBase begin **************************************************
test the basic classes
***********************************************************************/
tstBase: procedure expose m.
call tstM
call tstMap
call tstMapVia
call tstScan
call tstO
call tstJsay
call tstJ
call tstJ2
call tstCat
call tstScanRead
call tstScanWin
call tstScanSQL
call tstEnv
call tstEnvCat
call tstEnvLazy
call tstEnvVars
call tstCatDsn
call tstTotal
return
endProcedure tstBase
tstTstSay: procedure
call tst x, 'test eins', "test eins einzige testZeile"
call tstOut x, "test eins einzige testZeile"
call tstEnd x
call tst x, 'test zwei', "zwei 1. testZeile",
, "zwei 2. und letsdfazte testZeile"
call tstOut x, "zwei 1. testZeile"
call tstOut x, "zwei 2. und letzte testZeile"
call tstEnd x
call tst y, 'test drei',
, "drei 1. testZeile",
, "drei 2. tEstZeile",
, "drei 3. testZeile test line drei ganz lang 1 ",
|| " ...line drei ganz lang 2 ",
|| " ...line drei ganz lang 3 .",
|| "..line drei ganz lang 4 und schluss."
call tstOut y, 'drei 1. testZeile'
call tstOut y, 'drei 2. testZeile'
call tstOut y, 'drei 3. testZeile',
'test line drei ganz lang 1 ',
' ...line drei ganz lang 2 ',
' ...line drei ganz lang 3 ',
' ...line drei ganz lang 4 und schluss.'
call tstEnd y
call tstTotal
endProcedure tstTstSay
tstM: procedure
call tst t, 'tstM',
, "symbol m.b LIT",
, "mInc b 2 m.b 2",
, "symbol m.a LIT",
, "mAdd a A.2",
, "mAdd a A.3",
, "m.a: 3: 1=eins 2=zwei 3=drei 4=M.A.4",
, "m.c: 5: 1=c vor AddSt a 2=eins 3=zwei",
, " 4=drei 5=c nach addSt a 6=M.C.6"
call tstOut t, 'symbol m.b' symbol('m.b')
m.b = 1
call tstOut t, 'mInc b' mInc(b) 'm.b' m.b
call tstOut t, 'symbol m.a' symbol('m.a')
call tstOut t, 'mAdd a' mAdd(mCut(a, 0), 'eins', 'zwei')
call tstOut t, 'mAdd a' mAdd(a, 'drei')
call tstOut t, 'm.a:' m.a.0': 1='m.a.1 '2='m.a.2 '3='m.a.3 '4='m.a.4
call mAdd mCut(c, 0), 'c vor AddSt a'
call mAddSt c, a
call mAdd c, 'c nach addSt a'
call tstOut t, 'm.c:' m.c.0': 1='m.c.1 '2='m.c.2 '3='m.c.3
call tstOut t, ' 4='m.c.4 '5='m.c.5 '6='m.c.6
call tstEnd t
return
endProcedure tstM
tstMap: procedure expose m.
m = mapNew('K')
ky = mapKeys(m)
say '***mapNew' m 'keys' ky
call tst t, 'tstMap',
, "map "m": zwei --> 2",
, "map "m": Zwei is not defined",
, "map stem "ky" 4",
, "map "m": eins --> 1",
, "map "m": zwei --> 2",
, "map "m": drei --> 3",
, "map "m": vier --> 4",
, "*** err: duplicate key eins in map MAP.2",
, "map MAP.2: zwei is not defined",
, "q 2 zw dr",
, "map stem Q 2",
, "map Q: zw --> 2Q",
, "map Q: dr --> 3Q",
, "map stem MAP.2 3",
, "map MAP.2: eins --> 1",
, "map MAP.2: zwei --> 2PUT",
, "map MAP.2: vier --> 4PUT",
, "*** err: duplicate key zwei in map MAP.2"
call mAdd t'.CMP',
, "tstMapLong eins keys 3",
, "tstMapLong zweiMal keys 48",
, "tstMapLong dreiMal keys 93",
, "tstMapLong vier keys 138",
, "tstMapLong <fuenf> keys 188",
, "tstMap clear keys 0"
call mapAdd m, 'eins', 1
call mapAdd m, 'zwei', 2
call mapAdd m, 'drei', 3
call mapAdd m, 'vier', 4
call tstMapShow m, 'zwei'
call tstMapShow m, 'Zwei'
call tstMapShowSt m, mapKeys(m)
call mapAdd m, 'eins', 1
call mapReset m, '='
call tstMapShow m, 'zwei'
call mapAdd m, 'eins', 1
call mapAdd m, 'zwei', 2
call mapPut m, 'zwei', 2Put
call mapPut m, 'vier', 4Put
call mapReset q, '='
call mapAdd q, 'zw', 2q
call mapAdd q, 'dr', 3q
call tstOut t, 'q' m.q.0 m.q.1 m.q.2
call tstMapShowSt q, mapKeys(q)
call tstMapShowSt m, mapKeys(m)
call mapAdd m, 'zwei', 2addDup
call tstMapLong m, 'eins' ,201, 2000, -2, 2
call tstMapLong m, 'zweiMal' ,201, 2000, -2, 2
call tstMapLong m, 'dreiMal' ,201, 2000, 2,-2
call tstMapLong m, 'vier ' ,2010, 201, -2, 2
call tstMapLong m, '<fuenf>' ,2010, 201, 2,-2
call mapClear m
keys = mapKeys(m)
call tstOut t, 'tstMap clear keys' m.keys.0
call tstEnd t
return
endProcedure tstMap
tstMapLong: procedure expose m.
parse arg m, w, f1, t1, f2, t2
if f1 < t1 then
b1 = 201
else
b1 = -201
if f2 < t2 then
b2 = 1
else
b2 = -1
lo = copies(w, 2100 % length(w))
keys = mapKeys(m)
keyCn = m.keys.0
call tstOut t, 'tstMapLong' w 'keys' keyCn
do x = f1 by b1 to t1
do y = x+f2 by b2 to x+t2
k = left(lo, y)
if mapHasKey(m, k) then
call err 'mapLong hasKey before' w y
call mapAdd m, k, w y
if ^ mapHasKey(m, k) then
call err 'mapLong ^ hasKey after' w y
if mapGet(m, k) ^== w y then
call err 'mapLong ^ get <> ' w y
keys = mapKeys(m)
if keyCn + 1 ^= m.keys.0 then
call err 'mapLong keys .0 <> ' w y
keyCn = m.keys.0
if k ^== m.keys.keyCn then
call err 'mapLong keys . ' keyCn '<>' w y
end
end
return
endProcedure tstMapLong
tstMapVia: procedure expose m.
call tst t, 'tstMap',
, "map M: K --> A",
, "mapVia(m, K) A",
, "*** err: missing m.A at 3 in mapVia(M, K*)",
, "mapVia(m, K*) M.A",
, "mapVia(m, K*) valAt m.a",
, "mapVia(m, K*) valAt m.a",
, "*** err: missing m.A.aB at 5 in mapVia(M, K*aB)",
, "mapVia(m, K*aB) M.A.aB",
, "mapVia(m, K*aB) valAt m.A.aB",
, "*** err: missing m.valAt m.a at 4 in mapVia(M, K**)",
, "mapVia(m, K**) M.valAt m.a",
, "mapVia(m, K**) valAt m.valAt m.a",
, "mapVia(m, K**F) valAt m.valAt m.a.F"
drop m.a.
call mapReset m
call mapAdd m, k, a
call tstMapShow m, k
call tstOut t, 'mapVia(m, K) ' mapVia(m, 'K')
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
m.a = 'valAt m.a'
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
call tstOut t, 'mapVia(m, K*aB) ' mapVia(m, 'K*aB')
u='A.aB'
m.u = 'valAt m.'u
call tstOut t, 'mapVia(m, K*aB) ' mapVia(m, 'K*aB')
call tstOut t, 'mapVia(m, K**) ' mapVia(m, 'K**')
u= m.a
m.u = 'valAt m.'u
m.u.f = 'valAt m.'u'.F'
call tstOut t, 'mapVia(m, K**) ' mapVia(m, 'K**')
call tstOut t, 'mapVia(m, K**F) ' mapVia(m, 'K**F')
call tstEnd t
return
endProcedure tstMapVia
tstMapShow: procedure expose m.
parse arg a, key
if mapHasKey(a, key) then
call tstOut t, 'map' a':' key '-->' mapGet(a, key)
else
call tstOut t, 'map' a':' key 'is not defined'
return
endProcedure tstMapShow
tstMapShowSt: procedure expose m.
parse arg a, st
call tstOut t, 'map stem' st m.st.0
do wx=1 to m.st.0
call tstMapShow a, m.st.wx
end
return
endProcedure tstMapShow
tstJsay: procedure expose m.
call jIni
call jOut 'out eins'
call jOut 'out zwei jIn' jIn(vv) 'vv='vv
vv = 'value'
call jOut 'out drei jIn' jIn(vv) 'vv='vv 'Schluss'
return
endProcedure tstJsay
tstJ: procedure expose m.
call jIni
oldJin = m.j.jIn
oldJOut = m.j.jOut
m.j.jIn = t
m.j.jOut = t
b = jOpen(jBuf(), 'w')
call tst t, "tstJ",
, "out eins",
, "<jIn 1< tst in line 1 eins ,",
, "1 jIn() tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "2 jIn() tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "3 jIn() tst in line 3 drei |",
, "jIn eof 4",
, "jIn() 3 reads vv VV",
, "line buf line one",
, "line buf line two",
, "line buf line three",
, "line buf line four",
, "*** err: jWrite(" || b", buf line four) but not ope",
|| "ned w"
call jOut 'out eins'
do lx=1 by 1 while jIn(var)
call jOut lx 'jIn()' m.var
end
call jOut 'jIn()' (lx-1) 'reads vv' vv
call jWrite b, 'buf line one'
call mAdd m.b.stem, 'buf line two', 'buf line three'
call jWrite b, 'buf line four'
call jOpen b, 'r'
do while (jRead(b, line))
call jOut 'line' m.line
end
call jWrite b, 'buf line four'
call jClose b
call tstEnd t
return
endProcedure tstJ
tstLmdTiming:
parse arg lev
say timing() lev
call lmdBegin abc, lev
c = 0
do while lmdNext(abc, st.)
c = c + st.0
end
call lmdEnd abc
say timing() lev 'with group - without reading' c
call adrIsp 'lmdinit listid(lmdId) level('lev')'
do c=0 while adrIsp('lmdlist listid(&lmdId) dataset(abc)', 8) = 0
end
call adrIsp 'lmdfree listid(&lmdId)'
say timing() lev 'with list' c
return
endProcedure lmdTiming
tstCat: procedure expose m.
call catIni
call tst t, "tstCat",
, "catRead 1 line 1",
, "catRead 2 line 2",
, "catRead 3 line 3",
, "appRead 1 line 1",
, "appRead 2 line 2",
, "appRead 3 line 3",
, "appRead 4 append 4",
, "appRead 5 append 5"
i = cat('£', jBuf('line 1', 'line 2'), '£', jBuf('line 3'))
call jOpen i, 'r'
do lx=1 by 1 while jRead(i, v)
call tstOut t, 'catRead' lx m.v
end
call jOpen i, 'a'
call jWrite i, 'append 4'
call jWrite i, 'append 5'
call jOpen i, 'r'
do lx=1 by 1 while jRead(i, v)
call tstOut t, 'appRead' lx m.v
end
call tstEnd t
return
endProcedure tstCat
tstJ2: procedure expose m.
call jIni
call tst t, "tstJ2",
, "b read EINS feld eins, ZWEI feld zwei, DREI feld drei",
, "b read EINS feld eins, ZWEI feld zwei 2, DREI feld drei",
, "c read EINS feld eins, ZWEI feld zwei, DREI drei cat 1",
, "c read EINS feld eins, ZWEI feld zwei 2, DREI drei cat 2"
ty = oFldNew('Tst*', , , 'EINS = ZWEI = DREI =')
m.qq.eins = 'feld eins'
m.qq.zwei = 'feld zwei'
m.qq.drei = 'feld drei'
b = jBuf()
call oSetTypePara b, ty
call jOpen b, 'w'
call jWrite b, qq
m.qq.zwei = 'feld zwei 2'
call jWrite b, qq
call jOpen b, 'r'
c = jOpen(cat(), 'w')
call oSetTypePara c, ty
do xx=1 while jRead(b, res)
call jOut 'b read EINS' m.res.eins', ZWEI' m.res.zwei,
|| ', DREI' m.res.drei
m.res.drei = 'drei cat' xx
call jWrite c, res
end
call jOpen c, 'r'
do while jRead(c, ccc)
call jOut 'c read EINS' m.ccc.eins', ZWEI' m.ccc.zwei,
|| ', DREI' m.ccc.drei
end
call tstEnd t
return
endProcedure tstJ2
tstCatDsn: procedure expose m.
call catIni
call tst t, "tstCatDsn",
, "write read 0 last 10 vor anfang",
, "write read 1 last 80 links1 1 und rechts | .",
, "write read 2 last 80 liinks2 2 und rechts | .",
, "write read 5 last 80 links5 5 rechts5",
, "write read 99 last 80 links99 99 rechts",
, "write read 100 last 80 links100 100 rechts",
, "write read 101 last 80 links101 101 rechts",
, "write read 999 last 80 links999 999 rechts",
, "write read 1000 last 80 links1000 1000 rechts",
, "write read 1001 last 80 links1001 1001 rechts",
, "write read 2109 last 80 links2109 2109 rechts",
, "out > eins 1 ",
|| " ",
, "out > eins 2 schluss. ",
|| " ",
, "buf eins",
, "buf zwei",
, "buf drei",
, "out > zwei mit einer einzigen Zeile ",
|| " ",
, " links1 1 und rechts | . ",
|| " "
pds = tstDsn('lib', 'r')
call tstCatDsnWr pds, 0, ' links0', ' und rechts | . '
call tstCatDsnWr pds, 1, ' links1', ' und rechts | . '
call tstCatDsnWr pds, 2, 'liinks2', ' und rechts | . '
call tstCatDsnWr pds, 5, 'links5', 'rechts5'
call tstCatDsnWr pds, 99, 'links99', 'rechts'
call tstCatDsnWr pds, 100, 'links100', 'rechts'
call tstCatDsnWr pds, 101, 'links101', 'rechts'
call tstCatDsnWr pds, 999, 'links999', 'rechts'
call tstCatDsnWr pds, 1000, 'links1000', 'rechts'
call tstCatDsnWr pds, 1001, 'links1001', 'rechts'
call tstCatDsnWr pds, 2109, 'links2109', 'rechts'
pd2 = tstDsn('li2', 'r')
call envPush env('>', pd2'(eins) ::F')
call jOut 'out > eins 1'
call jOut 'out > eins 2 schluss.'
call envPop
call envPush env('>', pd2'(zwei) ::F')
call jOut 'out > zwei mit einer einzigen Zeile'
call envPop
b = jBuf("buf eins", "buf zwei", "buf drei")
call envPush env('<+', pd2'(eins) ::F', '+£', b,
,'+£', jBuf(), '+', pd2'(zwei)',
,'+', pds'(WR0)','', pds'(wr1)')
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstCatDsn
tstCatDsnWR: procedure expose m.
parse arg dsn, num, le, ri
io = catDsn(dsn'(wr'num') ::F')
call jOpen io, 'w'
do x = 1 to num
call jWrite io, le x ri
end
if num > 100 then
call catDsnReset io, dsn'(wr'num') ::F'
call jOpen io, 'r'
m.vv = 'vor anfang'
do x = 1 to num
if ^ jRead(io, vv) then
call err x 'not jRead'
else if m.vv <> le x ri then
call err x 'read mismatch' m.vv
end
if jRead(io, vv) then
call err x 'jRead'
if jRead(io, vv) then
call err x'+1 jRead'
call jClose io
call tstOut t, 'write read' num 'last' length(m.vv) strip(m.vv,'t')
return
endProcedure tstCatDsnRW
tstEnv: procedure expose m.
call envIni
c = jBuf()
call tst t, "tstEnv",
, "before envPush",
, "after envPop",
, "*** err: jWrite("c", write nach pop) but not op",
|| "ened w",
, "<jIn 1< tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "jIn eof 4",
, "before readWrite 2 c --> std",
, "before readWrite 1 b --> c",
, "b line eins",
, "b zwei |",
, "nach readWrite 1 b --> c",
, "add nach pop",
, "after push c only",
, "tst in line 1 eins ,",
, "tst in line 2 zwei ; "
call mAdd t'.CMP',
, "tst in line 3 drei |",
, "nach readWrite 2 c --> std",
, "*** err: jWrite("c", ) but not opened w"
call jOut 'before envPush'
b = jBuf("b line eins", "b zwei |")
call envPush env('<£', b, '>£', c)
call jOut 'before readWrite 1 b --> c'
call envReadWrite
call jOut 'nach readWrite 1 b --> c'
call envPop
call jOut 'after envPop'
call jWrite c, 'write nach pop'
call mAdd c'.BUF', 'add nach pop'
call envPush env('>>£', c)
call jOut 'after push c only'
call envReadWrite
call envPop
call envPush env('<£', c)
call jOut 'before readWrite 2 c --> std'
call envReadWrite
call jOut 'nach readWrite 2 c --> std'
call envPop
call jWrite c
call tstEnd t
return
endProcedure tstEnv
tstEnvCat: procedure expose m.
call tst t, "tstEnvCat",
, "c1 contents",
, "c1 line eins |",
, "before readWrite 1 b* --> c*",
, "b1 line eins|",
, "b2 line eins",
, "b2 zwei |",
, "c2 line eins |",
, "after readWrite 1 b* --> c*",
, "c2 contents",
, "c2 line eins |"
b0= jBuf()
b0= jBuf()
b1= jBuf("b1 line eins|")
b2 = jBuf("b2 line eins", "b2 zwei |")
c1 = jBuf("c1 line eins |")
c2 = jBuf("c2 line eins |")
call envPush env('<+£', b0, '<+£', b1, '<+£', b2, '<£', c2,
,'>>£', c1)
call jOut 'before readWrite 1 b* --> c*'
call envReadWrite
call jOut 'after readWrite 1 b* --> c*'
call envPop
call jOut 'c1 contents'
call envPush env('<£', c1)
call envReadWrite
call envPop
call envPush env('<£', c2)
call jOut 'c2 contents'
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstEnv
tstEnvBar: procedure expose m.
call tst t, 'tstEnvBar',
, "+0 vor envBarBegin",
, "<jIn 1< tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "jIn eof 4",
, "+7 nach envBarLast",
, "¢7 +6 nach envBar 7!",
, "¢7 +2 nach envBar 7!",
, "¢7 +4 nach nested envBarLast 7!",
, "¢7 (4 +3 nach nested envBarBegin 4) 7!",
, "¢7 (4 (3 +1 nach envBarBegin 3) 4) 7!",
, "¢7 (4 (3 tst in line 1 eins , 3) 4) 7!",
, "¢7 (4 (3 tst in line 2 zwei ; 3) 4) 7!",
, "¢7 (4 (3 tst in line 3 drei | 3) 4) 7!",
, "¢7 (4 (3 +1 nach readWrite vor envBar 3) 4) 7!",
, "¢7 (4 +3 nach preSuf vor nested envBarLast 4) 7!",
, "¢7 +4 nach preSuf vor nested envBarEnd 7!"
call mAdd t.cmp,
, "¢7 +5 nach nested envBarEnd vor envBar 7!",
, "¢7 +6 nach readWrite vor envBarLast 7!",
, "+7 nach readWrite vor envBarEnd",
, "+8 nach envBarEnd"
call jOut '+0 vor envBarBegin'
call envBarBegin
call jOut '+1 nach envBarBegin'
call envReadWrite
call jOut '+1 nach readWrite vor envBar'
call envBar
call jOut '+2 nach envBar'
call envBarBegin
call jOut '+3 nach nested envBarBegin'
call envPreSuf '(3 ', ' 3)'
call jOut '+3 nach preSuf vor nested envBarLast'
call envBarLast
call jOut '+4 nach nested envBarLast'
call envPreSuf '(4 ', ' 4)'
call jOut '+4 nach preSuf vor nested envBarEnd'
call envBarEnd
call jOut '+5 nach nested envBarEnd vor envBar'
call envBar
call jOut '+6 nach envBar'
say '?? 6 call envReadWrite'
call envReadWrite
say 'jOut +6 nach readWrite vor envBarLast'
call jOut '+6 nach readWrite vor envBarLast'
call envBarLast
call jOut '+7 nach envBarLast'
call envPreSuf '¢7 ', ' 7!'
call jOut '+7 nach readWrite vor envBarEnd'
call envBarEnd
call jOut '+8 nach envBarEnd'
call tstEnd t
return
endProcedure tstEnvBar
tstEnvLazy: procedure expose m.
call tst t, "tstEnvLazy",
, "vor envBarBegin",
, "vor 2 writeAll jIn inIx 0",
, "vor writeAll jBuf",
, "jBuf line 1",
, "jBuf line 2",
, "vor writeAll jIn inIx 0",
, "<jIn 1< tst in line 1 eins ,",
, "tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "tst in line 3 drei |",
, "jIn eof 4",
, "vor barLast inIx 0",
, "vor barEnd inIx 4",
, "nach barEnd"
call jOut 'vor envBarBegin'
call envBarBegin
call jOut 'vor writeAll jBuf'
call jWriteAll m.j.jOut, "£", jBuf('jBuf line 1', 'jBuf line 2')
call jOut 'vor writeAll jIn inIx' m.t.inIx
call jWriteAll m.j.jOut, "£-", m.j.jIn
call jOut 'vor barLast inIx' m.t.inIx
call envBarLast
call jOut 'vor 2 writeAll jIn inIx' m.t.inIx
call jWriteAll m.j.jOut, "£-", m.j.jIn
call jOut 'vor barEnd inIx' m.t.inIx
call envBarEnd
call jOut 'nach barEnd'
call tstEnd t
return
endProcedure tstEnvLazy
tstEnvVars: procedure expose m.
call tst t, "tstEnvVars",
, "put v1 value eins",
, "v1 hasKey 1 get value eins",
, "v2 hasKey 0",
, "via v1.fld via value",
, "one to theBur",
, "two to theBuf"
put1 = envPut('v1', 'value eins')
call tstOut t, 'put v1' put1
call tstOut t, 'v1 hasKey' envHasKey('v1') 'get' envGet('v1')
call tstOut t, 'v2 hasKey' envHasKey('v2')
if 0 then
call tstOut t, 'v2 get' envGet('v2')
m.put1.fld = 'via value'
call tstOut t, 'via v1.fld' envVia('v1*FLD')
call envPush env('>#', 'theBuf')
call jOut 'one to theBur'
call jOut 'two to theBuf'
call envPop
call envPush env('<#', 'theBuf')
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstEnvVars
tstScan: procedure expose m.
call tst t, 'tstScan.1',
, "scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' ",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "scan n tok 3: Und key val ",
, "scan v tok 1: key val ",
, "scan n tok 10: hr123sdfER key val ",
, "scan q tok 5: ""st1"" key val st1",
, "scan v tok 1: key val st1",
, "scan a tok 19: 'str2''mit''apo''s' key val str2'mit'apo's",
, "scan v tok 1: key val str2'mit'apo's"
call tstScan1 ,'l"litEins"l"litZwei"ndv" "aq1' ,
,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call tstEnd t
call tst t, 'tstScan.2',
, "scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' ",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "scan n tok 3: Und key val ",
, "scan b tok 0: key val ",
, "scan n tok 10: hr123sdfER key val ",
, "scan s tok 5: ""st1"" key val st1",
, "scan b tok 0: key val st1",
, "scan s tok 19: 'str2''mit''apo''s' key val str2'mit'apo's",
, "scan b tok 0: key val str2'mit'apo's"
call tstScan1 , 'ndsb1' ,
,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call tstEnd t
call tst t, 'tstScan.3',
, "scan src a034,'wie 789abc",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "*** err: scanErr ending Apostroph(') missing",
, " e 1: last token scanPosition 'wie 789abc",
, " e 2: pos 6 in string a034,'wie 789abc",
, "scan 1 tok 1: ' key val ",
, "scan n tok 3: wie key val ",
, "scan 1 tok 1: key val ",
, "*** err: scanErr illegal number end",
, " e 1: last token 789 scanPosition abc",
, " e 2: pos 14 in string a034,'wie 789abc",
, "scan d tok 3: 789 key val ",
, "scan n tok 3: abc key val "
call tstScan1 , 'nds1' ,
,"a034,'wie 789abc"
call tstEnd t
call tst t, 'jTestScan.4',
, "scan src litEinsefr 23 sdfER'str1'litZwei ""str2""""mit qu",
|| "o""s ",
, "scan l tok 7: litEins key val ",
, "scan n tok 3: efr key val ",
, "scan b tok 0: key val ",
, "scan d tok 2: 23 key val ",
, "scan b tok 0: key val ",
, "scan n tok 5: sdfER key val ",
, "scan a tok 6: 'str1' key val str1",
, "scan l tok 7: litZwei key val str1",
, "scan b tok 0: key val str1",
, "scan q tok 15: ""str2""""mit quo"" key val str2""mit quo",
, "scan n tok 1: s key val str2""mit quo",
, "scan b tok 0: key val str2""mit quo"
call tstScan1 , 'l"litEins"l"litZwei"ndbaq1' ,
,"litEinsefr 23 sdfER'str1'litZwei ""str2""""mit quo""s "
call tstEnd t
call tst t, 'jTestScan.5',
, "scan src aha;+-=f ab=cdEf eF='strIng' ",
, "scan b tok 0: key val ",
, "scan k tok 4: no= key aha val def",
, "scan 1 tok 1: ; key aha val def",
, "scan 1 tok 1: + key aha val def",
, "scan 1 tok 1: - key aha val def",
, "scan 1 tok 1: = key aha val def",
, "scan k tok 4: no= key f val def",
, "scan k tok 4: cdEf key ab val cdEf",
, "scan b tok 4: cdEf key ab val cdEf",
, "scan k tok 8: 'strIng' key eF val strIng",
, "scan b tok 8: 'strIng' key eF val strIng"
call tstScan1 , 'bk1'," aha;+-=f ab=cdEf eF='strIng' "
call tstEnd t
return
endProcedure tstScan
tstScanRead: procedure expose m.
call tst t, 'jTestScanRead',
, "name erste",
, "space",
, "name Zeile",
, "space",
, "nextLine",
, "nextLine",
, "space",
, "name dritte",
, "space",
, "name Zeile",
, "space",
, "name schluss",
, "space"
b = jBuf('erste Zeile ',,' dritte Zeile schluss ')
s = scanRead(b)
do while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanVerify(s, ' ') then call tstOut t, 'space'
else if scanReadNL(s) then call tstOut t, 'nextLine'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanRead mit spaceLn',
, "name erste",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name dritte",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name schluss",
, "spaceLn"
s = scanRead(b)
do forever
if scanName(s) then call jOut 'name' m.s.tok
else if scanSpaceNL(s) then call jOut 'spaceLn'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
else leave
end
call tstEnd t
return
endProcedure tstScanRead
tstScanWin: procedure expose m.
call scanWinIni
call tst t, 'jTestScanWin',
, "info 0: last token scanPosition erste Zeile ",
|| " dritteZe\npos 1 in line 1: erste Zeile",
, "name erste",
, "spaceNL",
, "name Zeile",
, "spaceNL",
, "name dritteZeeeile",
, "info 5: last token dritteZeeeile scanPosition zeile4 ",
|| " fuenfueberSechs\npos 1 in line 4: zeile4",
, "spaceNL",
, "name zeile4",
, "spaceNL",
, "name fuenfueberSechsUnddSiebenUNDundUndUAcht",
, "spaceNL",
, "info 10: last token scanPosition undZehnueberElfundNochWe",
|| "iterZwoelfundim1\npos 9 in line 10: undZehn",
, "name undZehnueberElfundNochWeiterZwoelfundim13",
, "spaceNL",
, "name Punkt",
, "infoE 14: last token Punkt scanPosition \natEnd after line",
|| " 13: im13 Punkt"
b = jBuf('?erste Zeile?',,'? dritteZeeeile?', '? zeile4 ',
,'? fuenf?', '?ueberSechsUnddS?', '?iebenUNDundUndU?',
,'?Acht ?', '? ?', '? undZehn?',
,'?ueberElfundNoch?', '?WeiterZwoelfund?', '?im13 Punkt?')
s = scanWin(b, , , 2, 15)
call tstOut t, 'info 0:' scanInfo(s)
do sx=1 while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
if sx // 5 = 0 then
call tstOut t, 'info' sx':' scanInfo(s)
end
call tstOut t, 'infoE' sx':' scanInfo(s)
call tstEnd t
call tst t, 'jTestScanRead',
, "info 0: last token scanPosition erste Zeile ",
|| " z3 com Ze\npos 1 in line 1: erste Zeile",
, "name erste",
, "spaceNL",
, "name Zeile",
, "spaceNL",
, "name z3",
, "info 5: last token z3 scanPosition com Zeeeile z4 come4 ",
|| " fuenf\npos 4 in line 3: z3 com Zeeeile",
, "spaceNL",
, "name z4",
, "spaceNL",
, "name fuenf",
, "spaceNL",
, "info 10: last token scanPosition com Sechs com siebe",
|| "n comAcht com\npos 15 in line 5: fuenf c",
, "name com",
, "spaceNL"
call mAdd t.cmp,
, "name Sechs",
, "spaceNL",
, "name com",
, "info 15: last token com scanPosition sieben comAcht c",
|| "om com com\npos 2 in line 7: m sieben com" ,
, "spaceNL",
, "name sieben",
, "spaceNL",
, "name Acht",
, "spaceNL",
, "info 20: last token scanPosition ueberElfundNochWeit com ",
|| "elfundim13\npos 1 in line 11: ueberElfundNoch",
, "name ueberElfundNochWeit",
, "spaceNL",
, "name im13",
, "spaceNL",
, "name Punkt",
, "info 25: last token Punkt scanPosition \natEnd after line ",
|| "13: im13 Punkt",
, "infoE 26: last token Punkt scanPosition \natEnd after line",
|| " 13: im13 Punkt"
b = jBuf('?erste Zeile?',,'? z3 com Zeeeile?', '? z4 come4 ',
,'? fuenf c?', '?om Sechs co?', '?m sieben com?',
,'?Acht com com ?', '? com ?', '? com undZehn?',
,'?ueberElfundNoch?', '?Weit com elfund?', '?im13 Punkt?')
s = scanWin(b, , , 2, 15)
call scanOpts s, , , 'com'
call tstOut t, 'info 0:' scanInfo(s)
do sx=1 while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
if sx // 5 = 0 then
call tstOut t, 'info' sx':' scanInfo(s)
end
call tstOut t, 'infoE' sx':' scanInfo(s)
call tstEnd t
return
endProcedure tstScanWin
tstScanSql: procedure expose m.
call scanWinIni
call tst t, 'jTestScanSql id',
, "sqlId ABC",
, "spaceNL",
, "sqlId AB__345EF",
, "spaceNL"
b = jBuf('abc -- kommentar', right('ab_', 72), '_345ef-- kom')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlID(s) then call tstOut t, 'sqlId' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql delimited',
, "sqlDeId ABC",
, "spaceNL",
, "sqlDeId AB_3F",
, "spaceNL",
, "sqlDeId abc",
, "spaceNL",
, "sqlDeId ab_Ef",
, "spaceNL"
b = jBuf('abc -- kommentar',,' -- ',,right('ab_', 72),'3F-- kom',
, '"abc" -- ko', ' -- ',,right('"ab_', 72),'Ef"-- kom')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlDeID(s) then call tstOut t, 'sqlDeId' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql qualified',
, "sqlQuId ABC 1 ABC",
, "sqlQuId AB_3F 1 AB_3F",
, "sqlQuId abc 1 abc",
, "sqlQuId ab_Ef 1 ab_Ef",
, "sqlQuId EINS.Zwei.DREI 3 EINS",
, "sqlQuId vi er.fu enf 2 vi er"
b = jBuf('abc -- kommentar',,' -- ',,right('ab_', 72),'3F-- kom',
, '"abc" -- ko', ' -- ',right('"ab_', 72),'Ef"-- kom',
, 'eins."Zwei', '" -- com', ' . -- com', ' -- com',
, 'drei -- ko', '"vi er"."fu enf " -- co')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlQuID(s) then
call tstOut t, 'sqlQuId' m.s.val m.s.val.0 m.s.val.1
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql Num',
, "sqlNum 1",
, "spaceNL",
, "sqlNum 2",
, "spaceNL",
, "sqlNum .3",
, "spaceNL",
, "sqlNum 4.5",
, "spaceNL",
, "sqlNum +6",
, "spaceNL",
, "sqlNum +7.03",
, "spaceNL",
, "sqlNum -8",
, "spaceNL",
, "sqlNum -.9",
, "spaceNL"
call mAdd t.cmp,
, "sqlNum 1E2",
, "spaceNL",
, "sqlNum -2E-2",
, "spaceNL",
, "sqlNum +.3E+3",
, "spaceNL"
b = jBuf('1 2. .3 4.5 +6 + --kom', , ' -- com ', , ' 7.03 -8 - .9',
'1e2 - 2.e-2 + .3e+3')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlNum(s) then
call tstOut t, 'sqlNum' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql Num Unit',
, "sqlNumUnit 1 KB",
, "spaceNL",
, "sqlNumUnit .3 MB",
, "sqlNumUnit .5",
, "sqlNumUnit +6E-5 B",
, "spaceNL",
, "sqlNumUnit -7",
, "char *",
, "spaceNL",
, "sqlNumUnit -.8",
, "char T",
, "char B",
, "spaceNL",
, "*** err: scanErr scanSqlNumUnit after +9 bad unit TB",
, " e 1: last token Tb scanPosition ",
, " e 2: pos 41 in line 1: 1 kb .3mB.5 + 6.e-5B -7* -.8 ",
|| "TB + 9.Tb",
, "sqlNumUnit +9",
, "spaceNL"
b = jBuf('1 kb .3mB.5 + 6.e-5B -7* -.8 TB + 9.Tb')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlNumUnit(s, 0, 'B KB MB') then
call tstOut t, 'sqlNumUnit' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if scanChar(s ,1) then call tstOut t, 'char' m.s.tok
else call scanErr s, 'cannot scan'
end
call tstEnd t
return
call tst t, 'jTestScanRead',
, "info 0: last token scanPosition erste Zeile ",
|| " z3 com Ze\npos 1 in line 1: erste Zeile",
, "name erste",
, "spaceNL",
, "name Zeile",
, "spaceNL",
, "name z3",
, "info 5: last token z3 scanPosition com Zeeeile z4 come4 ",
|| " fuenf\npos 4 in line 3: z3 com Zeeeile",
, "spaceNL",
, "name z4",
, "spaceNL",
, "name fuenf",
, "spaceNL",
, "info 10: last token scanPosition com Sechs com siebe",
|| "n comAcht com\npos 15 in line 5: fuenf c",
, "name com",
, "spaceNL"
call mAdd t.cmp,
, "name Sechs",
, "spaceNL",
, "name com",
, "info 15: last token com scanPosition sieben comAcht c",
|| "om com com\npos 2 in line 7: m sieben com" ,
, "spaceNL",
, "name sieben",
, "spaceNL",
, "name Acht",
, "spaceNL",
, "info 20: last token scanPosition ueberElfundNochWeit com ",
|| "elfundim13\npos 1 in line 11: ueberElfundNoch",
, "name ueberElfundNochWeit",
, "spaceNL",
, "name im13",
, "spaceNL",
, "name Punkt",
, "info 25: last token Punkt scanPosition \natEnd after line ",
|| "13: im13 Punkt",
, "infoE 26: last token Punkt scanPosition \natEnd after line",
|| " 13: im13 Punkt"
b = jBuf('?erste Zeile?',,'? z3 com Zeeeile?', '? z4 come4 ',
,'? fuenf c?', '?om Sechs co?', '?m sieben com?',
,'?Acht com com ?', '? com ?', '? com undZehn?',
,'?ueberElfundNoch?', '?Weit com elfund?', '?im13 Punkt?')
s = scanWin(b, , ,'com', , , 2, 15)
call tstOut t, 'info 0:' scanInfo(s)
do sx=1 while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
if sx // 5 = 0 then
call tstOut t, 'info' sx':' scanInfo(s)
end
call tstOut t, 'infoE' sx':' scanInfo(s)
call tstEnd t
return
call tst t, 'jTestScanRead mit spaceLn',
, "name erste",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name dritte",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name schluss",
, "spaceLn"
s = scanRead(b)
do forever
if scanName(s) then call jOut 'name' m.s.tok
else if scanSpaceNL(s) then call jOut 'spaceLn'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
else leave
end
call tstEnd t
return
endProcedure tstScanSql
/*--- one single test scan with lines to scan in stem ln -------------*/
tstScan1:
parse arg sc, types, ln
if sc == '' then do
call tstOut t, 'scan src' ln
call scanSrc scanReset(s), ln
end
else do
call tstOut t, 'scan scanner' sc
s = sc
end
do forever
x = tstScanType(s, types)
if x == '' then
leave
call tstOut t, 'scan' x 'tok' length(m.s.tok)':' m.s.tok ,
'key' m.s.key 'val' m.s.val
end
return
endProcedure tstScan1
tstScanType: procedure expose m.
parse arg s, opt
cx = 1
a2 = ''
do while cx <= length(opt)
f = substr(opt, cx, 1)
cx = cx + 1
if pos(substr(opt, cx, 1), "'""") > 0 then do
m.scan.type.src = opt
m.scan.type.pos = cx
call scanString 'SCAN.TYPE'
a2 = m.scan.type.val
cx = m.scan.type.pos
end
if f == 'a' then
res = scanString(s, "'")
else if f == 'b' then
res = scanSpaceNl(s)
else if f == 'c' then
res = scanChar(s, a2)
else if f == 'd' then
res = scanNat(s, a2)
else if f == 'k' then
res = scanKeyValue(s, 'def')
else if f == 'l' then
res = scanLit(s, a2)
else if f == 'n' then
res = scanName(s)
else if f == 'q' then
res = scanString(s, '"')
else if f == 's' then
res = scanString(s)
else if f == 'v' then
res = scanVerify(s, a2)
else if f == 'w' then
res = scanWord(s)
else if f == 'y' then
res = scanVerify(s, a2, 'm')
else if pos(f, '123456789') > 0 then
res = scanChar(s, f)
else
call err 'bad scanType' f
if res then
return f
end
return ''
endProcedure tstScanType
tstO: procedure expose m.
cR = oNewClass('R')
iR = 'O.C'm.o.cla.cR'I'
oo = 'call tstOut' t','
call oDecMethods cR, "print" oo "'Rprint' m a1",
, "say" oo "'Rsay ' m a2; return"
cS = oNewClass('S', "R")
is = 'O.C'm.o.cla.cS'I'
call oDecMethods cS, "print" oo "'Sprint' m a1; return",
, "quak" oo "'Squak ' m a3; return 'quak'a3"
call tst t, 'tstO',
, "class R with 2 methods",
, " print call tstOut T, 'Rprint' m a1",
, " say call tstOut T, 'Rsay ' m a2; return",
, "class S with 3 methods",
, " print call tstOut T, 'Sprint' m a1; return",
, " say call tstOut T, 'Rsay ' m a2; return",
, " quak call tstOut T, 'Squak ' m a3; return 'quak'a3",
, "oR.print call tstOut T, 'Rprint' m a1",
, "oS.print call tstOut T, 'Sprint' m a1; return",
, "oS.say call tstOut T, 'Rsay ' m a2; return",
, "Rsay "iR"1 arg oR say",
, "Rprint "iR"1 arg oR print",
, "Rsay "iS"1 arg oS say"
call mAdd t.cmp ,
, "Sprint "iS"1 arg oS print",
, "Squak "iS"1 arg oS quak",
, "quak: quakarg oS quak",
, "Rprint "iS"1 cast(os, R)",
, "Sprint "iS"1 cast(os, R), S)",
, "mutate oS R "iS"1",
, "Rprint "iS"1 mutate R",
, "oRun 7*3 21",
, "oRun 12*12 144"
cc = 'R S'
do cx=1 to words(cc)
cl = word(cc, cx)
call tstOut t, 'class' cl 'with' m.o.cla.cl.met.0 'methods'
do mx=1 to m.o.cla.cl.met.0
me = m.o.cla.cl.met.mx
call tstOut t, ' ' me m.o.cla.cl.met.me
end
end
oR = oNew(cR)
oS = oNew(cS)
call tstOut t, 'oR.print' oObjMethod(oR, 'print')
call tstOut t, 'oS.print' oObjMethod(oS, 'print')
call tstOut t, 'oS.say' oObjMethod(oS, 'say')
call tstClassRsay oR, 'arg oR say'
call tstClassRprint oR, 'arg oR print'
call tstClassRsay oS, 'arg oS say'
call tstClassRprint oS, 'arg oS print'
call tstOut t, 'quak:' tstClassSquak(oS, 'arg oS quak')
q1 = oCast(oS, 'R')
call tstClassRprint q1, 'cast(os, R)'
q2 = oCast(q1, 'S')
call tstClassRprint q2, 'cast(os, R), S)'
call tstOut t, 'mutate oS R' oMutate(oS, 'R')
call tstClassRprint oS, 'mutate R'
rr = oRunner('return 7 * 3')
call tstOut t, 'oRun 7*3' oRun(rr)
call oRunnerReset rr, 'return 12 * 12'
call tstOut t, 'oRun 12*12' oRun(rr)
call tstEnd t
return
endProcedure tstO
tstOType: procedure
call oIni
si = 'Simple'
call oFldNew 'T1', '=', '=', 'A = B ='
m.x.0 = 3
call oSay 'T1', x
call oSay 'Class', 'O.CLA.='
call oSay 'Class', 'O.CLA.Class'
call oClear 'Class', abc, 'abc'
call oSay 'Class', abc
call oTyCopy 'Class', abc, 'O.CLA.Class'
call oSay 'Class', abc
call oCopy efg, 'O.CLA.Class'
call oSay 'Class', efg
ff = oFlds('Class')
x = m.ff.0
say 'fields' x':' m.ff.1 m.ff.2 '...' m.ff.x
return
endProcedure tstOType
tstClassRprint: procedure expose m.
parse arg m, a1
interpret oObjMethod(m, 'print')
return
endProcedure tstClassRprint
tstClassRsay: procedure expose m.
parse arg m, a2
interpret oObjMethod(m, 'say')
endProcedure tstClassRsay
tstClassSquak: procedure expose m.
parse arg m, a3
interpret oObjMethod(m, 'quak')
endProcedure tstClassSquak
/* copx tstBase end *************************************************/
/* copx tst begin ****************************************************
test infrastructure
***********************************************************************/
/*--- return stems ---------------------------------------------------*/
/*--- make writerDescriptor m a testWriter
--- and use remaining lines as compare values -----------------*/
tst: procedure expose m.
parse arg m, nm
if m.tst.ini <> 1 then
call tstIni
m.m.name = nm
m.tst.act = m
m.tst.tests = m.tst.tests+1
call oMutate m, 'Tst'
m.m.jReading = 1
m.m.jWriting = 1
ox = 1
m.m.cmp.ox = left('****** start tst' nm '', 79, '*')
do ax=3 to arg()
ox = ox + 1
m.m.cmp.ox = arg(ax)
end
m.m.cmp.0 = ox
m.m.in.0 = 0
m.m.inIx = 0
m.m.out.0 = 0
m.m.err = 0
call mAdd m'.IN', 'tst in line 1 eins ,' ,
, 'tst in line 2 zwei ; ' ,
, 'tst in line 3 drei |'
call oMutate m, 'Tst'
if m.env.0 <> 1 then
call tstErr m, 'm.env.0' m.env.0 '<> 1'
call envPush env( '<-£', m, '>-£', m)
call tstOut m, m.m.cmp.1
return 'TST.'m
endProcedure tst
tstEnd: procedure expose m.
parse arg m, opt
m.tst.act = ''
call envPop
if m.env.0 <> 1 then
call tstErr m, 'm.env.0' m.env.0 '<> 1'
if m.m.out.0 ^= m.m.cmp.0 then do
call tstErr m, 'old' m.m.cmp.0 'lines ^= new' m.m.out.0
do nx = m.m.out.0 + 1 to min(m.m.out.0+10, m.m.cmp.0)
say 'old - ' m.m.cmp.nx
end
end
if m.m.err > 0 then do
say 'new lines:' (m.m.out.0 - 1)
len = 60
do nx=2 to m.m.out.0
str = quote(m.m.out.nx, '"')
pr = ' , '
do while length(str) > len
l=len
if substr(str, l-1, 1) = '"' then
if posCount('"', left(str, l-1)) // 2 = 0 then
l = l-1
say pr left(str, l-1)'",'
str = '"'substr(str, l)
pr = ' ||'
end
say pr str || left(',', nx < m.m.out.0)
end
end
say left('******' m.m.name 'end with' m.m.err 'errors ', 79,
, '*')
return
endProcedure tstEnd
/*--- write to test: say lines and compare them ----------------------*/
tstWrite: procedure expose m.
parse arg m, arg
call tstOut m, 'jOut:' arg
return
endProcedure tstWrite
tstOut: procedure expose m.
parse arg m, arg
call mAdd m'.OUT', arg
nx = m.m.out.0
if nx > m.m.cmp.0 then do
if nx = m.m.cmp.0+1 then
call tstErr m, 'more new Lines' nx
end
else if m.m.cmp.nx ^== arg then do
call tstErr m, 'next line old' nx '^^^ new overnext'
say m.m.cmp.nx
end
say arg
return
endProcedure tstOut
tstRead: procedure expose m.
parse arg m, arg
ix = m.m.inIx + 1
m.m.inIx = ix
if ix <= m.m.in.0 then do
m.arg = m.m.in.ix
call tstOut m, '<jIn' ix'<' m.arg
return 1
end
call tstOut m, 'jIn eof' ix
return 0
endProcedure tstRead
tstDsn: procedure
parse arg suf, opt
dsn = dsn2jcl('~tmp.tst.'suf)
if opt = 'r' & sysDsn("'"dsn"'") ^== 'DATASET NOT FOUND' then
call adrTso "delete '"dsn"'"
return dsn
endProcedure tstDsn
/*--- say total errors and fail if not zero --------------------------*/
tstTotal: procedure expose m.
say '******'
say '******'
say '******' m.tst.tests 'tests with' ,
m.tst.err 'errors in' m.tst.errNames
say '******'
say '******'
if m.tst.err ^== 0 then
call err m.tst.err 'errors total'
return
endProcedure tstTotal
/*--- test err: message, count it and continue -----------------------*/
tstErr: procedure expose m.
parse arg m, msg
say '*** error' msg
m.m.err = m.m.err + 1
m.tst.err = m.tst.err + 1
nm = m.m.name
if wordPos(nm, m.tst.errNames) < 1 then
m.tst.errNames = m.tst.errNames nm
return
endProcedure tstErr
/*--- tstErrHandler: intercept errors --------------------------------*/
tstErrHandler: procedure expose m.
parse arg ggTxt
if m.tst.act == '' then
call err ggTxt, '*'
call errSay ggTxt, tstErrHandler
call tstOut m.tst.act, '*** err:' m.tstErrHandler.1
do x=2 to m.tstErrHandler.0
call tstOut m.tst.act, ' e' (x-1)':' m.tstErrHandler.x
end
return 12
endSubroutine tstErrHandler
/*--- tstIni: global initialization ----------------------------------*/
tstIni: procedure expose m.
if m.tst.ini == 1 then
return
m.tst.ini = 1
call envIni
m.tst.err = 0
m.tst.errNames = ''
m.tst.tests = 0
m.tst.act = ''
call oDecMethods oNewClass("Tst", 'JRW'),
, "jRead return tstRead(m, var)",
, "jWrite call tstOut m, line"
call errReset 'h', 'return tstErrHandler(ggTxt)'
return
endProcedure tstIni
/*--- return the count of occurrences of needle in heyStack ----------*/
posCount: procedure
parse arg needle, hayStack, start, fin
if start = '' then
start = 1
if fin = '' then
fin = length(hayStack) + 1 - length(needle)
do cnt = 0 by 1
start = pos(needle, haystack, start)
if start < 1 | start > fin then
return cnt
start = start + length(needle)
end
endProcedure posCount
/* copx tst end **************************************************/
/* copy tstAll end **************************************************/
/* copy sort begin ****************************************************/
sort: procedure expose m.
parse arg i, o
call sort1 i, 1, m.i.0, o, 1, sort.work, 1
m.o.0 = m.i.0
return
endProcedure sort
sort1: procedure expose m.
parse arg i, i0, le, o, o0, w, w1
if le <= 1 then do
if le = 1 then
m.o.o0 = m.i.i0
return
end
h = (le + 1) % 2
call sort1 i, i0, h, o, o0+le-h, w, w1
call sort1 i, i0+h, le-h, w, w1, o, o0
call sortMerge o, o0+le-h, o0+le, w, w1, w1+le-h, o, o0
return
endProcedure sort1
sortMerge: procedure expose m.
parse arg l, l0, le, r, r0, re, o, o0
do while l0 < le & r0 < re
if m.l.l0 <<= m.r.r0 then do
m.o.o0 = m.l.l0
l0 = l0 + 1
end
else do
m.o.o0 = m.r.r0
r0 = r0 + 1
end
o0 = o0 + 1
end
do while l0 < le
m.o.o0 = m.l.l0
l0 = l0 + 1
o0 = o0 + 1
end
do while r0 < re
m.o.o0 = m.r.r0
r0 = r0 + 1
o0 = o0 + 1
end
return
endProcedure sortWork
/* copy sort end ****************************************************/
/* copy match begin ***************************************************/
/************************************* begin copy match ******/
/*--- wildCard matching with the following wildchars:
* 0-n chars
? 1 char
fill matched expressions instem st if st is non empty
return 1 if mask matches wert ----------------------------------*/
match: procedure expose m.
parse arg wert, mask, st
if st == '' then
return matchRO(wert, mask)
m.st.0 = -9
return matchSt(wert, mask, st, 0)
endProcedure match
/*--- return the fixed prefix of maskt -------------------------------*/
matchPref: procedure
arg mask, suff
ix = verify(mask, '*?', 'm')
if ix = 0 then
return mask
else
return left(mask, ix-1)suff
endProcedure matchPref
/*--- return true if mask matches wert -------------------------------*/
matchRO: procedure
arg wert, mask
ix = verify(mask, '*?', 'm')
if ix < 1 then return (mask == wert)
if length(wert) < ix-1 then return 0
if left(mask, ix-1) ^== left(wert, ix-1) then return 0
if substr(mask, ix, 1) == '?' then do
if length(wert) < ix then return 0
return matchRO(substr(wert, ix+1), substr(mask, ix+1))
end
mask = substr(mask, ix+1) /* * 0 - n Chars */
do ex = 1+length(wert) to ix by -1
if matchRO(substr(wert, ex), mask) then return 1
end
return 0
endProcedure matchRO
/*--- wildCard matching: fill matched expressions instem st
return 1 if mask matches wert ----------------------------------*/
matchSt: procedure expose m.
parse arg wert, mask, st, sx
ix = verify(mask, '*?', 'm')
if ix < 1 then do
if mask ^== wert then
return 0
m.st.0 = sx
return 1
end
if ^ abbrev(wert, left(mask, ix-1)) then
return 0
reMa = substr(mask, ix+1)
sx = sx + 1
if substr(mask, ix, 1) == '?' then do /* ? 1 Character */
if length(wert) < ix then
return 0
m.st.sx = substr(wert, ix, 1)
return matchSt(substr(wert, ix+1), reMa, st, sx)
end
do lx = 1+length(wert) to ix by -1 /* greedy: from all to empty */
if matchSt(substr(wert, lx), reMa, st, sx) then do
m.st.sx = substr(wert, ix, lx-ix)
return 1
end
end
return 0
endProcedure matchSt
matchTrans: procedure expose m.
parse arg mask, st
r = ''
ox = 1
sx = 0
ix = verify(mask, '*?', 'm')
do sx=1 to m.st.0 while ix > 0
if sx > m.st.0 then
call err 'matchTrans('mask',' st') has only' ,
m.st.0 'variables'
r = r || substr(mask, ox, ix-ox)m.st.sx
ox = ix+1
ix = verify(mask, '*?', 'm', ox)
end
if ix > 0 then
call err 'matchTrans('mask',' st') has only' ,
m.st.0 'variables'
return r || substr(mask, ox)
endProcedure matchTrans
/* copy match end *****************************************************/
/* copy comp begin *****************************************************
the shell compiler
syntax and semantics of the shell language see javaDoc
***********************************************************************/
/*--- module initialisation ------------------------------------------*/
compIni: procedure expose m.
if m.compIni = 1 then
return
m.compIni = 1
call envIni
call scanReadIni
cc = oNewClass('Compiler')
return
endProcedure compIni
/*--- constructor of Compiler ----------------------------------------*/
comp: procedure expose m.
parse arg src
nn = oNew('Compiler')
m.nn.scan = scanRead(src)
return compReset(nn, src)
endProcedure comp
compReset: procedure expose m.
parse arg m, src
call scanReadReset m.m.scan, src, , ,'$*'
m.m.chDol = '$'
m.m.chSpa = ' '
m.m.chNotWord = '${}=£:' || m.m.chSpa
m.m.stack = 0
return m
endProceduere compReset
/*--- push an empty stem on the stack --------------------------------*/
compPushStem: procedure expose m.
parse arg m
m.m.stack = m.m.stack + 1
pp = m'.STACK'm.m.stack
m.pp.0 = 0
return pp
endProcedure compPushStem
/*--- push a stem from the stack -------------------------------------*/
compPop: procedure expose m.
parse arg m, pp
if pp ^== m'.STACK'm.m.stack then
call err 'compPop pp' pp 'mismatch to' m'.STACK'm.m.stack
m.m.stack = m.m.stack - 1
return m
endProcedure compPop
/*--- compile the source and return an oRunner with the code ---------*/
compile: procedure expose m.
parse arg m, type
if type == 's' then do
what = "shell"
expec = "pipe or $;";
call compSpNlComment m
src = compShell(m)
end
else if type == 'd' then do
what = "data";
expec = "sExpression or block";
src = compData(m, 0)
end
else do
call err "bad type " type
end
if ^ scanAtEnd(m.m.scan) then
call scanErr m.m.scan, expec "expected: compile" what ,
" stopped before end of input"
call scanClose m.m.scan
r = oRunner(src)
return r
endProcedure compile
/*--- compile data lines return stmts or expr ------------------------*/
compData: procedure expose m.
parse arg m, makeExpr
s = m.m.scan
exprs = compPushStem(m)
do forever
aftEol = 0
do forever
text = "";
do forever
if scanVerify(s, m.m.chDol, 'm') then
text = text || m.s.tok
if ^ compComment(m) then
leave
end
nd = compExpr(m, 'd')
befEol = scanReadNL(s)
if nd <> '' | (aftEol & befEol) ,
| verify(text, m.m.chSpa) > 0 then do
if text ^== '' then
text = quote(text)
if text ^== '' & nd ^= '' then
text = text '|| '
call mAdd exprs, 'e' compNull2EE(text || nd)
end
if ^ befEol then
leave
aftEol = 1
end
one = compStmt(m)
if one == '' then
one = compRedirIO(m, 0)
if one == '' then
leave
call mAdd exprs, 's' one
end
if m.exprs.0 < 1 then do
if makeExpr then
res = '""'
else
res = ';'
end
else do
do x=1 to m.exprs.0 while left(m.exprs.x, 1) = 'e'
end
res = ''
if makeExpr & x > m.exprs.0 then do
res = substr(m.exprs.1, 3)
do x=2 to m.exprs.0
res = res substr(m.exprs.x, 3)
end
end
else do
do x=1 to m.exprs.0
if left(m.exprs.x, 1) = 'e' then
res = res 'call jOut'
res = res substr(m.exprs.x, 3)';'
end
if makeExpr then
res = "mCat("compStmts2ExprBuf(res)"'.BUF', ' ')"
end
end
call compPop m, exprs
return res
endProcedure compData
/*--- compile shell and return code ----------------------------------*/
compShell: procedure expose m.
parse arg m
res = ''
do forever
one = compPipe(m)
if one ^== '' then
res = res one
if ^ scanLit(m.m.scan, '$;') then
return strip(res)
call compSpNlComment m
end
endProcedure compShell
/*--- compile an expression, type d=data, w=word, s=strip ------------*/
compExpr: procedure expose m.
parse arg m, type
res = ''
if type == 'w' then
charsNot = m.m.chNotWord
else
charsNot = m.m.chDol
s = m.m.scan
if pos(type, 'sw') > 0 then
call compSpComment m
do forever
txt = ''
do forever
if scanVerify(s, charsNot, 'm') then
txt = txt || m.s.tok
if ^ compComment(m) then
leave
end
pr = compPrimary(m)
if pr = '' & pos(type, 'sw') > 0 then
txt = strip(txt, 't')
if txt ^== '' then
res = res '||' quote(txt)
if pr = '' then do
if pos(type, 'sw') > 0 then
call compSpComment m
if res == '' then
return ''
return substr(res, 5)
end
res = res '||' pr
end
return ''
endProcedure compExpr
/*--- push an empty stem on the stack --------------------------------*/
compPushStem: procedure expose m.
parse arg m
m.m.stack = m.m.stack + 1
pp = m'.STACK'm.m.stack
m.pp.0 = 0
return pp
endProcedure compPushStem
/*--- push a stem from the stack -------------------------------------*/
compPop: procedure expose m.
parse arg m, pp
if pp ^== m'.STACK'm.m.stack then
call err 'compPop pp' pp 'mismatch to' m'.STACK'm.m.stack
m.m.stack = m.m.stack - 1
return m
endProcedure compPop
/*--- compile a primary and return code ------------------------------*/
compPrimary: procedure expose m.
parse arg m
s = m.m.scan
if ^ scanLit(s, '$') then
return ''
if scanString(s) then
return m.s.tok
if scanLit(s, '(') then do
one = compCheckNN(m, compLang(m, 0), 'rexx expexted after $(')
if ^ scanLit(s, '$)') then
call scanErr s, 'closing $) missing after $(...'
return '('one')'
end
if scanLit(s, '-¢') then do
res = compData(m, 1)
if ^scanLit(s, '$!') then
call scanErr s, 'closing $! missing after $-¢ data'
return res
end
if scanLit(s, '-{') then do
res = compShell(m)
if ^scanLit(s, '$}') then
call scanErr s, 'closing $} missing after $-{ shell'
return "mCat("compStmts2ExprBuf(res)"'.BUF', ' ')"
end
if scanLit(s, '-cmpShell', '-cmpData') then do
return 'compile(comp(envRead2Buf()),' ,
'"'substr('ds', 1+(m.s.tok == '-cmpShell'), 1)'")'
end
if scanLit(s, '{') then do
if scanLit(s, '?') then
f = 'envIsDefined'
else if scanLit(s, '>') then
f = 'envRead'
else
f = 'envGet'
nm = compExpr(m, 'w')
if ^scanLit(s, '}') then
call scanErr s, 'closing } missing after ${'
return f'('nm')'
end
if scanName(s) then
return 'envGet('quote(m.s.tok)')'
call scanBack s, '$'
return ''
endProcedure compPrimary
/*--- compile a pipe and return code ---------------------------------*/
compPipe: procedure expose m.
parse arg m
s = m.m.scan
ios = ''
stmts = ''
stmtLast = ''
do forever
io1 = compRedirIO(m, 1)
if io1 ^== '' then do
ios = ios',' io1
call compSpNlComment m
end
else do
if stmtLast ^== '' then do
if ^ scanLit(s, '$¨') then
leave
call compSpNlComment m
end
one = compStmts(m)
if one == '' then do
if stmtLast ^== '' then
call scanErr s, 'stmts expected afte $¨'
if ios == '' then
return ''
leave
end
if stmtLast ^== '' then
stmts = stmts 'call envBar;' stmtLast
stmtLast = one
end
end
if stmts ^== '' then
stmtLast = insert('Begin', stmts, pos('envBar;', stmts)+5) ,
'call envBarLast;' stmtLast 'call envBarEnd;'
if ios ^== '' then do
if stmtLast == '' then
stmtLast = 'call envReadWrite;'
stmtLast = 'call envPush env('substr(ios, 3)');' stmtLast ,
'call envPop;'
end
return stmtLast
endProcedure compPipe
/*--- compile an io redirection, return
if makeExpr then "option", expr
else code write inut to standard out -------------*/
compRedirIO: procedure expose m.
parse arg m, makeExpr
s = m.m.scan
if ^ scanLit(s, '$&', '$<<', '$<', '$>>', '$>') then
return ''
opt = substr(m.s.tok, 2)
call scanVerify s, '+-£#¢{'
opt = opt || m.s.tok
/* ???? call compSpComment m */
if left(opt, 2) ^== '<<' then do
if verify(opt, '¢{', 'm') > 0 ,
| (left(opt, 1) == '&' & pos('£', opt) > 0) then
call scanErr s, 'inconsistent io redirection option' opt
ex = compCheckNN(m, compExpr(m, 's'),
, 'expression expected after $'opt)
end
else do
if verify(opt, '-£#', 'm') > 0 then
call scanErr s, 'inconsistent io redirection option' opt
if ^ scanName(s) then
call scanErr s, 'stopper expected in heredata after $'opt
stopper = m.s.tok
call scanVerify s, m.m.chSpa
if ^ scanReadNl(s) then
call scanErr s,
, 'space nl expected in heredata after $'opt||stopper
buf = jOpen(jBuf(), 'w')
do while ^ scanLit(s, stopper)
call jWrite buf, m.s.src
if ^ scanReadNl(s, 1) then
call scanErr s, 'eof in heredata after $'opt||stopper
end
call jClose buf
if verify(opt, '¢{', 'm') > 0 then do
if pos('¢', opt) > 0 then
ex = compile(comp(buf), 'd')
else
ex = compile(comp(buf), 's')
if makeExpr then
return "'<£', envRun("quote(ex)")"
else
return "call oRun" quote(ex)";"
end
opt = '<£'
ex = quote(buf)
end
if makeExpr then
return "'"opt"'," ex
else if left(opt, 1) = '>' then
call scanErr s, 'cannot write ioRedir $'opt
else
return "call envReadWrite '"opt"'," ex
endProcedure compRedirIO
/*--- compile stmts (stmt or java) -----------------------------------*/
compStmts: procedure expose m.
parse arg m
res = ''
do forever
one = compStmt(m)
if one == '' then
one = compLang(m, 1)
if one == '' then
return res
res = res strip(one)
call compSpNlComment m
end
endProcedure compStmts
/*--- compile a single statement -------------------------------------*/
compStmt: procedure expose m.
parse arg m
s = m.m.scan
if scanLit(s, "$=") then do
nm = compCheckNN(m, compExpr(m, 'w'), "variable name")
if scanLit(s, "=") then
vl = compExpr(m, 's')
else if scanLit(s, "£") then
vl = compCheckNN(m, compLang(m, 0),
, 'java expression after $= .. £')
else
call scanErr s, '= or £ expected after $= name'
return 'call envPut' nm',' vl';'
end
else if scanLit(s, '$@{') then do
call compSpNlComment m
one = compShell(m)
if ^ scanLit(s, "$}") then
call scanErr s, "closing $} missing for $@{ shell"
return "do;" one "end;"
end
else if scanLit(s, '$@¢') then do
call compSpNlComment m
one = compData(m, 0)
if ^ scanLit(s, "$!") then
call scanErr s, "closing $! missing for $@! data"
return "do;" one "end;"
end
else if scanLit(s, '$$') then do
return 'call jOut' compExpr(m, 's')';'
end
else if scanLit(s, '$£') then do
return 'call jOut' compCheckNN(m, compLang(m, 0),
, 'language expression after $£')';'
end
else if scanLit(s, '$@for') then do
v = compCheckNN(m, compExpr(m, 'w') ,
, "variable name after $@for")
call compSpNlComment m
return 'do while envRead('v');',
compCheckNN(m, compStmt(m),
, "statement after $@for variable") 'end;'
end
else if scanLit(s, '$@run') then do
return 'call oRun' compCheckNN(m, compExpr(m, 's'),
, 'expression after $@run') ';'
end
return ''
endProcedure compStmt
/*--- compile a language clause
multi=0 a single line for a rexx expression
multi=1 mulitple lines for rexx statements
(with rexx line contiunation) -----------------------*/
compLang: procedure expose m.
parse arg m, multi
s = m.m.scan
res = ''
do forever
if scanVerify(s, m.m.chDol, 'm') then do
res = res || m.s.tok
end
else do
one = compPrimary(m)
if one ^== '' then
res = res || one
else if compComment(m) then
res = res || ' '
else if ^multi then
return res
else if ^ scanReadNl(s) then do
if res == '' then
return res
else
return strip(res)';'
end
else do
res = strip(res)
if right(res, 1) = ',' then
res = strip(left(res, length(res)-1))
else
res = res';'
end
end
end
endProcedure compLang
/*--- convert stmts to an expression yielding the output ------------*/
compStmts2ExprBuf: procedure expose m.
parse arg stmts
rr = oRunner(stmts)
return "envRun('"rr"')"
endProcedure compStmts2ExprBuf
/*--- convert '' to an empty expression ------------------------------*/
compNull2EE: procedure
parse arg e
if e = '' then
return '""'
return e
endProcedure compNull2EE
/*--- if va == '' then issue an error with msg -----------------------*/
compCheckNN: procedure expose m.
parse arg m, va, msg
if va == '' then
call scanErr m.m.scan, msg 'expected'
return va
endProcedure compCheckNN
/*--- skip a comment. return 0 if there is none ----------------------*/
compComment: procedure expose m.
parse arg m
s = m.m.scan
if scanLit(s, '$**') then
m.s.pos = 1 + length(m.s.src) /* before next nl */
else if scanLit(s, '$*+') then
call scanReadNl s, 1
else if scanLit(s, '$*(') then do
do forever
if scanVerify(s, m.m.chDol, 'm') then iterate
if scanReadNl(s) then iterate
if compComment(m) then iterate
if ^ scanLit(s, '$') then
call scanErr s, 'source end in comment'
if scanLit(s, '*)') then
return 1
if scanLit(s, '$') then iterate
if scanString(s) then iterate
end
end
else
return 0
return 1
endProcedure compComment
/*--- skip spaces and comments ---------------------------------------*/
compSpComment: procedure expose m.
parse arg m
found = 0
do forever
if scanVerify(m.m.scan, m.m.chSpa) then
found = 1
else if compComment(m) then
found = 1
else
return found
end
endProcedure compSpComment
/*--- skip spaces, NLs and comments ----------------------------------*/
compSpNlComment: procedure expose m.
parse arg m
found = 0
do forever
if compSpComment(m) then
found = 1
else if scanReadNl(m.m.scan) then
found = 1
else
return found
end
endProcedure compSpComment
/* copy comp end ******************************************************/
/* copy sqlO begin ***************************************************
sql interface mit o und j Anbindung
***********************************************************************/
sqlOini: procedure expose m.
if m.sqlO.ini == 1 then
return
m.sqlO.ini = 1
call sqlIni
call envIni
call oDecMethods oNewClass("SqlType", "JRW"),
, "jOpen call sqlOpen substr(m, 8); m.m.jReading = 1",
, "jClose call sqlClose substr(m, 8)",
, "jRead return sqlFetch(substr(m, 8), var)"
call oDecMethods oNewClass("SqlLn", "SqlType"),
, "jRead return sqlFetchLn(substr(m, 8), var)"
return
endProcedure sqlOini
/*--- fetch all rows into stem st
from sql src using type ty and format fmt -----------------*/
sql2St: procedure expose m.
parse arg st, src, ty, fmt
cx = 49
call sql2Cursor cx, src, ty, fmt
call sqlOpen cx
do ix=1 by 1 while sqlFetch(cx, st'.'ix)
end
m.st.0 = ix-1
call sqlClose cx
return ix-1
endProcedure sql2St
/*--- prepare statement 's'cx and declare cursor 'c'cx from sql src
use or generate type ty and format fo ---------------------*/
sql2Cursor: procedure expose m.
parse arg cx, src, ty, fo
call sqlPreDeclare cx, src, 1 /* with describe output */
call sqlGenType cx, ty
m.Sql.cx.FMT.0 = 0
m.Sql.cx.FMT = sqlGenFmt('SQL.'cx'.FMT', cx, fo)
call assert 'm.'m.sql.cx.fmt'.0 >= m.sql.cx.d.sqlD', 'too few fmt'
return
endProcedure sql2Cursor
/*--- return the type for sql cx -------------------------------------*/
sqlType: procedure expose m.
parse arg cx
return oGetTypePara('SQL.TY.'cx)
/*--- fetch cursor 'c'cx into destination dst
each column is formatted and assigned to m.dst.<colName> ---*/
sqlFetch: procedure expose m.
parse arg cx, dst
if ^ sqlFetchInto(cx, 'descriptor :M.SQL.'cx'.D') then
return 0
if dst == '' then
return 1
fi = oFlds(sqlType(cx))
fo = m.sql.cx.fmt
do ix=1 to m.sql.cx.d.SQLD
f = m.fi.ix
if m.sql.cx.d.ix.sqlInd = 0 then
m.dst.f = fmt(m.sql.cx.d.ix.sqlData, m.fo.ix)
else
m.dst.f = fmtS(m.sqlNull, m.fo.ix)
end
return 1
endProcedure sqlFetch
/*--- fetch cursor 'c'cx
put the formatted and concatenated columns into m.var
return 1 if a row fetched, 0 if not ------------------------*/
sqlFetchLn: procedure expose m.
parse arg cx, var
st = 'SQL.'cx'.FET'
if ^ sqlFetch(cx, st) then
return 0
m.var = oFldCat(sqlType(cx), st, m.sql.cx.fmt)
return 1
endProcedure sqlFetchLn
/*--- generate the type sql cx as specified in ty
use the information from the sqlDa -------------------------*/
sqlGenType: procedure expose m.
parse arg cx, ty
if ty == '*' | ty = '' then do
ff = ''
do ix=1 to m.sql.cx.d.sqlD
f1 = word(m.sql.cx.d.ix.sqlName, 1)
if f1 == '' then
f1 = 'COL'ix
ff = ff f1
end
ty = oFldOnly(ff, 'e')
end
call oSetTypePara 'SQL.TY.'cx, ty, 'noCall'
return ty
endProcedure sqlGenType
/*--- generate the format ff for a sql cx as specified in sp
use the information from the sqlDa -------------------------*/
sqlGenFmt: procedure expose m.
parse arg ff, cx, sp
if abbrev(sp, '=') then
return substr(sp, 2)
if sp = '' then
sp = '*st'
m.ff.0 = m.sql.cx.d.sqlD
m.ff.flds = oFlds(sqlType(cx))
if abbrev(sp, '*') then do
do ix=1 to m.ff.0
m.ff.ix = substr(sp, 2)
end
return ff
end
if abbrev(fmts, '=') then
m.Sql.cx.FMT = substr(fmts, 2)
defs = 'ir7 fr9 sl12 Tl26' sp
do wx = 1 to words(defs)
parse value word(defs, wx) with ty 2 fo
select
when ty = 'd' then t.384 = fo
when ty = 'f' then t.480 = fo'/f'
when ty = 'i' then t.496 = fo'/i'
when ty = 'n' then t.484 = fo'/n'
when ty = 's' then t.448 = fo
when ty = 't' then t.388 = fo
when ty = 'T' then t.392 = fo
otherwise call err 'bad type' ty 'for format' fo
end
end
if symbol('t.496') == 'VAR' then
t.500 = t.496
if symbol('t.448') == 'VAR' then do
t.452 = t.448
t.456 = t.448
t.464 = t.448
end
do wx = 1 to m.ff.0
ty = m.sql.cx.d.wx.sqlType
le = m.sql.cx.d.wx.sqlLen
withNulls = ty // 2
ty = ty - withNulls
if symbol('t.ty') <> 'VAR' then
call err 'sqlType' ty 'not supported'
parse var t.ty fo 2 fl '/' op
if op = 'i' then
if le = 2 then le = 6
else le = 12
else if op <> '' then
call err 'length for sqlType' ty 'op' op 'not implemented'
if fl = '=' then
fl = le
else if abbrev(fl, '<') then
fl = min(le, substr(fl, 2))
m.ff.wx = fo || fl
end
return ff
endProcedure sqlGenFmt
/*--- sql o interface ------------------------------------------------*/
/*--- return a reader for the givenn sql or std input ----------------*/
sql2Obj: procedure expose m.
parse arg cx, src, ty, fo
if ty = '' then
ty = '*'
if src == '' then
src = envCatStr(' ', 'sb')
call sql2Cursor cx, src, ty, substr(fo, 1+abbrev(fo, '~'))
call oMutate 'SQL.TY.'cx, 'SqlType'
return 'SQL.TY.'cx
endProcedure sql2obj
/*--- write to std output the result columns of
the sql given in src or std input --------------------------*/
sql: procedure expose m.
parse arg cx, src, ty, fo
call jWriteAll m.j.jOut, "r£", sql2Obj(cx, src, ty, fo)
return
endProcedure sql
/*--- write to std output the result lines of
the sql given in src or std input --------------------------*/
sqlLn: procedure expose m.
parse arg cx, src, ty, fo
if fo = '' then
fo = '~'
squash = abbrev(fo, '~')
if ^ abbrev(fo, '=') then
fo = left(fo, squash) 'sl=' substr(fo, squash+1)
t = sql2Obj(cx, src, ty, fo)
if squash then do
call fmtFldSquashRw t, 'opCl'
return
end
m = 'SQL.LN.'cx
call oMutate m, 'SqlLn'
call jWrite m.j.jOut, fmtFldTitle(m.sql.cx.fmt)
call jWriteAll m.j.jOut, "r£", m
return
endProcedure sqlLn
/* copy sqlO end **************************************************/
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm:
parse arg ggSrc, ggRet
return sqlExec('execute immediate :ggSrc', ggRet)
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure expose m.
parse arg ggSys, ggRetCon
call sqlIni
address tso "SUBCOM DSNREXX"
if rc <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
if ggSys = '-' then
return 0
return sqlExec("connect" ggSys, ggRetCon ,1)
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure expose m.
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
call address tso 'DSN SYSTEM('sys')'
rr = rc
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql end **************************************************/
/* copy fmt begin **************************************************/
/*--- format the first arg by the format in the second ---------------*/
fmt: procedure
parse arg v, f 2 l
if abbrev('-', f) then
return v
else if f = 'l' then
return left(v, l)
else if f = 'r' then
return right(v, l)
else if f = 's' then
if l = '' then
return strip(v, 't')
else
return strip(v, l)
else if f = 'w' then do
parse var l st ',' le
return substr(v, st, le)
end
else
call err 'bad format' f l 'for' v
endProcedure fmt
/*--- format special (title, null Value also for numbers) ------------*/
fmtS: procedure expose m.
parse arg v, f
return fmt(v, f)
endProcedure fmtS $
/* copy fmt end **************************************************/
/* copy fmtF begin **************************************************/
fmtFldTitle: procedure expose m.
parse arg form
res = ''
fs = m.form.FLDS
do ix=1 to m.fs.0
res = res fmtS(m.fs.ix, m.form.ix)
end
return substr(res, 2)
endProcedure fmtFldTitle
fmtFld: procedure expose m.
parse arg form, st
res = ''
fs = m.form.FLDS
do ix=1 to m.fs.0
f = m.fs.ix
res = res fmt(m.st.f, m.form.ix)
end
return substr(res, 2)
endProcedure fmtData
fmtFldSquash: procedure expose m.
parse arg newFo, type, src
fs = oFlds(type)
do fx = 1 to m.fs.0
fd = m.fs.fx
lMi = 9e9
lMa = 0
rMi = 9e9
rMa = 0
len = 0
do sx = 1 to m.src.0
x = verify(m.src.sx.fd, ' ', 'n')
if x < 1 then
iterate
lMi = min(lMi, x)
lMa = max(lMa, x)
x = length(strip(m.src.sx.fd, 't'))
rMi = min(rMi, x)
rMa = max(rMa, x)
end
if rMa = 0 then
m.newFo.fx = 'w1,1'len
else
m.newFo.fx = 'w'lMi',' || (rMa+1-lMi)
end
m.newFo.0 = m.fs.0
m.newFo.flds = fs
return newFo
endProcedure fmtFldSquash
fmtFldRW: procedure expose m.
parse arg fo
ty = oGetTypePara(m.j.jIn)
call assert 'oFlds(ty) == m.fo.flds', 'fo different flds than type'
call jOut fmtFldTitle(fo)
do while jIn(ii)
call jOut fmtFld(fo, ii)
end
return
endProcedure fmtTypeRW
fmtFldSquashRW: procedure expose m.
parse arg in, opCl
if in = '' then
in = m.j.jIn
if opCl == 'opCl' then
call jOpen in, 'r'
ty = oGetTypePara(in)
flds = oFlds(ty)
st = 'FMT.TYPEAD'
do ix=1 while jRead(in, st'.'ix)
end
m.st.0 = ix - 1
fo = fmtFldSquash(sqFo, ty, st)
call jOut fmtFldTitle(fo)
do ix = 1 to m.st.0
call jOut fmtFld(fo, st'.'ix)
end
if opCl == 'opCl' then
call jClose in
return
endProcedure fmtFldSquashRW
/* copy fmtF end * **************************************************/
/* copy env begin ******************************************************
***********************************************************************/
env: procedure expose m.
nn = oNew("Env")
m.nn.toClose = ''
call envReset nn
do ax=1 by 2 to arg()-1
call envAddIo nn, arg(ax), arg(ax+1)
end
return nn
endProcedure env
envReset: procedure expose m.
parse arg m
call envClose m
m.m.in = ''
m.m.out = ''
m.m.lastCat = ''
do ax=2 by 2 to arg()-1
call envAddIo m, arg(ax), arg(ax+1)
end
return m
endProcedure envReset
envClose: procedure expose m.
parse arg m
do wx=1 to words(m.m.toClose)
call jClose word(m.m.toClose, wx)
end
m.m.toClose = ''
return m
endProcedure envClose
envAddIO: procedure expose m.
parse arg m, opt, spec
contX = pos("+", opt)
if contX > 0 then do
opt = left(opt, contX-1)substr(opt,contX+1)
contX = 1
if m.m.lastCat == '' then
m.m.lastCat = cat()
end
if m.m.lastCat ^== '' then
call catWriteAll m.m.lastCat, opt, spec
else
oc = catMake(opt, spec)
if contX then
return
if m.m.lastCat ^== '' then do
oc = m.m.lastCat
m.m.lastCat = ''
opt = left(m.oc.opts.1, 1)
end
o1 = left(opt, 1)
if pos(o1, 'r<') > 0 then do
if m.m.in ^== '' then
call err 'envAddIo('opt',' spec') duplicate stdIn'
m.m.in = oc
end
else if pos(o1, 'wa>') > 0 then do
if m.m.out ^== '' then
call err 'envAddIo('opt',' spec') duplicate stdOut'
m.m.out = oc
end
if pos('-', opt) < 1 then do
call jOpen oc, catOpt(opt)
m.m.toClose = m.m.toClose oc
end
return m
endProcedure envAddIO
envLink: procedure expose m.
parse arg m, old
if m.m.lastCat ^== '' then
call err 'envLink with open cat'
if m.m.in == '' then
m.m.in = m.j.jIn
if m.m.out == '' then
m.m.out = m.j.jOut
return m
endProcedure envLink
envReadWrite: procedure expose m.
parse arg opt, rdr
if opt = '' then
call jWriteAll m.j.jOut, '-£', m.j.jIn
else
call jWriteAll m.j.jOut, opt, catMake(opt, rdr)
return
endProcedure envReadWrite
envRead2Buf: procedure expose m.
b = jBuf()
call envPush env('>£', b)
call envReadWrite
x = envPop()
return b
endProcedure envRead2Buf
envPreSuf: procedure expose m.
parse arg le, ri
do while jIn(v)
call jOut le || m.v || ri
end
return
endProcedure envPreSuf
envCatStr: procedure expose m.
parse arg mi, fo
res = ''
do while jIn(v)
res = res || mi || fmt(m.v)
end
return substr(res, length(mi))
endProcedure envCatStr
envIsDefined: procedure expose m.
parse arg na
return symbol('m.env.vars.na') == 'VAR'
endProcedure envIsDefined
envGet: procedure expose m.
parse arg na
return mapGet(env.vars, na)
envRead: procedure expose m.
parse arg na
return jIn('ENV.VARS.'na)
envHasKey: procedure expose m.
parse arg na
return mapHasKey(env.vars, na)
envVia: procedure expose m.
parse arg na
return mapVia(env.vars, na)
envPut: procedure expose m.
parse arg na, va
return mapPut(env.vars, na, va)
envRemove: procedure expose m.
parse arg na
return mapRemove(env.vars, na)
envIni: procedure expose m.
if m.env.ini == 1 then
return
m.env.ini = 1
call catIni
call oDecMethods oNewClass("Env", "JRW"),
, "jOpen call err 'envOpen('m', 'arg')'",
, "jReset return envReset(m, arg, arg(3), arg(4), arg(5))",
, "jClose call envClose m"
m.env.0 = 1
call mapReset env.vars
ex = env()
m.env.1 = ex
m.ex.in = m.j.jIn
m.ex.out = m.j.jOut
return
endProcedure envIni
envPush: procedure expose m.
parse arg e
ex = m.env.0
call envLink e, m.env.ex
ex = ex + 1
m.env.0 = ex
m.env.ex = e
m.j.jIn = m.e.in
m.j.jOut = m.e.out
return e
endProcedure envPush
envPop: procedure expose m.
ox = m.env.0
if ox <= 1 then
call err 'envPop on empty stack' ox
lazy = 0
if wordPos(oGetClass(m.j.jOut), 'Cat CatWrite CatRead') > 0 then do
e = m.env.ox
lazy = catLazyClose(m.j.jOut, m.e.toClose)
end
if lazy then
m.e.toClose = 'lazyDoNotClosePlease||||'
else
call envClose m.env.ox
ex = ox - 1
m.env.0 = ex
e = m.env.ex
m.j.jIn = m.e.in
m.j.jOut = m.e.out
return m.env.ox
endProcedure envPop
envBarBegin: procedure expose m.
call envPush env('>£', Cat())
return
endProcedure envBarBegin
envBar: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.oldEnv.out, '>£', Cat())
return
endProcedure envBar
envBarLast: procedure expose m.
oldEnv = envPop()
call envPush env('<£', m.oldEnv.out)
return
endProcedure envBarLast
envBarEnd: procedure expose m.
oldEnv = envPop()
return
endProcedure envBarEnd
/*--- return the output buffer of oRunner m --------------------------*/
envRun: procedure expose m.
parse arg m
b = jBuf()
call envPush env('>£', b)
call oRun m
x = envPop()
return b
endProcedure envRun
/* copy env end *******************************************************/
/* copy cat begin ****************************************************
***********************************************************************/
catOpt: procedure
parse arg opt, keep
if abbrev(opt, '<') then
o = 'r'substr(opt, 2)
else if abbrev(opt, '>>') then
o = 'a'substr(opt, 3)
else if abbrev(opt, '>') then
o = 'w'substr(opt, 2)
else if pos(left(opt, 1), 'rwa') > 0 then
o = opt
else
o = '?'opt
if keep ^== 1 then
o = translate(o, ' ', '£#')
return space(o, 0)
endProcedure catOpt
/*--- create and possibly open a reader or writer --------------------*/
catMake: procedure expose m.
parse arg opt, spec
o = catOpt(opt, 1)
if pos('£', o) > 0 then
return spec
else if pos('#', o) > 0 then do
if envhasKey(spec) then
return catMake(translate(opt, '£', '#'), envGet(spec))
else
return envPut(spec, jBuf())
end
else if pos('&', o) > 0 then
return catDsn('&'spec)
else
return catDsn(spec)
call err 'catMake implement' opt
if defDsn == '' then do
o = left(o, length(o)-1)
end
else if defDsn == '' then do
rw = catDsn(spec)
end
else do
rw = jReset(defDsn, spec)
end
if pos('-', o) < 1 then
call jOpen rw, o
return rw
endProcedure catMake
/*--- create a new cat -----------------------------------------------*/
cat: procedure expose m.
m = oNew('Cat')
m.m.catIx = -9
call catReset m
do ax=1 by 2 to arg()
call catWriteAll m, arg(ax), arg(ax+1)
end
return m
endProcedure cat
catReset: procedure expose m.
parse arg m
m.m.RWs.0 = 0
m.m.catWr = ''
m.m.catRd = ''
m.m.catToClose = ''
m.m.catIx = -9
call oSetTypePara m
do ax=2 by 2 to arg()
call catWriteAll m, arg(ax), arg(ax+1)
end
return m
endProcedure catReset
catClose: procedure expose m.
parse arg m
if m.m.catIx == -9 then
return
if m.m.catWr ^== '' then do
call jClose m.m.catWr
bx = mInc(m'.RWS.0')
m.m.opts.bx = ""
m.m.RWs.bx = m.m.catWr
m.m.catWr = ''
end
if m.m.catIx >= 0 then do
if m.m.catRd ^== '' then do
ix = m.m.catIx
if pos('-', m.m.opts.ix) < 1 then
call jClose m.m.catRd
m.m.catRd = ''
end
do wx = 1 to words(m.m.catToClose)
cl = word(m.m.catToClose, wx)
if cl ^== m then
call jClose cl
end
m.m.catToClose = ''
end
m.m.catIx = -9
return m
endProcedure catClose
catOpen: procedure expose m.
parse arg m, oo
call jClose m
if oo = 'r' then do
m.m.catIx = 0
m.m.catRd = catNextRdr(m)
m.m.jReading = 1
end
else if oo == 'w' | oo == 'a' then do
if oo == 'w' then
m.m.RWs.0 = 0
m.m.catIx = -7
m.m.jWriting = 1
end
else do
call err 'catOpen('m',' oo') bad opt'
end
return m
endProcedure catOpen
/*--- return and open next reader ------------------------------------*/
catNextRdr: procedure expose m.
parse arg m
cx = m.m.catIx
if cx > 0 & cx <= m.m.RWs.0 & pos('-', m.m.opts.cx) < 1 then
call jClose m.m.catRd
cx = cx + 1
m.m.catIx = cx
if cx > m.m.RWs.0 then
return ''
oo = overlay('r', m.m.opts.cx)
if pos('-', oo) < 1 then
call jOpen m.m.RWs.cx, oo
return m.m.RWs.cx
endProcedure catNextRdr
catRead: procedure expose m.
parse arg m, var
do while m.m.catRd ^== ''
if jRead(m.m.catRd, var) then
return 1
m.m.catRd = catNextRdr(m)
end
return 0
endProcedure catRead
catWrite: procedure expose m.
parse arg m, line
if m.m.catWr == '' then do
m.m.catWr = jOpen(jBuf(), 'w')
call oSetTypePara m.m.catWr, oGetTypePara(m)
end
call jWrite m.m.catWr, line
return
endProcedure catWrite
/*--- write contents of a reader to cat
or keep it for later reading -------------------------------*/
catWriteAll: procedure expose m.
parse arg m
if m.m.catIx >= 0 then
call err 'catWriteAll('m',' arg(2)',' arg(3)') but opened,',
'catIx='m.m.catIx
bx = m.m.RWs.0
if m.m.catWr ^== '' then do
call jClose m.m.catWr
bx=bx+1
m.m.opts.bx = ""
m.m.RWs.bx = m.m.catWr
m.m.catWr = ''
end
do ax=2 by 2 to arg()
bx=bx+1
m.m.opts.bx = catOpt(arg(ax))
m.m.RWs.bx = catMake(arg(ax), arg(ax+1))
call oSetTypePara m, oGetTypePara(m.m.RWs.bx)
end
m.m.RWs.0 = bx
return
endProcedure catWriteAll
/*--- store the list toClose to close them when closing cat ----------*/
catLazyClose: procedure expose m.
parse arg m, toClose
if m.m.catIx <> -7 then
call err 'catLazyClose with catIx' m.m.catIx
if m.m.RWs.0 = 0 then
return 0
if m.m.catToClose ^== '' then
call err 'catLazyClose with catToClose' m.m.catToClose
if m.m.catIx <> -7 | m.m.catToClose ^== '' then
m.m.catToClose = toClose
return 1
endProcedure catLazyClose
catSetTypePara: procedure expose m.
parse arg m, type
do ix=1 to m.m.RWs.0
call oSetTypePara m.m.RWs.ix, type
end
return
endProcedure catSetTypePara
/*--- create a reader/writer for a dsn -------------------------------*/
catDsn: procedure expose m.
parse arg spec
m = oNew('CatDsn')
m.m.readIx = 'c'
ix = mInc('CAT.BUF')
m.m.defDD = 'CAT'ix
m.m.buf = 'CAT.BUF'ix
call catDsnReset m, spec
return m
endProcedure catDsn
catDsnReset: procedure expose m.
parse arg m, sp
if symbol('m.m.defDD') ^== 'VAR' then
m.m.defDD = 'CDD' mInc('CAT.DEFDD')
m.m.spec = sp
return m
endProcedure catDsnReset
catDsnOpen: procedure expose m.
parse arg m, opt
call jClose m
buf = m.m.buf
if opt == 'r' then do
aa = dsnAlloc(m.m.spec, 'SHR', m.m.defDD)
if m.dsnAlloc.dsn <> '' then
if sysDsn("'"m.dsnAlloc.dsn"'") <> 'OK' then
call err 'cannot read' m.dsnAlloc.dsn':',
sysDsn("'"m.dsnAlloc.dsn"'")
call readDDBegin word(aa, 1)
m.m.jReading = 1
m.buf.0 = -1
m.m.readIx = 0
end
else do
if opt == 'w' then
aa = dsnAlloc(m.m.spec, 'OLD', m.m.defDD)
else if opt == 'a' then
aa = dsnAlloc(m.m.spec, 'MOD', m.m.defDD)
else
call err 'catDsnOpen('m',' opt') with bad opt'
call writeDDbegin word(aa, 1)
m.m.jWriting = 1
m.buf.0 = 0
m.m.readIx = 'w'
end
m.m.dd = word(aa, 1)
m.m.free = subword(aa, 2)
return m
endProcedure catDsnOpen
catDsnClose:
parse arg m
buf = m.m.buf
if m.m.readIx ^== 'c' then do
if m.m.readIx == 'w' then do
if m.buf.0 > 0 then
call writeDD m.m.dd, 'M.'BUF'.'
call writeDDend m.m.dd
end
else do
call readDDend m.m.dd
end
interpret m.m.free
end
m.buf.0 = 'closed'
m.m.readIx = 'c'
m.m.free = ''
m.m.dd = ''
return m
endProcedure catDsnClose
catDsnRead: procedure expose m.
parse arg m, var
ix = m.m.readIx + 1
buf = m.m.buf
if ix > m.buf.0 then do
res = readDD(m.m.dd, 'M.'buf'.')
if ^ res then
return 0
ix = 1
end
m.m.readIx = ix
m.var = m.buf.ix
return 1
endProcedure catDsnRead
catDsnWrite: procedure expose m.
parse arg m, var
buf = m.m.buf
ix = m.buf.0 + 1
m.buf.0 = ix
m.buf.ix = var
if ix > 99 then do
call writeDD m.m.dd, 'M.'buf'.'
m.buf.0 = 0
end
return
endProcedure catDsnWrite
catIni: procedure expose m.
if m.cat.ini == 1 then
return
m.cat.ini = 1
m.cat.buf = 0
call jIni
call oDecMethods oNewClass("Cat", "JRW"),
, "jOpen return catOpen(m, arg)",
, "jReset return catReset(m, '', arg)",
, "jClose call catClose m",
, "jWriteAll call err 'jWriteAll not opened w",
, "oSetTypePara call catSetTypePara m, type",
, "jRead return catRead(m, var)",
, "jWrite call catWrite m, line; return",
, "jWriteAll call catWriteAll m, opt, rdr; return"
call oDecMethods oNewClass("CatDsn", "JRW"),
, "jOpen return catDsnOpen(m, arg)",
, "jReset return catDsnReset(m, arg)",
, "jClose call catDsnClose m",
, "jRead return catDsnRead(m, var)",
, "jWrite call catDsnWrite m, line"
return
endProcedure catIni
/* copy cat end ****************************************************/
/* 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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 expose m.
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 csi begin ***************************************************
csi interface: see dfs managing catalogs appendix c
returncode/reason see message IDC3009I
**********************************************************************/
/*--- specify dsn mask and fields to start a csi catalog search --------
arguments:
m objectPointer
dsnMask specifies the dsns with wildcards:
% 1 character
* 0 - n character in one level
** 0 - n levels
fields a (space separated) list of field names -------------*/
csiOpen: procedure expose m.
parse arg m, dsnMask, fields
m.m.fld.0 = words(fields)
ffix = d2c(m.m.fld.0, 2)
do x=1 to m.m.fld.0
m.m.fld.x = translate(word(fields, x))
ffix = ffix || left(m.m.fld.x, 8)
end
m.m.filt = left(dsnMask, 149) ,
|| left('Y', 3) , /* resume offset 149 */
|| ffix /* csiNumEn offset 152 */
WORKLEN = 1024 * 64
m.m.work = D2C(WORKLEN,4) || COPIES('00'X,WORKLEN-4)
m.m.pos = workLen + 1
return
endProcedure csiOpen
/*--- put the next dsn into m.o.dsn and m.o.* (for other fields)
return 1 if next dsn exists 0 otherwise ------------------------*/
csiNext: procedure expose m.
parse arg m, o
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET AMOUNT OF WORK AREA USED */
px = m.m.pos
do forever
if px > usedL then do
if substr(m.m.filt, 150, 1) ^== 'Y' then do
m.m.pos = px
m.o.dsn = ''
return 0
end
reason = left('', 4)
ADDRESS LINKPGM 'IGGCSI00 reason m.'m'.filt m.'m'.work'
if rc == 0 & substr(reason, 3, 2) == '0000'x then
nop
else if rc == 4 & substr(reason, 3, 2) == '0464'x then
say 'data set entry with error'
else
call err 'call csi returns' rc,
'rc' c2d(substr(reason, 4,1)),
'reason' c2d(substr(reason, 3,1)),
'module' substr(reason, 1,2)
usedL = C2D(SUBSTR(m.m.work,9,4)) /* GET WORK AREA USED */
numFD = C2D(SUBSTR(m.m.work,13,2)) /* no flds + 1 */
if numFd <> m.m.fld.0 + 1 then
call err 'csiNumFd' numFd 'not' m.m.fld.0 '+' 1
px = 15
iterate
end
eType = substr(m.m.work, px+1, 1)
m.o.dsn = substr(m.m.work, px+2, 44)
flag = substr(m.m.work, px, 1)
/* say 'eType' eType m.o.dsn 'flag' c2x(flag) */
if eType == '0' then do
if flag ^== '00'x & flag ^== '40'x then
call err 'flag' c2x(flag) 'for catalog' m.o.dsn
px = px + 50 /* length of catalog entry */
iterate
end
else do
if ^ abbrev(x2b(c2x(flag)), '101') then
call err 'call csi entry flag' x2b(c2x(flag)),
'rc' c2d(substr(m.m.work, px+49,1)),
'reason' c2d(substr(m.m.work, px+48,1)),
'module' substr(m.m.work, px+46, 2),
'for entry' m.o.dsn,
'see qw IDC3009I'
py = px + 46
tl = c2d(substr(m.m.work, py, 2))
pl = py + 4
pf = py + m.m.fld.0 * 2 + 4
do fx = 1 to m.m.fld.0
fi = m.m.fld.fx
fl = c2d(substr(m.m.work, pl, 2))
m.o.fi = substr(m.m.work, pf, fl)
if fi = 'MGMTCLAS' then
m.o.fi = substr(m.o.fi, 3, c2d(left(m.o.fi ,2)))
else if wordPos(fi, 'COMUDSIZ NOBYTTRK') > 0 then
m.o.fi = c2d(m.o.fi)
pf = pf + fl
pl = pl + 2
end
if py + tl <> pf then
call err 'length mismatch for entry' m.o.dsn
m.m.pos = pf
return 1
end
end
endProcedure csiNext
/*--- if dsn is arcived return 'arcive'
if dsn is tape return 'tape'
otherwise return managment class ------------------------------*/
csiArcTape: procedure expose m.
parse arg vo, cl, dt, dsn
if vo = '' then
say err '||| no volume for dsn' dsn
else if vo = 'ARCIVE' then
res = 'arcive'
else if cl <> '' then
res = cl
else if abbrev(vo, 'SHR') then
res = 'SHR'
else
res = 'tape'
if res = 'arcive' then
return res
/*if abbrev(res, 'ar') ^= abbrev(dt, '00'x) , */
if abbrev(res, 'ta') ^= abbrev(c2x(left(dt, 1)), '7') ,
| (left(res, 1) >= 'A') ^= abbrev(dt, '30'x) then
say '||| mismatch cl' cl 'vo' vo 'dt' c2x(dt) 'dsn' dsn
return res
endProcedure csiArcTape
/* copy csi end ******************************************************/
/* copy csm begin ******************************************************
interface to csm,
it is integrate with adrTso, eg. dsnAlloc , 'RZ3/..' uses csm
***********************************************************************/
adrCsm:
return adrTso('csmExec' arg(1), arg(2))
endProcedure adrCsm
csmCopy: procedure expose m.
parse arg csnFr, csnTo, ggRet
if dsnGetMbr(csnTo) ^= '' ,
& dsnGetMbr(csnFr) <> dsnGetMbr(csnTo) then
call err 'member rename' csnFr 'to' csnTo
parse value csmSysDsn(csnFr) with sysFr '/' dsnFr
parse value csmSysDsn(csnTo) with sysTo '/' dsnTo
if sysFr = '*' & sysTo <> '*' then do
pdsTo = dsnSetMbr(dsnTo)
al = "SYSTEM("sysTo") DDNAME(COPYTo)",
"DATASET('"pdsTo"') DISP(SHR)"
alRes = dsnAlloc(systo'/'pdsTo, ,'COPYTO', '*')
if datatype(alRes, 'n') then do
/* wir müssen es selbst allozieren csmxUtil
vergisst management class ||||| */
say 'could not allocate' al
say 'trying to create'
rc = listDsi("'"dsnSetMbr(dsnFr)"' SMSINFO")
if rc ^= 0 then
call err 'listDsi rc' rc 'reason' sysReason,
sysMsgLvl1 sysMsgLvl2
al = left(al, length(al)-4)'CAT)'
if right(sysDsSms, 7) == 'LIBRARY' ,
| abbrev(sysDsSms, 'PDS') then
al = al 'DSNTYPE(LIBRARY)'
al = al "DSORG("sysDSorg") MGMTCLAS("sysMgmtClass")",
"RECFM("sysREcFM") LRECL("SYSLRECL")",
"blksize("sysBLkSIZE")",
"SPACE("sysPrimary"," sysSeconds")" sysUnits
call adrCsm "allocate" al
end
call adrTso 'free dd(copyTo)'
end
c = "'COPY" sysFr"/''"dsnFr"'' TO" ,
sysTo"/''"dsnSetMbr(dsnTo)"'' REPLACE'"
return adrTso("exec 'CSM.DIV.P0.EXEC(CSRXUTIL)'" c , ggRet)
return
endProcedure csmCopy
csmAlloc: procedure expose m.
parse upper arg dd, disp, dsn, rest, nn, retRc
sys = ''
al = ''
parse value csmSysDsn(dsn) with sys '/' dsn
if disp = '' then
disp = 'shr'
al = "SYSTEM("sys") DDNAME("dd")"
if abbrev(disp, 'SYSOUT(') then
al = al disp
else
al = al "DISP("disp")"
if dsn <> '' then do
al = al "DATASET('"dsnSetMbr(dsn)"')"
mbr = dsnGetMbr(dsn)
if mbr <> '' then
al = al 'MEMBER('mbr')'
end
if retRc <> '' | nn = '' then do
alRc = adrCsm('allocate' al rest, retRc)
if alRc <> 0 then
return alRc
return dd 'call adrTso "free dd('dd')";'
end
do retry=0 to 1
alRc = adrCsm(al rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if nn = '' | wordPos(disp, 'OLD SHR') < 1 then,
leave
say 'csmAlloc rc' alRc 'for' al rest '...trying to create'
call adrCsm 'allocate' left(al, length(al)-4)'CAT)' ,
dsnCreateAtts(dsn, nn)
call adrTso 'free dd('dd')'
end
call err 'cmsAlloc rc' alRc 'for' al rest
endProcedure csmAlloc
csmSysDsn: procedure expose m.
parse upper arg dsn, withStar
if pos('/', dsn) < 1 then
sys = '*'
else
parse var dsn sys '/' dsn
if sys <> '' & sys <> '*' & sys <> sysvar(sysnode) then
return sys'/'dsn
else if withStar == 0 then
return dsn
else
return '*/'dsn
endProcedure csmSysDsn
/* copy csm 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 expose m.
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 expose m.
parse arg dsn .
return "'"dsn"'"
endProcedure jcl2dsn
dsnSetMbr: procedure expose m.
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 expose m.
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 expose m.
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 expose m.
parse arg ggDD
call adrTso 'execio 0 diskr' ggDD '(finis)'
return /* end readDDEnd */
/*--- prepare writing to DD ggDD -------------------------------------*/
writeDDBegin: procedure expose m.
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 expose m.
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 by 1
alRc = adrTso(c rest, '*')
if alRc = 0 then
return dd 'call adrTso "free dd('dd')";'
if retry > 0 | nn = '' | wordPos(disp, 'OLD SHR') < 1 ,
| sysDsn("'"m.dsnAlloc.dsn"'") ^== 'DATASET NOT FOUND' then
call err 'tsoAlloc rc' alRc 'for' c rest
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
endProcedure tsoAlloc
dsnCreateAtts: procedure expose m.
parse arg dsn, atts, forCsm
bl = 32760
if abbrev(atts, ':') then do
rl = substr(atts, 3)
if abbrev(atts, ':F') then do
if rl = '' then
rl = 80
recfm='f b'
bl = bl - (bl // rl)
end
else do
if rl = '' then
rl = bl-4
recfm = substr(atts, 2, 1) 'B'
end
end
if pos('(', dsn) > 0 then
po = 'dsntype(library) dsorg(po)'
else
po = ''
dsn = dsnSetMbr(dsn)
if forCsm == 1 then
return "dataset('"dsn"')" po,
"recfm("space(recfm, 0)") lrecl("rl") blkSize("bl")" ,
"mgmtclas(s005y000) space(10, 1000) cylinder"
else
return "dsn('"dsn"')" po,
"recfm("recfm") lrecl("rl") block("bl")" ,
"mgmtclas(s005y000) 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
copyDSN: procedure expose m.
parse arg frSpec, toSpec, ggSay
frDD = dsnAlloc(frSpec, 'SHR', 'FRDD')
toDD = dsnAlloc(toSpec, 'OLD', 'TODD')
call readDDBegin word(frDD, 1)
call writeDDBegin word(toDD, 1)
cnt = 0
do while readDD(word(frDD, 1), r.)
call writeDD word(toDD, 1), r.
cnt = cnt + r.0
end
call readDDEnd word(frDD, 1)
call writeDDEnd word(toDD, 1)
interpret ';' subword(frDD, 2) '; ; ;' subword(toDD, 2)
if ggSay == 1 | m.debug == 1 then
say cnt 'records copied from' frSpec 'to' to toSpec
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy j begin *******************************************************
the j framework
jReset
jOpen
jClose
jRead
jWrite
***********************************************************************/
jRead: procedure expose m.
parse arg m, var
if m.m.jReading then
interpret oObjMethod(m, 'jRead')
else
call err 'jRead('m',' var') but not opened r'
endProcedure jRead
jWrite: procedure expose m.
parse arg m, line
if m.m.jWriting then
interpret oObjMethod(m, 'jWrite')
else
call err 'jWrite('m',' line') but not opened w'
return
endProcedure jWrite
jWriteAll: procedure expose m.
parse arg m, opt, rdr
interpret oObjMethod(m, 'jWriteAll')
return
endProcedure jWriteAll
jWriteAllImpl: procedure expose m.
parse arg m, opt, rdr
if pos('-', opt) < 1 then
call jOpen rdr, catOpt(opt)
do while jRead(rdr, line)
call jWrite m, m.line
end
if pos('-', opt) < 1 then
call jClose rdr
return
endProcedure jWriteAll
jReset: procedure expose m.
parse arg m, arg
call jClose m
interpret oObjMethod(m, 'jReset')
return m
endProcedure jOpen
jOpen: procedure expose m.
parse arg m, arg
interpret oObjMethod(m, 'jOpen')
return m
endProcedure jOpen
jClose: procedure expose m.
parse arg m
if m.m.jReading = 1 | m.m.jWriting = 1 then
interpret oObjMethod(m, 'jClose')
m.m.jReading = 0
m.m.jWriting = 0
return m
endProcedure jClose
/*--- analyze an option in oOpt and oVal -----------------------------*/
jOpt: procedure expose m.
parse arg src, alone, val
m.j.oOpt = ''
if left(src, 1) ^== '-' then do
m.j.oVal = src
return 0
end
sx = 2
if alone ^== '' then do
sx = verify(src, alone, 'n', sx)
if sx = 0 then
sx = length(src)+1
end
if length(src) < sx then
m.j.oVal = ''
else if val == '' then
call err 'bad opt "'src'" should contain only "'alone'"'
else if pos(substr(src, sx, 1), val) < 1 then
call err 'bad opt "'src'" should contain only "'alone'"' ,
'and/or 1 of "'val'" with value'
else do
sx = sx + 1
m.j.oVal = substr(src, sx)
end
m.j.oOpt = substr(src, 2, sx-2)
return 1
endProcedure jOpt
jIni: procedure expose m.
if m.j.ini == 1 then
return
m.j.ini = 1
call oIni
call oDecMethods oNewClass("JRW"),
, "jRead call err 'jRead('m',' var') but not opened r'",
, "jWrite call err 'jWrite('m',' line') but not opened w'",
, "jWriteAll call jWriteAllImpl m, opt, rdr",
, "jRead drop m.arg; return 0",
, "jWrite say 'jOut:' line",
, "jReset ;",
, "jOpen ;",
, "jClose ;"
x = oNew("JRW")
m.j.jIn = x
m.x.jReading = 1
m.x.jWriting = 0
x = oNew("JRW")
m.j.jOut = x
m.x.jReading = 0
m.x.jWriting = 1
call oDecMethods oNewClass("Jbuf", "JRW"),
, "jOpen return jBufOpen(m, arg)",
, "jReset return jBufReset(m, arg)",
, "oSetTypePara call jBufSetTypePara m, type",
, "jRead return jBufRead(m, var)",
, "jWrite call jBufWrite m, line"
return
endProcedure jInit
jIn: procedure expose m.
parse arg arg
return jRead(m.j.jIn, arg)
endProcedur jIn
jOut: procedure expose m.
parse arg arg
call jWrite m.j.jOut, arg
return
endProcedure jOut
/*--- jBuf: buffer read or write (supports datataypes) ---------------*/
jBuf: procedure expose m.
m = oNew('Jbuf')
call jBufReset m
do ax=1 to arg()
m.m.buf.ax = arg(ax)
end
m.m.buf.0 = ax-1
return m
endProcedure jBuf
jBufReset: procedure expose m.
parse arg m
m.m.stem = m'.BUF'
m.m.buf.0 = 0
call oSetTypePara m
do ax=1 to arg() - 1
m.m.buf.ax = arg(ax+1)
m.m.buf.0 = ax
end
return m
endProcedure jBufReset
jBufSetTypePara: procedure expose m.
parse arg m, type
if m.m.buf.0 <> 0 then
call err 'jBufSetTypePara but not empty'
return
endProcedure jBufSetTypePara
jBufOpen: procedure expose m.
parse arg m, opt
call jClose m
if opt == 'r' then do
m.m.readIx = 0
m.m.jReading = 1
return m
end
if opt == 'w' then
m.m.buf.0 = 0
else if opt ^== 'a' then
call err 'jBufOpen('m',' opt') with bad opt'
m.m.jWriting = 1
return m
endProcedure jBufOpen
jBufRead: procedure expose m.
parse arg m, var
nx = m.m.readIx + 1
if nx > m.m.buf.0 then
return 0
m.m.readIx = nx
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.var = m.m.buf.nx
else
call oTyCopy ty, var, m'.BUF.'nx
return 1
endProcedure jBufRead
jBufWrite: procedure expose m.
parse arg m, line
nx = mInc(m'.BUF.0')
ty = oGetTypePara(m)
if abbrev(ty, '=') then
m.m.buf.nx = line
else
call oTyCopy ty, m'.BUF.'nx, line
return 1
endProcedure jBufRead
/* copy j end *********************************************************/
/* copy oFld begin *****************************************************
defines classes with field names
is the base for the oo layer in copy o
***********************************************************************/
/*--- initialize the module ------------------------------------------*/
oFldIni: procedure expose m.
if m.oFld.ini = 1 then
return
m.oFld.ini = 1
call mapIni
m.o.fldOnly = mapNew() /* map fields -> class */
m.o.cla.0 = 0 /* the stem for classes */
call oFldNew 'Class', '=', , , /* MetaClass definieren */
'INST = MET .<>= FLD .<>=Class STEM =Class'
return
endProcedure oFldIni
/*--- create a new class
name: name of new class, a star will be replaced by a number
va: type of value
st: type of stem
flds: pairs of field names and types
dup: duplicate resolver -----------------------------------*/
oFldNew: procedure expose m.
parse arg name, va, st, flds, dup
if pos('*', name) > 0 then
name = oPut('O.CLA', name, , '*')
else
call oPut 'O.CLA', name, , 'n'
m.o.cla.name.inst = 0
m.o.cla.name.val = va
m.o.cla.name.stem = st
m.o.cla.name.FLD.0 = 0
m.o.cla.name.MET.0 = 0
return oFldAdd(name, flds, dup)
endProcedure oFldNew
/*--- create or find a class with only simple fields fs --------------*/
oFldOnly: procedure expose m.
parse arg fs, dup
kk = space(fs '?'dup, 1)
if mapHasKey(m.o.fldOnly, kk) then
return mapGet(m.o.fldOnly, kk)
if dup ^== 'e' then do
ll = space(fs, 1)
end
else do
ll = ''
do wx=1 to words(fs)
w = word(fs, wx)
v = w
do x=2 while wordPos(v, ff) > 0
v = w || x
end
ll = space(ll v, 1)
end
end
if mapHasKey(m.o.fldOnly, ll) then do
nn = mapGet(m.o.fldOnly, ll)
end
else do
nn = oFldNew('FldType*')
st = 'O.CLA.'nn'.FLD'
do lx=1 to words(ll)
call oPut st, word(ll, lx), '=', dup
end
call mapPut m.o.fldOnly, ll, nn
end
call mapPut m.o.fldOnly, kk, nn
return nn
endProcedure oFldOnly
/*--- return the stem of flds of class type --------------------------*/
oFlds: procedure expose m.
parse arg type
return 'O.CLA.'type'.FLD'
/*--- return the concatenation of the fields of type ty in stem st
formated by fmt -------------------------------------------*/
oFldCat: procedure expose m.
parse arg ty, st, fmt
flds = oFlds(ty)
res = ''
do ix=1 to m.flds.0
f = m.flds.ix
if fmt == '' then
res = res m.st.f
else
res = res fmt(m.st.f, m.fmt.ix)
end
return substr(res, 2)
endProcedure oFldCat
/*--- add fields to class cl given as name type pairs in fs ----------*/
oFldAdd: procedure expose m.
parse arg cla, fs, dup
st = 'O.CLA.'cla'.FLD'
do ix=1 by 2 to words(fs)
call oPut st, word(fs, ix), word(fs, ix+1), dup
end
return cla
endProcedure oFldAdd
/*--- add/put key k with value v to stem st
duplicate handling dup:
* replace * in k by a number until it is new
e add a number in it is not new
o replace old value at existing key
= add a new key, fail if key exists and value is different
------------------------------------------------------------*/
oPut: procedure expose m.
parse arg st, k, v, dup
if dup = '*' then do
cx = pos('*', k)
if cx < 1 then
call err 'no * in key' k
k = oPutDupResolve(st, left(k, cx-1), 1)
end
else if symbol('m.st.k') = 'VAR' then do
if dup = '' | dup = 'o' then do
m.st.k = v
return k
end
if dup = '=' then do
if v <> m.st.k | ^ (v = '' & datatype(m.st.k, 'n')) then
call err 'not =: m.'st'.'k '=>' m.st.k '<>' v
return k
end
if dup = 'e' then
k = oPutDupResolve(st, k, 2)
else
call err 'key' k 'exists in' st 'but dup' dup
end
else if dup = 'o' then
call err 'old key' k 'does not exist in' st
if datatype(k, 'n') | words(k) <> 1 | pos('.', k) > 0 then
call err 'illegal name' k
x = m.st.0 + 1
m.st.0 = x
m.st.x = k
if v == '' then
m.st.k = x
else
m.st.k = v
return k
endProcedure oPut
oPutDupResolve: procedure expose m.
parse arg st, k, b
do ix=b
a = k || ix
if symbol('m.st.a') <> 'VAR' then
return a
end
endProcedure oPutDupResolve
/*--- parameterized types --------------------------------------------*/
oGetTypePara: procedure expose m.
parse arg m
if symbol('m.o.tyPa.m') == 'VAR' then
return m.o.tyPa.m
else
return '='
endProcedure oGetTypePara
oSetTypePara: procedure expose m.
parse arg m, type, noCall
if type = '' then
type = '='
if oGetTypePara(m) == type then
return
if noCall ^== 'noCall' then
interpret oObjMethod(m, 'oSetTypePara')
m.o.tyPa.m = type
return
endProcedure oSetTypePara
/* copy oFld end ***************************************************/
/* copy o begin ********************************************************
object layer has three freatures
* an object may have a class which has methods
* an object may have a parmeterized type
* a class may contain field descriptions
***********************************************************************/
oClaMethod: procedure expose m.
parse arg cl, me
if symbol('m.o.cla.cl.met.me') = 'VAR' then
return m.o.cla.cl.met.me
else
call err 'no method' me 'in class' cl
endProcedure oClaMethod
oHasMethod: procedure expose m.
parse arg obj, me
cla = oGetClass(obj)
return symbol('m.o.cla.cl.met.me') = 'VAR'
endProcedure oHasMethod
oGetClass: procedure expose m.
parse arg Obj
if symbol('m.o.obj2cla.Obj') = 'VAR' then
return m.o.obj2cla.Obj
call err 'no class found for object' obj
endProcedure oGetClass
oObjMethod: procedure expose m.
parse arg obj, me
if symbol('m.o.obj2cla.obj') = 'VAR' then
return oClaMethod(m.o.obj2cla.obj, me)
if abbrev(obj, 'oCast:') then do
cx = pos(':', obj, 7)
return 'M="'substr(obj, cx+1)'";' ,
oClaMethod(substr(obj, 7,cx-7), me)
end
call err 'no class found for object' obj
endProcedure oObjMethod
oCast: procedure
parse arg obj, cl
if abbrev(obj, 'oCast:') then
obj = substr(obj, 1 + pos(':', obj, 7))
return 'oCast:'cl':'obj
endProcedure oCast
oNewClass: procedure expose m.
parse arg name, super
/* call oIni */
name = oFldNew(name)
neMe = 'O.CLA.'name'.MET'
neFi = 'O.CLA.'name'.FLD'
do sx=1 to words(super)
sup = word(super, sx)
if symbol('m.o.cla.sup') ^== 'VAR' then
call err 'superclass' sup 'is not defined'
if m.o.cla.sup.val ^== '' then
m.o.cla.name.val = m.o.cla.sup.val
if m.o.cla.sup.stem ^== '' then
m.o.cla.name.stem = m.o.cla.sup.stem
st = 'O.CLA.'sup'.MET'
do x=1 to m.st.0
olMe = m.st.x
call oPut neMe, olMe, m.st.olMe
end
st = 'O.CLA.'sup'.FLD'
do x=1 to m.st.0
olFi = m.st.x
call oPut neFi, olFi, m.st.olFi
end
end
call oMutate 'O.CLA.'name, 'Class'
return name
endProcedure oNewClass
oValStemFldsWKOLD: procedure expose m.
parse arg cl, m.o.cla.cl.val, m.o.cla.cl.stem, flds
st = 'O.CLA.'cl'.FLD'
do wx=1 by 2 to words(flds)
call oPut st, word(flds, wx), word(flds, wx+1)
end
return cl
endProcedure oValStemFlds
oNewTypeWKOLD: procedure expose m.
parse arg cl, va, st, flds
return oValStemFlds(oNewClass(cl), va, st, flds)
/*--- a field type has only fields of type '='
finds or creates a field Type with the fields of types tps
and the field list aFl.
if dup = 'e' duplicate field names are resolved ------------*/
oFiTypeWKOLD: procedure expose m.
parse arg tps, aFl, dup
if symbol('m.o.cla.fiType.tps.aFl.dup') = 'VAR' then
return m.o.cla.fiType.tps.aFl.dup
fs = ''
do wx=1 to words(tps)
t1 = oFlds(word(tps, wx))
do fx=1 to m.t1.0
fs = fs m.t1.fx
end
end
fs = fs aFl
fd = ''
do wx=1 to words(fs)
f1 = word(fs, wx)
if wordPos(f1, fd) < 1 then do
fd = fd f1
end
else if dup == 'e' then do
do dx=2 by 1 while wordPos(f1 || dx, fn fs) > 0
end
fd = fd f1 || dx
end
end
fd = space(fd aFl)
if symbol('m.o.cla.fiType.fd') = 'VAR' then do
res = m.o.cla.fiType.fd
end
else do
res = oNewClass("FiType*")
m.o.cla.fiType.fd = res
st = 'O.CLA.'res'.FLD'
do wx=1 to words(fd)
call oPut st, word(fd, wx), '='
end
end
m.o.cla.fiType.tps.aFl = res
return res
endProcedure oFiType
oDecMethods: procedure expose m.
parse arg cla
st = 'O.CLA.'cla'.MET'
do ax=2 to arg()
call oPut st, word(arg(ax), 1), subWord(arg(ax), 2)
end
return
endProcedure oDecMethods
oNew: procedure expose m.
parse arg cla
st = 'O.CLA.'cla
if symbol('M.st') ^== 'VAR' then
call err 'class' cla 'is not initialized'
nn = m.st.inst + 1
m.st.inst = nn
nn = 'O.C' || m.st || 'I' || nn
if symbol('m.o.obj2cla.nn') == 'VAR' then
call err 'oNew already defined:' nn
m.o.obj2cla.nn = cla
return nn
endProcedure oNew
oMutate: procedure expose m.
parse arg obj, class
if obj == 'O.C13I12' then do
end
if symbol('M.O.CLA.class') ^== 'VAR' then
call err 'class' class 'is not initialized'
m.o.obj2cla.obj = class
return obj
endProcedure oMutate
oSay: procedure expose m.
parse arg type, a, aPr, mPr
ty = 'O.CLA.'type
msg = mPr || substr(a, length(aPr)+1)
redir = 0
do forever
if type == '=' then do
say msg '=' m.a
return
end
else if abbrev(type, '=') then do
a = m.a
msg = msg '==>' a
redir = 1
type = substr(type, 2)
end
else if left(type, 2) = '<>' then do
k = m.a
a = left(a, lastPos('.', a))k
msg = msg '=<>' k
redir = 1
type = substr(type, 3)
end
else if left(type, 1) = '.' then do
if ^ datatype(m.a.0, 'n') then
call err 'type' type 'not stem but m.'a'.0 is' m.a.0
type = substr(type, 2)
if redir then do
say msg 'stem 1..'m.a.0':' type
end
else do
do y=1 to m.a.0
call oSay type, a'.'y, a'.', mPr' '
end
end
return
end
else if redir then do
say msg':' type
return
end
else do
leave
end
end
if m.ty.val = '=' then
say msg '=' m.a
else
say msg '=' m.a':' m.ty.val
/* call oSay m.ty.val, a,==>' m.a '(to' m.ty.val')' */
do y=1 to m.ty.fld.0
f = m.ty.fld.y
call oSay m.ty.fld.f , a'.'f, a'.', mPr' '
end
if m.ty.stem ^== '' then
call oSay '.'m.ty.stem, a, a, mPr
return
endProcedure oSay
oClear: procedure expose m.
parse arg type, a, val
if abbrev(type, '.') then do
m.a.0 = 0
end
else if abbrev(type, '<>') then do
m.a = val
call oClear substr(type, 3), left(a, lastPos('.', a))val, val
end
else if abbrev(type, '=') then do
m.a = ''
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.a = val
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oClear m.ty.fld.k, a'.'k, val
end
if m.ty.stem ^== '' then
call m.a.0 = 0
end
return a
endProcedure oClear
oCopy: procedure expose m.
parse arg t, f
if symbol('m.o.obj2cla.f') ^== 'VAR' then
call err f 'has no class'
cl = m.o.obj2cla.f
m.o.obj2cla.t = m.o.obj2cla.f
return oTyCopy(cl, t, f)
endProcedure oCopy
oTyCopy: procedure expose m.
parse arg type, t, f
if abbrev(type, '.') then do
do y=1 to m.f.0
call oTyCopy substr(type, 2), t'.'y, f'.'y
end
m.t.0 = m.f.0
end
else if abbrev(type, '<>') then do
k = m.f
m.t = k
call oTyCopy substr(type, 3), left(t, lastPos('.', t))k,
, left(f, lastPos('.', f))k
end
else if abbrev(type, '=') then do
m.t = m.f
end
else do
ty = 'O.CLA.'type
if m.ty.val ^== '' then
m.t = m.f
do x = 1 to m.ty.fld.0
k = m.ty.fld.x
call oTyCopy m.ty.fld.k, t'.'k, f'.'k
end
if m.ty.stem ^== '' then
call oTyCopy '.'m.ty.stem, t, f
end
return t
endProcedure oTyCopy
/*--- Run ------------------------------------------------------------*/
oRunner: procedure expose m.
parse arg code
return oRunnerReset(oNew('ORunner'), code)
oRunnerReset: procedure expose m.
parse arg m, pCode
m.m.code = pCode
return m
endProcedure oRunnerReset
oRun: procedure expose m.
parse arg m
interpret m.m.code
return
endProcedure oRun
oIni: procedure expose m.
if m.o.ini = 1 then
return
m.o.ini = 1
call oFldIni
call mapIni
m.o.paTy.0 = 0
call oFldNew '=', '='
call oDecMethods oNewClass('ORunner'), 'oRun call oRun m'
return
endProcedure oIni
/* copy o end *********************************************************/
/* copy scan begin ****************************************************
Scan: scan an input:
scanLine(m,ln) : begin scanning a single line (string)
scanRead??(m,ln): begin scanning all lines of an opened reader
scanAtEnd(m) : returns whether we reached end of input
scanLit(m,lit) : scan Literal lit if present or return 0
scanChar(m,n) : scan next n characters
scanName(m) : scan a name
ScanNat(m) : scan a natural number (without sign)
scanString(m,q): scan a String with quote q. (with doubble = 1)
scanVerify(m,c,o): verify(...,c,o,...)
scanKeyValue(m): scan a key = value clause (with spaces)
scanWord(m,u) : scan a space delimited word or a string,
if u=1 then uppercase non-strings
scanErr(m, txt): error with current scan location
m is an adress, to store our state
if a scan function succeeds, the scan posititon is moved
returns: true if scanned, false otherwise
m.m.tok ==> last token
m.m.val ==> last value for scanString/Word/KeyValue
m.key ==> key for scanKeyValue
m.m.pos ==> scan position
m.m.src ==> scan source
***********************************************************************/
scanIni: procedure expose m.
if m.scan.ini == 1 then
return
m.scan.ini = 1
m.scan.alfLC = 'abcdefghijklmnopqrstuvwxyz'
m.scan.alfUC = translate(m.scan.alfLC)
m.scan.alfa = m.scan.alfLC || m.scan.alfUC
m.scan.alfNum = m.scan.alfa || '0123456789'
return
endProcedure scanIni
scanReset: procedure expose m.
parse arg m, n1, np, co
m.m.tok = ''
m.m.val = ''
m.m.key = ''
m.m.read = ''
return scanOpts(m, n1, np, co)
endProcedure scanReset
scanOpts: procedure expose m.
parse arg m, m.m.scanName1, namePlus, m.m.scanComment
call scanIni
if m.m.scanName1 == '' then
m.m.scanName1 = m.scan.alfa
if namePlus == '' then
m.m.scanNameR = m.m.scanName1 || '0123456789'
else
m.m.scanNameR = m.m.scanName1 || namePlus
return m
endProcedure scanReset
/*--- begin scanning a single line -----------------------------------*/
scanSrc: procedure expose m.
parse arg m, m.m.src
m.m.atEnd = 1
m.m.pos = 1
return m
endProcedure scanSrc
/*--- return the next len characters ---------------------------------*/
scanLook: procedure expose m.
parse arg m, len
if len == '' then
return substr(m.m.src, m.m.pos)
else
return substr(m.m.src, m.m.pos,
, min(len, 1 + length(m.m.src) - m.m.pos))
endProcedure scanLook
/*--- scan the literal lit ------------------------------------------*/
scanLit: procedure expose m.
parse arg m
do ax=2 to arg()
if abbrev(substr(m.m.src, m.m.pos), arg(ax)) then do
m.m.tok = arg(ax)
m.m.pos = m.m.pos + length(arg(ax))
return 1
end
end
m.m.tok = ''
return 0
endProcedure scanLit
/*--- scan the next len characters -----------------------------------*/
scanChar: procedure expose m.
parse arg m, len
nx = 1 + length(m.m.src)
if len ^= '' then
nx = min(m.m.pos + len, nx)
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanChar
/*--- scan a string with quote char qu -------------------------------*/
scanString: procedure expose m.
parse arg m, prefs
m.m.tok = ''
bx = m.m.pos
if prefs = '' then do
qu = substr(m.m.src, bx, 1)
if pos(qu, "'""") < 1 then
return 0
ax = bx + 1
end
else do
do px=1 until abbrev(substr(m.m.src, bx), p1)
p1 = word(prefs, px)
if p1 = '' then
return 0
end
qu = right(p1, 1)
ax = bx + length(p1)
end
m.m.val = ''
do forever
qx = pos(qu, m.m.src, ax)
if qx < 1 then
return scanErr(m, 'ending Apostroph('qu') missing')
m.m.val = m.m.val || substr(m.m.src, ax, qx-ax)
if qx >= length(m.m.src) then
leave
else if substr(m.m.src, qx+1, 1) <> qu then
leave
ax = qx+2
m.m.val = m.m.val || qu
end
m.m.tok = substr(m.m.src, bx, qx+1-bx)
m.m.pos = qx+1
return 1
endProcedure scanString
/*--- scan a Name, first char in *.scanName1, rest in *.scanNameR ----*/
scanName: procedure expose m.
parse arg m
if pos(substr(m.m.src, m.m.pos, 1),
, m.m.scanName1) <= 0 then do
m.m.tok = ''
return 0
end
return scanVerify(m, m.m.scanNameR)
endProcedure scanName
/*--- scan with verify, vOpt is passed to verify ---------------------*/
scanVerify: procedure expose m.
parse arg m, alpha, vOpt
if vOpt == '' then /* empty string does not take default| */
nx = verify(m.m.src, alpha, , m.m.pos)
else
nx = verify(m.m.src, alpha, vOpt, m.m.pos)
if nx = 0 then
nx = length(m.m.src) + 1
m.m.tok = substr(m.m.src, m.m.pos, nx - m.m.pos)
m.m.pos = nx
return m.m.tok ^== ''
endProcedure scanVerify
/*--- scan a natural number (no sign, decpoint ...) ------------------*/
scanNat: procedure expose m.
parse arg m, chEn
if ^ scanVerify(m, '0123456789') then
return 0
if chEn^==0 & pos(substr(m.m.src, m.m.pos,1), m.m.scanNameR)>0 then
call scanErr m, 'illegal number end'
return 1
endProcedure ScanNat
scanInt: procedure expose m.
parse arg m, chEn
if scanNat(m, chEn) then
return 1
ox = m.scan.m.pos
if pos(substr(m.scan.m.src, ox, 1) , '+-') < 1 then
return 0
m.scan.m.pos = ox + 1
if | scanNat(m) then do
m.scan.m.pos = ox
return 0
end
m.tok =substr(m.scan.m.src, ox, 1)|| m.tok
return 1
endProcedure scanInt
/*--- scan a word and put value into *.val
a word is either delimited by space or stopper
or a string (with single or double quotes -------*/
scanWord: procedure expose m.
parse arg m, stopper
if scanString(m) then return 1
if ^scanVerify(m, ' 'stopper, 'm') then return 0
m.m.val = m.m.tok
return 1
endProcedure scanWord
scanBack: procedure expose m.
parse arg m, tok
if m.m.pos <= length(tok) then
call scanErr sc, 'cannot back "'tok'" length'
cx = m.m.pos - length(tok)
if substr(m.m.src, cx, length(tok)) ^== tok then
call scanErr sc, 'cannot back "'tok'" value'
m.m.pos = cx
return
endProcedure scanBack
/*--- scan a key = word phrase
put key into m.key and word into m.m.val -------*/
scanKeyValue: procedure expose m.
parse arg m, def
if ^ scanName(m) then
return 0
m.m.key = m.m.tok
if ^ scanLit(scanSkip(m), '=') then do
m.m.val = def
m.m.tok = ' no='
end
else if ^scanWord(scanSkip(m)) then
call scanErr(m, 'word expected after' m.m.key '=')
return 1
endProcedure scanKeyValue
scanAtEnd: procedure expose m.
parse arg m
return m.m.atEnd & m.m.pos > length(m.m.src)
endProcedure scanAtEnd
/*--- skip over spaces, nl and comments (if option set) --------------*/
scanSpaceNL: procedure expose m.
parse arg m
lastTok = m.m.tok
if m.m.read ^== '' then
interpret 'res = ' oObjMethod(m, 'scanSpaceNl')
else
res = scanSpaceCom(m)
m.m.tok = lastTok
return res
endProcedure scanSpaceNL
scanSpaceCom: procedure expose m.
parse arg m
res = scanVerify(m, ' ')
if m.m.scanComment ^== '' then
if abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
m.m.pos = 1 + length(m.m.src)
return 1
end
return res
endProcedure scanSpaceCom
/*--- skip over space, nl and comments and return m -----------------*/
scanSkip: procedure expose m.
parse arg m
call scanSpaceNl m
return m
endProcedure scanSkip
/*--- emit an error with current scan pos ----------------------------*/
scanErr: procedure expose m.
parse arg m, txt
m.m.err.0 = 0
call err 'scanErr' txt'\n'scanInfo(m, m'.ERR')
return 0
endProcedure scanErr
scanPos: procedure expose m.
parse arg m
if m.m.read ^== '' then
interpret 'return' oObjMethod(m, 'scanPos')
else if scanAtEnd(m) then
return E
else
return 1 m.m.pos
endProcedure scanPos
scanInfo: procedure expose m.
parse arg m
msg = 'last token' m.m.tok 'scanPosition' ,
strip(left(substr(m.m.src, m.m.pos), 40), 't')
if m.m.read == '' then
return msg'\npos' m.m.Pos 'in string' strip(m.m.src, 't')
else
interpret 'return msg"\n" ||' oObjMethod(m, 'scanInfo')
endProcedure scanInfo
/* copy scan end ****************************************************/
/* copy scanRead begin ************************************************/
scanReadIni: procedure expose m.
if m.scanRead.ini = 1 then
return
m.scanRead.ini = 1 then
call scanIni
call jIni
call oDecMethods oNewClass('ScanRead'),
, 'scanReadNl return scanReadNlImpl(m, unCond)',
, 'scanSpaceNl scanReadSpaceNl(m)',
, 'scanClose call scanReadClose m ',
, 'scanInfo scanReadInfo(m)',
, 'scanPos scanReadPos(m)'
return
endProcedure scanReadIni
/*--- begin scanning the lines of a reader ---------------------------*/
scanRead: procedure expose m.
parse arg rdr, n1, np, co
return scanReadReset(oNew('ScanRead'), rdr , n1, np, co)
scanReadReset: procedure expose m.
parse arg m, rdr, n1, np, co
call scanReset m, n1, np, co
m.m.atEnd = 0
m.m.lineX = 0
m.m.read = rdr
call jOpen rdr, 'r'
call scanReadNl m, 1
return m
endProcedure scanRead
scanClose: procedure expose m.
parse arg m
interpret oObjMethod(m, 'scanClose')
return
scanReadClose: procedure expose m.
parse arg m
call jClose m.m.read
return
scanReadNl: procedure expose m.
parse arg m, unCond
interpret oObjMethod(m, 'scanReadNl')
endProcedure scanReadNl
/*--- return true/false whether we are at the end of line / reader ---*/
scanReadNLimpl: procedure expose m.
parse arg m, unCond
if unCond ^== 1 then
if m.m.pos <= length(m.m.src) then
return 0
if m.m.atEnd then
return 0
m.m.atEnd = ^ jRead(m.m.read, m'.SRC')
if m.m.atEnd then do
m.m.pos = 1 + length(m.m.src)
end
else do
m.m.pos = 1
m.m.lineX = m.m.lineX + 1
end
return ^ m.m.atEnd
endProcedure scanReadNLimpl
scanReadSpaceNl: procedure expose m.
parse arg m
fnd = 0
do forever
if scanSpaceCom(m) then
fnd = 1
if ^ scanReadNl(m) then
return fnd
fnd = 1
end
endProcedure scanReadSpaceNl
scanReadPos: procedure expose m.
parse arg m, msg
if scanAtEnd(m) then
return E
else
return m.m.lineX m.m.pos
endProcedure scanReadPos
scanReadInfo: procedure expose m.
parse arg m, msg
if scanAtEnd(m) then
msg = msg'\natEnd after'
else
msg = msg'\npos' m.m.pos 'in'
return msg 'line' m.m.lineX':' strip(m.m.src, 't')
endProcedure scanReadInfo
/* copy scanRead end **************************************************/
/* copy scanWin begin *************************************************
scan the the concatenation of the lines of a reader
any token my be split over several line
except the end-of-line-comment-token
***********************************************************************/
scanWinIni: procedure expose m.
if m.scanWin.ini = 1 then
return
m.scanWin.ini = 1
call scanIni
call jIni
call oDecMethods oNewClass('ScanWin'),
, 'scanReadNl return scanWinNl(m, unCond)',
, 'scanSpaceNl scanWinSpaceNl(m)',
, 'scanClose call scanWinClose m ',
, 'scanInfo scanWinInfo(m)',
, 'scanPos scanWinPos(m)'
return
endProcedure scanReadIni
/*--- instanciate a new window scanner, open rdr ---------------------*/
scanWin: procedure expose m.
parse arg rdr, wiSz, wiBa, cuPo, cuLe
return scanWinReset(oNew('ScanWin'), rdr, wiSz, wiBa, cuPo, cuLe)
/*--- set the attributes of window scanner m, open rdr and start read*/
scanWinReset: procedure expose m.
parse arg m, rdr, wiSz, wiGa, cuPo, cuLe
call scanReset m
m.m.read = rdr
m.m.atEnd = 'still closed'
return scanWinOpts(m, wiSz, wiGa, cuPo, cuLe)
endProcedure scanWinReset
scanWinOpts: procedure expose m.
parse arg m, wiSz, wiGa, cuPo, cuLe
wiSz = word(wiSz 5, 1)
wiGa = word(wiGa 1, 1)
m.m.cutPos = word(cuPo 1, 1)
m.m.cutLen = word(cuLe 72, 1)
m.m.winTot = (wiSz * 2 + wiGa) * m.m.cutLen
m.m.posLim = (wiSz + wiGa) * m.m.cutLen
m.m.posOff = wiGa * m.m.cutLen
return scanWinOpen(m)
endProcedure scanWinReset
scanWinOpen: procedure expose m.
parse arg m, lx
m.m.atEnd = 0
if lx = '' then
m.m.lineX = 1
else
m.m.lineX = lx
m.m.pos = 1
m.m.src = ''
call jOpen m.m.read, 'r'
call scanWinRead m
return m
endProcedure scanWinOpen
scanWinClose: procedure expose m.
m.m.atEnd = 'still closed'
call jClose m.m.read
return
endProcedure scanWinClose
/*--- move the source window: cut left side and append at right side
return number of characters cut at left ------------------------*/
scanWinRead: procedure expose m.
parse arg m
dlt = 0
if m.m.atEnd then
return 0
if m.m.pos >= m.m.posLim then do /* cut left side */
dlt = m.m.pos - (m.m.pos // m.m.cutLen + m.m.posOff)
m.m.src = substr(m.m.src, dlt+1)
m.m.pos = m.m.pos - dlt
m.m.lineX = m.m.lineX + dlt % m.m.cutLen
end
do while length(m.m.src) < m.m.winTot /* read and fill to len */
if ^ jRead(m.m.read, m'.'one) then do
m.m.atEnd = 1
return dlt
end
m.m.src = m.m.src || substr(m.m.one, m.m.cutPos, m.m.cutLen)
end
call assert 'length(m.m.src) = m.m.winTot'
return dlt
endProcedure scanWinRead
/*--- return position of next line start -----------------------------*/
scanWinNLPos: procedure expose m.
parse arg m
return m.m.pos + m.m.cutLen - ((m.m.pos - 1) // m.m.cutLen)
/*--- scan over spaces and comments ----------------------------------*/
scanWinSpaceNL: procedure expose m.
parse arg m
res = 0
do forever
r1 = 0
if scanVerify(m, ' ') then do
r1 = 1
end
else if m.m.scanComment ^== '' ,
& abbrev(substr(m.m.src, m.m.pos), m.m.scanComment) then do
np = scanWinNlPos(m)
r1 = length(m.m.scanComment) <= np - m.m.pos
if r1 then
m.m.pos = np
end
if r1 then
res = 1
else if scanWinRead(m) = 0 then
return res
end
endProcedure scanWinSpaceNl
/*--- return current position in input ------------------------------*/
scanWinPos: procedure expose m.
parse arg m
if scanAtEnd(m) then
return 'E'
else
ps = m.m.pos - 1
return (m.m.lineX + (ps % m.m.cutLen)) (ps // m.m.cutLen + 1)
endProcedure scanWinPos
/*--- return a description of the current scan position --------------*/
scanWinInfo: procedure expose m.
parse arg m
p = scanWinPos(m)
if p == 'E' then do
res = 'atEnd after'
p = m.m.lineX - 1 + length(m.m.src) % m.m.cutLen
end
else do
res = 'pos' word(p, 2) 'in'
p = word(p, 1)
end
return res 'line' p':' strip(substr(m.m.src,
, 1 + (p - m.m.lineX) * m.m.cutLen, m.m.cutLen), 't')
endProcedure scanWinInfo
/* copy scanWin end *************************************************/
/* copy scanSql begin *************************************************/
/*--- initialize with reader inRdr ----------------------------------*/
scanSql: procedure expose m.
parse arg inRdr
return scanSqlReset(scanWin(inRdr), inRdr)
scanSqlReset: procedure expose m.
parse arg m, rdr, scanWin
if scanWin ^== 0 then
call scanWinReset m, rdr, 5, 2, 1, 72
else
m.m.read = rdr
return scanOpts(m, , '0123456789_' , '--')
scanSqlSeekId: procedure expose m.
parse arg m, lx, cmd, opts
if opts = '' then
opts = word
if adrEdit("cursor =" max(trunc(lx), 1), 12) = 12 then
return -1
do while adrEdit("seek" cmd opts, 4) = 0 /* find each command*/
call adrEdit "(fx) = cursor"
if m.debug then do
call adrEdit "(LI) = LINE" fx
call debug 'scanSqlSeekId after' lx 'found' cmd 'at' fx li
end
call editReadReset m.m.read, fx
call scanWinOpen es, fx
do while word(scanPos(m), 1) <= fx & scanSqlType(m)
if m.m.sqlType = 'i' & m.m.val == cmd then
return fx
end
end
return -1
endProcedure scanSqlSeekId
/*--- scan a sql token put type in m.sqltype:
'i': ordinary identifier e.g. Name
'd': delimited identifier e.g. "Delimited"
'q': qualified identifier e.g. abc."efg"
'u': integer units e.g. 8G
'n': number e.g. -234
's': string e.g. 'abc''ef'
'' : at end
: any other character e.g. ;
----------------------------------------------------------------*/
scanSqlType: procedure expose m.
parse arg m, retSpace
m.m.val = ''
if scanSpaceNl(m) & retSpace = 1 then do
m.m.sqlType = 'b'
return 1
end
c2 = scanLook(m ,2)
if scanString(m, "' x' X'") then do
m.m.sqlType = 's'
if ^abbrev(m.m.tok, "'") then
m.m.val = x2c(m.m.val)
end
else if scanSqlQuId(m) then do
if m.m.val.0 > 1 then
m.m.sqlType = 'q'
else if abbrev(m.m.tok, '"') then
m.m.sqlType = 'd'
else
m.m.sqlType = 'i'
end
else if scanSqlNum(m, 0, 1) then
m.m.sqlType = 'n'
else if scanChar(m, 1) then
m.m.sqlType = m.m.tok
else if scanAtEnd(m) then do
m.m.sqlType = ''
return 0
end
else
call scanErr m, 'cannot scan sql'
return 1
endProcedure scanSqlType
scanSqlSkipBrackets: procedure expose m.
parse arg m, br
if br ^== '' then
nop
else if scanLit(m, '(') then
br = 1
else
return 0
do while scanSqlType(m) & m.m.sqlType ^== ';'
if m.m.sqlType = '(' then br = br + 1
else if m.m.sqlType ^== ')' then iterate
else if br > 1 then br = br - 1
else return 1
end
call scanErr m, '; or eof, but' br 'closing ) expected'
endProcedure skipBrackets
/*--- scan an ordinary sql identifier e.g. abc, ef_12 ----------------*/
scanSqlId: procedure expose m.
parse arg m
if ^ scanName(m) then
return 0
m.m.val = translate(m.m.tok)
return 1
endProcedure scanSqlId
/*--- scan a delimited or ordinay sql identifier ---------------------*/
scanSqlDeId: procedure expose m.
parse arg m
if scanSqlId(m) then
return 1
if ^ scanString(m, '"') then
return 0
m.m.val = strip(m.m.val, 't')
return 1
endProcedure scanSqlDeId
/*--- scan a qualified sql identifier --------------------------------*/
scanSqlQuId: procedure expose m.
parse arg m
res = ''
rto = ''
do qx=1
if ^ scanSqlDeId(m) then do
if qx <> 1 then
call scanErr m, 'id expected after .'
return 0
end
m.m.val.qx = m.m.val
res = res'.'m.m.val
rto = rto'.'m.m.tok
if ^ scanLit(scanSkip(m), '.') then
leave
call scanSpaceNl m
end
m.m.val.0 = qx
m.m.val = substr(res, 2)
m.m.tok = substr(rto, 2)
return 1
endProcedure scanSqlQuId
/*--- scan a sql number ----------------------------------------------*/
scanSqlNum: procedure expose m.
parse arg m, checkEnd, noSp
n = ''
if scanLit(m, '+', '-') then do
n = m.m.tok
if noSp <> 1 then
call scanSpaceNl m
end
if scanLit(m, '.') then
n = n'.'
if scanVerify(m, '0123456789') then
n = n || m.m.tok
else if n == '' then
return 0
else if noSp = 1 then do
call scanBack m, n
return 0
end
else
call scanErr m, 'scanSqlNum bad number: no digits after' n
if pos('.', n) < 1 then
if scanLit(m, '.') then do
if scanVerify(m, '0123456789') then
n = n'.'m.m.tok
end
if scanLit(m, 'E', 'e') then do
n = n'E'
if scanLit(m, '+', '-') then
n = n || m.m.tok
if ^ scanVerify(m, '0123456789') then
call scanErr m, 'scanSqlNum bad number: no digits after' n
n = n || m.m.tok
end
if checkEnd ^= 0 then
if pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNum number' n 'bad end' ,
scanLook(m, 1)
m.m.val = n
return 1
endProcedure scanSqlNum
/*--- scan a sql number with a unit which may follow without space ---*/
scanSqlNumUnit: procedure expose m.
parse arg m, both, units
if ^ scanSqlNum(m, 0) then
return 0
nu = m.m.val
sp = scanSpaceNl(m)
if scanSqlId(m) then do
if units == '' | wordpos(m.m.val, units) > 0 then
nu = nu m.m.val
else if both | ^ sp then
call scanErr m, 'scanSqlNumUnit after' nu 'bad unit' m.m.val
else
call scanBack m, m.m.tok
end
else if both then
call scanErr m, 'scanSqlNumUnit no unit after' nu
else if ^sp & pos(scanLook(m, 1), m.m.scanNameR) > 0 then
call scanErr m, 'scanSqlNumUnit bad number end after' nu
m.m.val = nu
return 1
endProcedure scanSqlNumUnit
/* copy scanSql end *************************************************/
/* copy map begin ******************************************************
a map stores values at keys
it may also maintain a list of keys
the basic ideas are similar to the java Interface java.util.Map
contrary to stems we also handle keys longer then 250 bytes
***********************************************************************/
/*--- create a new map ----------------------------------------------*/
mapNew: procedure expose m.
parse arg opt
return mapReset('MAP.'mInc('MAP.0') , opt)
endProcedure mapNew
/*--- make an empty map, opt=K means maintain a stem of keys ---------*/
mapReset: procedure expose m.
parse arg a, opt
if symbol('m.map.keys.a') == 'VAR' then
call mapClear a
upper opt
if opt = '=' then
st = a
else if opt = 'K' then
st = 'MAP.KEYS.'a
else
st = opt
m.map.keys.a = st
if st ^== '' then
m.st.0 = 0
if abbrev(a, 'MAP.') then
m.map.loKy.a.0 = 0
return a
endProcedure
/*--- remove all entries ---------------------------------------------*/
mapClear: procedure expose m.
parse arg a
st = mapKeys(a)
do kx=1 to m.st.0
k = m.st.kx
if length(k) > 200 then do
k = left(k, 201)
if symbol('m.a.k') == 'VAR' then/* ist noch hier */
call mapClear m.a.k
end
drop m.a.k m.st.kx
end
m.st.0 = 0
return a
endProcedure mapClear
/*--- return a stem of all keys (including removed ones) -------------*/
mapKeys: procedure expose m.
parse arg a
if m.map.keys.a == '' then
call err 'mapKeys('a') with no keys'
return m.map.keys.a
endProcedure mapKeys
/*--- add a new key value pair to the map ----------------------------*/
mapAdd: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'a')
m.vv = val
return val
endProcedure mapAdd
/*--- change the value at a key or add key value ---------------------*/
mapPut: procedure expose m.
parse arg a, ky, val
vv = mapValAdr(a, ky, 'p')
m.vv = val
return val
endProcedure mapPut
/*--- return the value pointer for a key, '' if non existang ---------*/
mapValAdr: procedure expose m.
parse arg pA, pKy, fun
a = pA
ky = pKy
do forever
if length(ky) <= 200 then do
if symbol('m.a.ky') ^== 'VAR' then
leave
if fun == 'a' then
call err 'duplicate key' pKy 'in map' pA
return a'.'ky
end
k1 = left(ky, 201)
if symbol('m.a.k1') ^== 'VAR' then
leave
a = m.a.k1
ky = substr(ky, 202)
end
if fun == '' then
return ''
opt = left('K', m.map.keys.pA ^== '')
if opt == 'K' then
call mAdd m.map.Keys.pA, pKy
do while length(ky) > 200
k1 = left(ky, 201)
n = mapNew(opt)
m.a.k1 = n
if a ^== pA & opt == 'K' then
call mAdd m.map.keys.a, ky
a = n
ky = substr(ky, 202)
end
return a'.'ky
endProcedure mapValAdr
/*--- remove a key from the map, do nothing if it is missing ---------*/
mapRemove: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv == '' then
return ''
if ^ abbrev(vv, aa) | m.map,keys ^== '' then
call err 'not implemented mapRemove('a',' ky')'
val = m.a.vv
drop m.a.ky
return val
endProcedure mapRemove
/*--- return 1 if key ky exists in map a, 0 otherwise ----------------*/
mapHasKey: procedure expose m.
parse arg a, ky
return mapValAdr(a, ky) ^== ''
endProcedure mapHasKey
/*--- return the value of key ky in map a if it exists,
else if called with a third argument return third argument
else issue an error ----------------------------------------*/
mapGet: procedure expose m.
parse arg a, ky
vv = mapValAdr(a, ky)
if vv ^== '' then
return m.vv
else arg() > 2 then
return arg(2)
else
call err 'missing key in mapGet('a',' ky')'
endProcedure mapGet
/*--- initialize the module ------------------------------------------*/
mapIni: procedure expose m.
if m.map.ini = 1 then
return
m.map.ini = 1
call mIni
m.map.0 = 0
return
endProcedure mapIni
/* copy map end *******************************************************/
/* copy mapExp begin **************************************************/
mapVia: procedure expose m.
parse arg a, ky
sx = pos('*', ky)
if sx < 1 then
return mapGet(a, ky)
via = mapGet(a, left(ky, sx-1))
do while sx <= length(ky)
fx = sx+1
sx = pos('*', ky, fx)
if sx < 1 then
sx = length(ky) + 1
if sx = fx then do
if symbol('m.via') ^== 'VAR' then
call err 'missing m.'via 'at' sx 'in mapVia('a',' ky')'
via = m.via
end
else do
f = substr(ky, fx, sx - fx)
if symbol('m.via.f') ^== 'VAR' then
call err 'missing m.'via'.'f ,
'at' sx 'in mapVia('a',' ky')'
via = m.via.f
end
end
return via
endProcedure mapVia
mapExpAt: procedure expose m.
parse arg a, src, sx
m.map.ExpAt = 0
cx = pos('$', src, sx)
if cx < 1 then
return substr(src, sx)
res = substr(src, sx, cx-sx)
do forever
if substr(src, cx+1, 1) = '{' then do
ex = pos('}', src, cx+2)
if ex < 1 then
call err 'missing } after' substr(src, cx) 'in' src
res = res || mapVia(a, strip(substr(src, cx+2, ex-cx-2)))
ex = ex + 1
end
else do
ex = verify(src, m.mAlfDot, 'n', cx+1)
if ex < 1 then
return res || mapVia(a, substr(src, cx+1))
if ex = cx+1 then do
m.map.ExpAt = cx
return res
end
res = res || mapVia(a, substr(src, cx+1, ex-cx-1))
end
cx = pos('$', src, ex)
if cx < 1 then
return res || substr(src, ex)
res = res || substr(src, ex, cx-ex)
end
endProcedure mapExpAt
mapExp: procedure expose m.
parse arg a, src
res = mapExpAt(a, src, 1)
if m.map.ExpAt ^== 0 then
call err 'mapExp stopped at' substr(src, map.ExpAt) 'in' src
return res
endProcedure mapExp
mapExpAllAt: procedure expose m.
parse arg a, dst, src, sx, cx
do while sx <= m.src.0
li = mapExpAt(a, m.src.sx, cx)
dx = m.map.ExpAt
if (cx=1 & dx = 0) | li ^= '' then
call mAdd dst, li
if dx = 0 then do
cx = 1
sx = sx+1
end
else do
return sx dx
end
end
return ''
endProcedure mapExpAllAt
mapExpAll: procedure expose m.
parse arg a, dst, src
sto = mapExpAllAt(a, dst, src, 1, 1)
if sto == '' then
return
lx = word(sto, 1)
call err 'mapExpAll stopped at' sto':' m.src.lx
endProcedure mapExpAll
/* copy mapExp end ****************************************************/
/* copy m begin ********************************************************
we use variables as follows
m. stem m: all global data and object data that must survive
a procedure call (m for memory in Memoria of B5000)
m.<mbr>.** to avoid conflicts: every rexx Module (copy) should
only allocate addresses m.<mbr>.** with <mbr> the name of
the rexx module
we pass parameters around (e.g. a=address, m=memory, st=stem)
and the called function may use m.a or m.a.subField etc.
gg*: local variable in subroutines without procedure
everything else: temporary data within procedure
every subroutine is declared as procedure expose m.
(also if no m. variable is used, because e.g. of error handling)
the few subroutines that cannot use procedure, should use only
variables starting with gg
***********************************************************************/
/*--- increase m.a and return it (fail if undefined) -----------------*/
mInc: procedure expose m.
parse arg a
m.a = m.a + 1
return m.a
endProcedure mInc
/*--- cut stem a to length len ---------------------------------------*/
mCut: procedure expose m.
parse arg a, len
m.a.0 = len
return a
endProcedure mCut
/*--- add one or several arguments to stem m.a -----------------------*/
mAdd: procedure expose m.
parse arg a
ix = m.a.0
do ax = 2 to arg()
ix = ix + 1
m.a.ix = arg(ax)
end
m.a.0 = ix
return a'.'ix
endProcedure mAdd
/*--- add to m.dst.* a (sub)sequence of m.src.* ----------------------*/
mAddSt: procedure expose m.
parse arg dst, src
dx = m.dst.0
do sx = 1 to m.src.0
dx = dx + 1
m.dst.dx = m.src.sx
end
m.dst.0 = dx
return
endProcedure mAddAt
/*--- strip all elements of a stem -----------------------------------*/
mStrip: procedure expose m.
parse arg st, opt
if opt == '' then
opt = 'b'
do x=1 to m.st.0
m.st.x = strip(m.st.x, opt)
end
return st
endProcedure mStrip
/*--- cat all elements of a stem together ----------------------------*/
mCat: procedure expose m.
parse arg st, mid
if m.st.0 < 1 then
return ''
res = m.st.1
do x=2 to m.st.0
res = res || mid || m.st.x
end
return res
endProcedure mCat
mIni: procedure expose m.
if m.m.ini = 1 then
return
m.m.ini = 1
m.mAlfLC = 'abcdefghijklmnopqrstuvwxyz'
m.mAlfUC = translate(m.mAlfLC)
m.mAlfa = m.mAlfLC || m.mAlfUC
m.mAlfNum = m.mAlfa || '0123456789'
m.mAlfDot = m.mAlfNum || '.'
return
endProcedure mIni
/* copy m 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 expose m.
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 expose m.
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 expose m.
return time() time('E') sysvar('syscpu') /* sysvar('syssrv') */
/--- display the first comment block of the source as help -----------*/
help: procedure expose m.
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 *****************************************************/
}¢--- A540769.WK.REXX.O08(WT) cre=2008-09-16 mod=2008-09-16-14.36.38 F540769 ---
say time()
call wait 4
say time()
}¢--- A540769.WK.REXX.O08(WV) cre=2007-04-03 mod=2007-04-03-14.57.15 F540769 ---
inDsn = '~tmp.sql(wlviews4)'
outDsn = '~tmp.sql(wlviews5)'
call readDsn inDsn, i.
say 'read' i.0 'from' inDsn
chg = ''
do i=1 to i.0
if substr(i.i, 73) ^= '' then do
over = strip(substr(i.i, 73), 't')
o = length(over)
if right(over, 1) <> ',' then
o = o + 1
v = verify(i.i, ' ', 'n') - 1
if v < 0 then
v = 99
say left(i '<'substr(i.i, 73)'>' o 'sp' v, 25)':' i.i
if o >= v then
call err 'overflow' i '<'substr(i.i, 73)'>' o 'sp' v i.i
i.i = substr(i.i, o+1)
say left(i 'changed to', 25)':' i.i
chg = chg i
end
end
say 'changed' words(chg)':' chg
if 1 then
call writeDsn outDsn, i., , 1
exit
err:
call errA arg(1), 1
endSubroutine err
/* 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', "'")
else if sysvar('SYSPREF') = '' | addPrefix = 0 then
return dsn
else
return sysvar('SYSPREF')'.'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
m.dsnAlloc.dsn = ''
if left(spec, 1) = '=' then
return strip(substr(spec, 2))
addPref = pos('~', spec) > 0
if addPref then
spec = strip(spec, 'b', '~')
do wx=1 to 3
w = word(spec, wx)
if w = '.' then do
wx = wx + 1
leave
end
if w = '' then
leave
if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if m.dsnAlloc.dsn = '' then
m.dsnAlloc.dsn = dsn2jcl(w, addPref)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
if m.dsnAlloc.dsn <> '' then
disp = disp "dsn('"m.dsnAlloc.dsn"')"
call adrTso 'alloc dd('dd')' disp subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(XLS) cre=2008-06-05 mod=2008-06-05-13.26.58 F540769 ---
call readDsn '~wk.texv(testcsv)', i.
call sqlConnect 'DBTF'
call sqlPrepare 1, 'select dbName, tsName' ,
'from sysibm.sysTables' ,
'where creator = ? and name = ?'
do i=1 to i.0
parse var i.i NA ';' CR ';' TY ';' DB ';' TS ';'
say ty':' cr'.'na db'.'ts'|'
call sqlOpAllCl 1, st, ':m.st.sx.sDb, :m.st.sx.sTs', cr, na
say 'sql fetch 'm.st.0 m.st.1.sDb'.'m.st.1.sTs'|'
end
exit
/* copy sql begin ***************************************************
sql interface
***********************************************************************/
sqlIni: procedure expose m.
m.sqlNull = '---'
return
endProcedure sqlIni
/*--- prepare statement 's'cx from sql src into descriptor desc ------*/
sqlPrepare: procedure expose m.
parse arg cx, src, descOut, descInp
s = ''
if descOut == 1 then
s = 'into :M.SQL.'cx'.D'
call sqlExec 'prepare s'cx s 'from :src'
if descInp == 1 | (descInp == '' & pos('?', src) > 0) then
call sqlExec 'describe input s'cx 'into :M.SQL.'cx'.I'
else
m.sql.cx.i.sqlD = 0
return
endProcedure
/*--- prepare and declare 'c'cx from sql src -------------------------*/
sqlPreDeclare: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPrepare cx, src, descOut, descInp
call sqlExec 'declare c'cx 'cursor for s'cx
return
endProcedure sqlPreDeclare
/*--- prepare, declare and open 'c'cx from sql src -------------------*/
sqlPreOpen: procedure expose m.
parse arg cx, src, descOut, descInp
call sqlPreDeclare cx, src, descOut, descInp
call sqlOpen cx
return
endProcedure sqlPreOpen
/*--- open cursor 'c'cx using arguments arg(2), arg(3)... ------------*/
sqlOpen: procedure expose m.
parse arg cx
do ix=1 to arg()-1
call sqlDataSet 'SQL.'cx'.I', ix, arg(ix+1)
end
call sqlExec 'open c'cx 'using descriptor :M.SQL.'cx'.I'
return
endProcedure sqlOpen
/*--- close cursor 'c'cx ---------------------------------------------*/
sqlClose: procedure expose m.
parse arg cx, src
return sqlExec('close c'cx)
endProcedure sqlClose
/*--- fetch cursor 'c'cx into variables ggVars -----------------------*/
sqlFetchInto:
parse arg ggCx, ggVars
if ggVars == '' then
ggVars = 'descriptor :M.SQL.'ggCX'.D'
/* accept sqlCodes > 0 except 100 */
return sqlExec('fetch c'ggCx 'into' ggVars, 0 100) <> 100
endProcedure sqlFetchInto
/*--- return sql variable list for stem st and fields the word in vars
if withInd == 1 then with sqlIndicator variables
sqlVars('S', 'A B') --> ':S.A, :S.B'
sqlVars('S', 'A B', 1) --> ':S.A :S.A.SQLIND, :S.B :S.B.SQLIND'
----------------------------------------------------------------------*/
sqlVars: procedure expose m.
parse arg st, vars, withInd
res = ''
if st ^== '' then
st = st'.'
do ix=1 to words(vars)
res = res', :'st || word(vars, ix)
if withInd == 1 then
res = res ':'st || word(vars, ix)'.SQLIND'
end
return substr(res, 3)
endProcedure sqlVars
sqlVarsNull: procedure expose m.
parse arg st, vars
hasNulls = 0
do ix = 1 to words(vars)
fld = word(vars, ix)
if m.st.fld.sqlInd < 0 then do
m.st.fld = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlVarsNull
sqlDescNull: procedure expose m.
parse arg cx
desc = 'SQL.'ggCX'.D',
hasNulls = 0
do ix=1 to m.desc.SQLD
if m.desc.ix.sqlInd < 0 then do
m.desc.ix.sqlData = m.sqlNull
hasNulls = 1
end
end
return hasNulls
endProcedure sqlDescNull
/*--- open cursor 'c'cx fetch all into variables vars and close
st = passed stem, sx = row number
return number of rows fetched ----------------------------------*/
sqlOpAllCl:
parse arg ggCx, st, ggVars
do ggAx=4 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-3, arg(ggAx)
end
call sqlOpen ggCx
do sx = 1 while sqlFetchInto(ggCx, ggVars)
end
m.st.0 = sx - 1
call sqlClose ggCx
return m.st.0
endProcedure sqlOpAllCl
sqlDataSet: procedure expose m.
parse arg da, ix, val
m.da.ix.sqlData = val
m.da.ix.sqlInd = - (arg(ix+2) == m.sqlNull)
return
endProcedure sqlDataSet
/*--- prepare, declare open cursor 'c'cx, fetch all and close
return number of rows fetched ----------------------------------*/
sqlPreAllCl:
parse arg ggCx, ggSrc, st, ggVars
call sqlPreDeclare ggCx, ggSrc
return sqlOpAllCl(ggCx, st, ggVars)
endProcedure sqlPreAllCl
/*--- execute statement 's'cx using arguments arg(2), arg(3)... ------*/
sqlExecute:
parse arg ggCx
do ggAx=2 to arg()
call sqlDataSet 'SQL.'ggCx'.I', ggAx-1, arg(ggAx)
end
call sqlExec 'execute s'ggCx 'using descriptor :M.SQL.'ggCx'.I'
return
endProcedure
/*--- execute immediate the sql src ----------------------------------*/
sqlExImm: procedure expose m.
parse arg src
call sqlExec 'execute immediate :src'
return
endProcedure sqlExImm
sqlCommit: procedure expose m.
parse arg src
return sqlExec('commit')
endProcedure sqlCommit
/*--- execute sql thru the dsnRexx interface -------------------------*/
sqlExec: /* no procedure, to keep variables sql... */
parse arg ggSqlStmt, ggRet, ggNo
if ggNo <> '1' then
ggSqlStmt = 'execSql' ggSqlStmt
address dsnRexx ggSqlStmt
/* say 'sqlCode' sqlCode 'rc' rc 'for' ggSqlStmt ggNo */
if rc = 0 then
return 0
else if ggRet = '*' | wordPos(sqlCode, ggRet) > 0 then
return sqlCode
else if rc < 0 then
call err sqlmsg()
else if sqlWarn.0 ^== ' ' | sqlCode <> 0 then
call errSay sqlMsg(), ,'w'
return sqlCode
endSubroutine sqlExec
/*--- connect to the db2 subsystem ggSys -----------------------------*/
sqlConnect: procedure
parse arg ggSys, ggRetCon
call sqlIni
if adrTSO("SUBCOM DSNREXX", '*') <> 0 then do
sRc = RXSUBCOM('ADD','DSNREXX','DSNREXX') /* ADD HOST CMD ENV */
if sRc <> 0 then
call err 'rc' sRc 'from RXSUBCOM(ADD, DSNREXX, DSNREXX)'
end
call sqlExec "connect" ggSys, ggRetCon ,1
return
endProcedure sqlConnect
/*--- diconnect from db2 ---------------------------------------------*/
sqlDisconnect: procedure
parse arg ggRet
call sqlExec "disconnect ", ggRet, 1
return
endProcedure sqlDisconnect
/*--- issue an sql error message -------------------------------------*/
sqlMsg: /* no procedure, to keep variables sql... */
signal on syntax name sqlMsgOnSyntax
ggRes = 'sqlCode' sqlCodeT(sqlCode, sqlErrMc, sqlwarn.0':' ,
|| sqlwarn.1||sqlwarn.2||sqlwarn.3||sqlwarn.4||sqlwarn.5',',
|| sqlwarn.6||sqlwarn.7||sqlwarn.8||sqlwarn.9||sqlwarn.10)
if 0 then
sqlMsgOnSyntax: do
ggRes = 'sqlCode' sqlCode translate(sqlErrMc, ',', 'ff'x),
'<<rexx sqlCodeT not found or syntax>>\nwarnings'
do ggX=0 to 10
if sqlWarn.ggx <> '' then
ggRes = ggRes ggx'='sqlWarn.ggx
end
end
signal off syntax
ggRes = ggRes'\nstate' sqlState'\nstmt = ' ggSqlStmt
ggPref = '\nwith'
ggXX = pos(':', ggSqlStmt)+1
do 12 while ggXX > 1
ggYY = verify(ggSqlStmt, ' ,:+-*/&%?|()¢!', 'm', ggXX)
if ggYY < 1 then
ggYY = length(ggSqlStmt) + 1
ggVar = substr(ggSqlStmt, ggXX, ggYY - ggXX)
if ggVar <> '' then do
ggRes = ggRes || ggPref ggVar '=' value(ggVar)
ggPref = '\n '
end
ggXX = pos(':', ggSqlStmt, ggYY+1) + 1
end
return ggRes
endSubroutine sqlMsg
/*--- send a command to db2 through the TSO dsn processor ------------*/
sqlDsn: procedure expose m.
parse arg st, sys, cmd, rcOk
x = outtrap('M.'st'.')
push 'END'
push cmd
rr = adrTso('DSN SYSTEM('sys')', '*')
x = outtrap(off)
if rr = 0 | rcOk = '*' | wordPos(rr, rcOk) > 0 then
return rr
fl = max(1, m.st.0 - 10)
em = 'rc' rr 'for DSN SYSTEM('sys') cmd' cmd,
'\nOuputlines' fl '-' m.st.0':'
do lx=fl to m.st.0
em = em '\n' strip(m.st.lx, 't')
end
call err em
endProcedure sqlDsn
/* copy sql 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(s005y000) 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(XX) cre=2008-09-16 mod=2008-11-13-11.03.04 F540769 ---
}¢--- A540769.WK.REXX.O08(XXX) cre=2006-09-07 mod=2006-09-07-13.02.59 F540769 ---
//A540769L JOB (CP00,KE50)
//*MAIN CLASS=LOG
//* alle Dataset l:schen, die wir nachher neu erstellen
//S1 EXEC PGM=IEFBR14
//RM1 DD DISP=(MOD,DELETE,DELETE),
// DSN=A540769.TMPUL.PU1.OLDPUNCH
//* Originales Punchfile Kopieren
//S2 EXEC PGM=IEBCOPY
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD DISP=OLD,DSN=DSN.DBAF.DRE01.A525A.LPUNCH.S88.D2006158
//SYSUT2 DD DISP=(NEW,CATLG,DELETE),DSN=A540769.TMPUL.PU1.OLDPUNCH,
// LIKE=DSN.DBAF.DRE01.A525A.LPUNCH.S88.D2006158
}¢--- A540769.WK.REXX.O08(XYZ) cre=2008-03-05 mod=2008-03-05-15.43.49 F540769 ---
/* rexx */
parse arg a
say 'xyz with' a
}¢--- A540769.WK.REXX.O08(ZGL) cre=2008-04-03 mod=2008-06-27-11.42.04 F540769 ---
/* rexx ****************************************************************
synopsis: zgl wsl?
editmacro um zgl Worklisten zu bearbeiten
1) e wsl und zgl c oder zgl <wsl Name>
fügt wsl Namen ein
macht dbacheck und dbarb
2) r wsl und zgl
modifiziert JobName auf Y<wsl Name>
fügt eine // no run Zeile ein
um versehentlichem Run zu verhidern
kopiert jcl in Library dsn.zgl.AUG.dbof.wj
damit man das admin tool zum submitten nicht mehr braucht
***********************************************************************
**********************************************************************/
parse arg args
subsys = 'DBOF'
call adrIsp 'control errors return'
mbr = ''
call adrEdit 'macro (args)'
aMbr = translate(word(args, 1))
call adrEdit "(l1) = line .zf"
if pos('?', args) then
return help()
wMbr = findWorklist()
if abbrev(l1, '//') then do
if wMbr = '' then
call err 'no worklist=' found
ll = '//Y'left(wMbr, 7) subword(l1, 2)
call adrEdit "line .zf = (ll)"
ll = '// no run'
call adrEdit "line_after .zf = (ll)"
call adrEdit "replace 'DSN.ZGL.AUG.DBOF.WJ("wMbr")' .zf .zl"
return
end
if wMbr = '' then do
if length(aMbr) < 8 then do
fnd = 'source work stmt list'
em = ''
if adrEdit("seek '"fnd"' first", 4) = 0 then do
call adrEdit "(lx, cx) = cursor"
call adrEdit "(line) = line" lx
em = word(substr(line, pos(fnd, line)+length(fnd)), 1)
end
if length(em) <> 8 then do
fnd = 'DSN.DBA.'
call adrEdit 'cursor = .zf'
do 4
if adrEdit("seek" fnd, 4) ^= 0 then
call err 'could not find member, dsn.dba not found'
call adrEdit "(lx, cx) = cursor"
call adrEdit "(line) = line" lx
sx = cx + 8
do 4
ex = verify(line, ' .', 'm', sx)
if ex <= sx then
ex = 1+length(line)
em = strip(substr(line, sx, ex-sx))
if length(em) = 8 then
leave
sx = ex+1
if sx > length(line) then
leave
end
if length(em) = 8 then
leave
end
end
if length(em) <> 8 then
call errHelp 'no mbr detected in line' lx':' line
wMbr = overlay(aMbr, em, 9 - length(aMbr))
say 'detected qualifier' em 'yielding member' wMbr
end
else
wMbr = aMbr
li = '-- worklist='wMbr
call adrEdit 'line_before .zf = (li)'
end
if length(wMbr) <> 8 then
call errHelp 'mbr "'wMbr'" should have length 8'
else if pos(right(wMbr, 1), 'CW') = 0 then
call errHelp 'mbr "'wMbr'" should end with C or W'
else if right(wMbr, length(aMbr)) ^== aMbr then
call err 'worklist='wMbr 'but arg mbr=' aMbr
say 'dbaCheck for' wMbr
call adrEdit "replace tmp.dbaVor("wMbr") .zf .zl"
call dbaCheck aa
call adrEdit "replace tmp.dbaNac("wMbr") .zf .zl"
say 'dbaRb for' wMbr subsys
call dbaRb 'isMacro' subsys
return
findWorklist: procedure expose m.
fnd = 'worklist='
if adrEdit("seek" fnd, 4) ^== 0 then
return ''
call adrEdit "(lx, cx) = cursor"
call adrEdit "(line) = line" lx
px = pos(fnd, line)
if px < 0 then
call err 'bad' fnd 'in line' lx line
wMbr = word(substr(line, px+length(fnd)), 1)
if length(wMbr) <> 8 then
call err 'bad worklist len' wMbr 'in line' px line
return wMbr
endProcedure findWorklist
do mx = 1 to words(libMid)
dsn = jcl2dsn(libPre || word(libMid, mx) || libSuf"("mbr")")
sd = sysDsn(dsn)
if sd = 'OK' then do
if pos('S', opt) < 1 then do
say 'remove existing mbr' mbr 'in' dsn' (r for remove)?'
parse upper pull a
if left(a, 1) ^== 'R' then do
say 'exiting because answer was' a 'and not r'
exit
end
opt = opt || 'S'
end
call lmmRmMbr dsn
end
else if sd ^== 'MEMBER NOT FOUND' then do
call err 'unexpected sysDsn('dsn') =' sd
end
end
if pos('R', opt) > 0 then
exit
x.1 = 'SRCWSLST =' overlay('Q', mbr, length(mbr))','
x.2 = 'CLNWSLST =' mbr','
call writeDsn jcl2dsn(multiInp), 'X.', 2
if right(mbr, 1) == 'W' then
call adrTso 'sub' jcl2dsn(multiNew)
else if right(mbr, 1) == 'C' then
call adrTso 'sub' jcl2dsn(multiChg)
else
call err 'cannot start job for mbr' mbr
if isMacro & nd = 'RZ1' then do
call adrEdit '(zl) = lineNum .zl'
do x=2 to zl+1
call adrEdit '(li) = line' (x-1)
li.x = li
end
li.1 ='-- Copied by dbamulti for' userid() 'on' date() 'at' time()
call writeDsn jcl2dsn(multiCopy'('left(mbr,7)'Q)'), li., zl+1
end
exit
err:
call errA arg(1), 1
endSubroutine err
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn)
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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 .
if left(dsn,1) = "'" then
return strip(dsn, 'b', "'")
else if sysvar('SYSPREF') = '' then
return dsn
else
return sysvar('SYSPREF')'.'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
dsn = strip(dsn)
if right(dsn, 1) = "'" then
dsn = strip(left(dsn, length(dsn) - 1))
bx = pos('(', dsn)
if bx > 0 then
dsn = strip(left(dsn, bx-1))
if mbr <> '' then
dsn = dsn'('strip(mbr)')'
if left(dsn, 1) = "'" then
dsn = dsn"'"
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), 't', "'")
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
if left(spec, 1) = '=' then
return strip(substr(spec, 1))
dsn = ''
do wx=1 to 3
w = word(spec, wx)
if w = '' then
leave
else if wordPos(w, 'OLD SHR MOD NEW')>0 | abbrev(w, 'SYSO') then
disp = w
else if abbrev(w, 'DD(') then
dd = substr(w, 4, length(w)-4)
else if dsn = '' | left(w, 1) = "'" then
dsn = 'dsn('w')'
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
disp = 'SHR'
call adrTso 'alloc dd('dd')' disp dsn subword(spec, wx)
return dd 'call adrTso "free dd('dd')";'
endProcedure dsnAlloc
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
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)
return
endSubroutine writeDsn
/* copy adrTso end ****************************************************/
/* copy err begin ******************************************************
messages, errorhandling,help
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: procedure
parse arg showmsg
return time() sysvar('syscpu') /* sysvar('syssrv') */ showmsg
/--- 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 *****************************************************/
}¢--- A540769.WK.REXX.O08(ZUEGEL) cre=2007-04-05 mod=2007-07-02-18.23.03 F540769 ---
/* rexx ***************************************************************
synopsys: TSO ZUEGEL fun
fun
leer oder ? diese Hilfe
d qual wsl Member (in DSN.DBA.qual.WSL) und IFF pruefen,
im Batch laufen lassen um IFF zu restoren |
x prd xmit wsl members and iff to production
x pta xmit wsl members and iff to pta
c clone alle WSL (nur im RZ2 oder RR2)
die WSL's sind in einem Dataset(Member) definiert mit Layout
wsl user auft rz date time mask
1 19 24 38 50
rz: 2, 4, 24: welche RZ's
mask: falls ein spezielles MaskingDataset verwendet werden soll
.ODV ==> DSN.DBA.MASK.DBAFDBOF.ODV
************************************************************************
05.05.2007 w. keller neu
***********************************************************************/
call adrIsp 'Control errors return'
parse upper arg fun opt
skels = 'ORG.U0009.B0106.KIUT23.SKELS'
list = skels'(zglAug)'
gen = '~tmp.jcl'
if fun = '' | pos('?', fun opt) > 0 then do
say 'zuegel mit wsl-Liste in' list
exit help()
end
call wslList list
if fun = 'D' then
call wslDsns opt
else if fun = 'X' then
call makeJobs skels'(zglXm'dest(opt)')', gen'(zueXm'dest(opt)')'
else if fun = 'C' then
call makeClon skels'(zglClone)', gen'(zueClone)'
else if fun = 'R' then
call rmMembers DSN.DBA.DBOF.WSL
else
call errHelp 'bad fun' fun 'in arguments' fun opt
exit
dest: procedure
parse arg opt
if abbrev('PROD', opt) | abbrev('PRD', opt) then
return 'PRD'
else if abbrev('PTA', opt) then
return 'PTA'
else
call errHelp 'ungueltiges RZ' opt
endProcedure dest
wslList: procedure expose m.
parse arg dsn
call readDsn dsn, m.wsl.
wx = 0
do sx = 1 to m.wsl.0
sl = m.wsl.sx
if left(sl, 1) = '*' then
say 'ignoring' strip(sl, 't')
else do
wx = wx+1
m.wx.name = substr(sl, 1, 8)
m.wx.auft = substr(sl, 19, 2)
m.wx.rz = substr(sl, 24, 2)
m.wx.tim = substr(sl, 38, 5)
m.wx.mask = word(substr(sl, 50, 5), 1)
/* say m.wx.name 'auft' m.wx.auft 'rz' m.wx.rz 'um' m.wx.tim */
end
end
m.0 = wx
say m.0 'WSLs' form m.wsl.0 'lines from' dsn
return
endProcedure wlsList
wslDsns: procedure expose m.
parse arg mid
if mid = '' then
mid = 'CLON'
pds = 'DSN.DBA.'mid'.WSL'
pre = 'DSN.DBA.'
suf = '.IFF'
do wx=1 to m.0
say m.wx.name sysDsn("'"pds"("strip(m.wx.name)")'")
fn = pre || overlay('Q', m.wx.name, 8) || suf
say fn sysDsn("'"fn"'")
end
return
endProcedure wslDsns
makeJobs: procedure expose m.
parse arg iDs, oDs
call readDsn iDs, j.
do ex=1 to j.0 while pos('EXEC', j.ex) < 4
end
say 'exec' ex strip(left(j.ex, 72), 't')
o = 0
do wx=1 to m.0
if m.wx.rz = '' then do
say 'ignoring' m.wx.name 'rz' m.wx.rz 'tim' m.wx.tim
iterate
end
do j=1 to ex-1
o = o + 1
o.o = chg(j.j, '???', left(m.wx.name, 7))
end
do r=2 to 4
if pos(r, m.wx.rz) < 1 then
iterate
do j=ex to j.0
o = o + 1
o.o = chg(j.j, '???', left(m.wx.name, 7), '|', r)
end
end
end
call writeDsn oDs '::F', o., o, 1
call adrIsp "edit dataset('"dsn2jcl(oDs)"')", 4
return
endProcedure makeJobs
makeClon: procedure expose m.
parse arg iDs, oDs
call readDsn iDs, j.
o = 0
do wx=1 to m.0
isOld = translate(substr(m.wx.name, 8, 1), 'YN', 'CW')
isNew = translate(substr(m.wx.name, 8, 1), 'NY', 'CW')
say m.wx.name '==> isNew' isNew 'isOld' isOld
if ^ (isNew == 'Y' | isNew == 'N') then
call err 'isNew not Y or N but' isNew 'wsl' m.wx.name
do j=1 to j.0
if left(j.j, 3) = '---' then do
if isNew == 'Y' then
j.j = substr(j.j, 4)
else
iterate
end
o = o + 1
o.o = chg(j.j, '????', m.wx.name,
, '???', left(m.wx.name, 7) ,
, '¢', isNew,
, '!', isOld,
, '+++', m.wx.mask)
end
end
call writeDsn oDs "::F", o., o, 1
call adrIsp "edit dataset('"dsn2jcl(oDs)"')", 4
return
endProcedure makeClon
rmMembers: procedure expose m.
parse arg dsn
mm = ''
do wx=1 to m.0
mm = mm m.wx.name
end
say 'remove from' dsn
say mm
parse upper pull an 2 .
if an ^== 'R' then
call err 'not removing answer was' an
call lmmRmMbr "'"dsn"'", mm
return
endProcedure makeClon
chg: procedure
parse arg text 73 over
do ax=2 by 2 to arg()
ol = arg(ax)
ne = arg(ax+1)
cx = 1
do forever
cx = pos(ol, text, cx)
if cx < 1 then
leave
text = left(text, cx-1) || ne ,
|| substr(text, cx + length(ol))
cx = cx + length(ne)
end
end
return strip(text, 't')
endProcedure chg
err:
call errA arg(1), 1
endSubroutine err
/* rexx */
call lmmTest
exit
/* 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 showTime() 'lmdlist save' grp lev
call adrTso 'alloc dd('grp') shr dsn('grp'.datasets)'
end
else do
call trc 'no datasets found' showTime() '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 */
/**********************************************************************
member list of a pds:
call sequence x=lmmBegin(dsn) lmmNext(x) * lmmEnd(x)
***********************************************************************/
lmmTest: procedure
parse arg dsn
if dsn = '' then
dsn = 'wk.pli(*)'
say 'lmmTest for dsn' dsn
id = lmmBegin(dsn2Jcl(dsn, 1))
do ix=1 by 1
m = lmmNext(id)
if m = '' then
leave
say ix m
end
call lmmEnd id
say 'lmmTest end' (ix-1) 'members in' dsn
return
endProcedure lmmTest
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 mbr
else
return ''
endProcedure lmmNext
lmmRmMbr: 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
/**********************************************************************
adr*: address an environment
***********************************************************************/
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
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 -------------------------------------------*/
dsnAlloc: procedure expose m.
parse upper arg spec, disp, dd
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 ds = '' then
ds = dsn2jcl(w)
else
leave
end
if dd = '' then
dd = 'DD' || ooNew()
if disp = '' | (disp = 'OLD' & pos('(', dsn) > 0) then
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
***********************************************************************/
/* caller should define err as follows ---------------------------------
err:
call errA arg(1), 1
endSubroutine err
end call should define err ----------------------------------------*/
/*--- error routine: abend with message ------------------------------*/
errA:
parse arg ggTxt, ggHist
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggTxt
if ggHist ^== 1 then
exit setRc(12)
say 'divide by zero to show stack history'
x = 1 / 0
endSubroutine errA
/*--- abend with Message after displaying help -----------------------*/
errHelp: procedure
parse arg ggMsg
parse source . . ggS3 . /* current rexx */
say 'fatal error in' ggS3':' ggMsg
call help
call err ggMsg
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
----------------------------------------------------------------------*/
setRc: procedure
parse arg zIspfRc
if sysVar('sysISPF') = 'ACTIVE' then do
say 'exitRc setting zIspfRc='zIspfRc
address ispExec vput 'zIspfRc' shared
end
return zIspfRc
endProcedure setRc
/*--- 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 ------------------------------*/
showtime: 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 *****************************************************/