This REXX can report on ONLINE devices. I have it set up to report on DASD
volumes found where the argument is part of the volume name.
It also contains some unused code that I haven't removed.
Regards
Bruce Hewson
/*REXX*****************************************************
***********/
/* */
/* TITLE = Scan UCBs */
/* */
/* COPYRIGHT = */
/* */
/* AUTHOR = Bruce Hewson */
/* */
/* NAME = SCANUCBS */
/* */
/* FUNCTION = */
/* */
/* NOTES = */
/* */
/* INPUT = Subset mask of required VolSer */
/* */
/* OUTPUT = */
/* */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* CHANGE HISTORY: Latest change at top. */
/* */
/* Date Name Description */
/* ======== ===============
======================================== */
/* 18/07/07 Bruce Hewson Original Version. */
/* */
/**********************************************************
***********/
Trace 'o'
Signal on Novalue /* Clean diagnostics */
Signal on Syntax /* for unexpected results. */
Numeric Digits 16
/*-------------------------------------------------------------------*/
Parse Source opsys calltype execname .
Parse Upper Arg search_arg .
/*-------------------------------------------------------------------*/
/*- SCANUDBD - Scan UCBs and summarize NED entries -*/
/*-------------------------------------------------------------------*/
Say 'Begin of dasd UCB scan'
num_UCB = 0
num_UCB_online_CU = 0
num_UCB_offline_CU = 0
num_UCB_online_total = 0
num_UCB_offline_total = 0
SSCB_print. = ""
SSCB_print.0 = 0
ULUT_address = Ulut()
ULUTE_address = Ulute()
If Storage(ULUT_address, 4) = "ULUT" Then Do
ULUTDASD = C2d(Storage(X2x(ULUT_address, '1C'), 4))
ULUTDSDI = C2d(Storage(X2x(ULUT_address, '34'), 2))
dasd_ULUTE_addr = D2x(X2d(ULUTE_address) + (12 * (ULUTDSDI -1)))
ULUTNXDC = C2d(Storage(X2x(dasd_ULUTE_addr, '2'), 2))
Do While ULUTNXDC <> 0
num_UCB = num_UCB + 1
ULUTUCBP = C2x(Storage(X2x(dasd_ULUTE_addr, '08'), 4))
ULUTDEVN = C2x(Storage(X2x(dasd_ULUTE_addr, '00'), 2))
DASD_volser = Storage(X2x(ULUTUCBP, '1C'), 6)
flag1 = C2x(Storage(X2x(ULUTUCBP, '17'), 1))
If Bitand(X2c(flag1),'01'x) = '01'x Then Do
UCB_plus15 = C2d(Storage(X2x(ULUTUCBP, '15'), 3)) - 1
hi_byte = X2d(Left(ULUTUCBP,2) ³³ '000000')
UCBEXTP_addr = D2x(hi_byte + UCB_plus15)
End
Else Do
UCBEXTP_addr = C2x(Storage(X2x(ULUTUCBP, '15'), 3))
End
UCBIEXT_addr = C2x(Storage(X2x(UCBEXTP_addr, '08'), 4))
SSCB_addr = C2x(Storage(X2x(UCBIEXT_addr, '30'), 4))
If SSCB_addr = '00000000' Then Do
TokenNED = Left('NED not found',32)
End
Else Do
TokenNED = Storage(X2x(SSCB_addr,'1C'),32)
End
ix = SSCB_print.0
If ix > 0 Then Do
If Strip(SSCB_print.ix) <> Strip(SSCB_addr) ,
& SSCB_addr <> "00000000" Then Do
/* Call Print_SSCB */
num_UCB_offline_CU = 0
num_UCB_online_CU = 0
ix = ix + 1
SSCB_print.ix = SSCB_addr
SSCB_print.SSCB_addr = ix
SSCB_print.0 = ix
SSCB_print.DEV.ix = ULUTDEVN
SSCB_print.NED.ix = TokenNED
End
Else Do
If Left(SSCB_print.DEV.ix,2) <> Left(ULUTDEVN,2) Then Do
/* Call Print_SSCB */
num_UCB_offline_CU = 0
num_UCB_online_CU = 0
ix = ix + 1
SSCB_print.ix = SSCB_addr
SSCB_print.SSCB_addr = ix
SSCB_print.0 = ix
SSCB_print.DEV.ix = ULUTDEVN
SSCB_print.NED.ix = TokenNED
End
End
If Pos(search_arg,DASD_volser) <> 0 Then Do
Say Right(DASD_volser,8) ,
Right(ULUTDEVN,8) ,
Right(Substr(TokenNED, 7, 4),8) ,
Right(Substr(TokenNED,14, 3),6) ,
Right(Substr(TokenNED,17, 2),6) ,
Substr(TokenNED,19,12)
End
End
Else Do
ix = ix + 1
SSCB_print.ix = SSCB_addr
SSCB_print.SSCB_addr = ix
SSCB_print.0 = ix
SSCB_print.DEV.ix = ULUTDEVN
SSCB_print.NED.ix = TokenNED
End
If SSCB_addr = '00000000' Then Do
num_UCB_offline_CU = num_UCB_offline_CU + 1
num_UCB_offline_total = num_UCB_offline_total + 1
End
Else Do
num_UCB_online_CU = num_UCB_online_CU + 1
num_UCB_online_total = num_UCB_online_total + 1
End
ULUTNXDC = C2d(Storage(X2x(dasd_ULUTE_addr, '04'), 2))
dasd_ULUTE_addr = D2x(X2d(ULUTE_address) + (12 * (ULUTNXDC -1)))
End
End
Say
Say "Number of DASD UCBs processed:" num_UCB
Say "Number of DASD UCBs in ULUT :" ULUTDASD
Say "Number of dasd Online :" num_UCB_online_total
Say "Number of dasd Offline :" num_UCB_offline_total
Return
Print_SSCB:
ix = SSCB_print.0
Say "device:" SSCB_print.DEV.ix ,
"SSCB at" SSCB_print.ix ":" ,
Readable(SSCB_print.NED.ix) ,
"NED found#:" Right(num_UCB_online_CU,3) ,
"NED not found#:" Right(num_UCB_offline_CU,3)
Return
/*-------------------------------------------------------------------*/
/*- XXX - Return address of common MVS control blocks -*/
/*-------------------------------------------------------------------*/
PSA: Procedure: Return '00'
CVT: Procedure: Return C2x(Storage(X2x(Psa(), '10'),4))
CVTFIX: Procedure: Return X2xD(Cvt(), '100')
CVTUSER: Procedure: Return C2x(Storage(X2x(Cvt(), 'CC'),4))
CVTAUTHL:Procedure: Return C2x(Storage(X2x(Cvt(), '1E4'),4))
CVTCSD: Procedure: Return C2x(Storage(X2x(Cvt(), '294'),4))
CVTVSTGX:Procedure: Return C2x(Storage(X2x(Cvt(), '4AC'),4))
CVTLLTA: Procedure: Return C2x(Storage(X2x(Cvt(), '4DC'),4))
ECVT: Procedure: Return C2x(Storage(X2x(Cvt(), '8C'),4))
TSAB: Procedure: Return C2x(Storage(X2x(Ecvt(), 'B0'),4))
IPA: Procedure: Return C2x(Storage(X2x(Ecvt(),'188'),4))
DFA: Procedure: Return C2x(Storage(X2x(Cvt(), '4C0'),4))
RMCT: Procedure: Return C2x(Storage(X2x(Cvt(), '25C'),4))
ZDTAB: Procedure: Return C2x(Storage(X2x(Cvt(), '40'),4))
STB: Procedure: Return C2x(Storage(X2x(Cvt(), '70'),4))
HSM: Procedure: Return C2x(Storage(X2x(Cvt(), '3DC'),4))
GVT: Procedure: Return C2x(Storage(X2x(Cvt(), '1B0'),4))
GDA: Procedure: Return C2x(Storage(X2x(Cvt(), '230'),4))
TCB: Procedure: Return C2x(Storage(X2x(Psa(), '21C'),4))
ASCB: Procedure: Return C2x(Storage(X2x(Psa(), '224'),4))
AUTHL: Procedure: Return C2x(Storage(X2x(Cvt(), '1E4'),4))
ASVT: Procedure: Return C2x(Storage(X2x(Cvt(), '22C'),4))
RCE: Procedure: Return C2x(Storage(X2x(Cvt(), '490'),4))
RAX: Procedure: Return C2x(Storage(X2x(Rce(), '80'),4))
LLT: Procedure: Return C2x(Storage(X2x(Cvt(), '4DC'),4))
SMCA: Procedure: Return C2x(Storage(X2x(Cvt(), 'C4'),4))
SMCAFRDS:Procedure: Return C2x(Storage(X2x(Smca(), 'F4'),4))
SCVT: Procedure: Return C2x(Storage(X2x(Cvt(), 'C8'),4))
SVCT: Procedure: Return C2x(Storage(X2x(Scvt(), '84'),4))
SVCR: Procedure: Return C2x(Storage(X2x(Scvt(), '88'),4))
ASXB: Procedure: Return C2x(Storage(X2x(Ascb(), '6C'),4))
LDA: Procedure: Return C2x(Storage(X2x(Ascb(), '30'),4))
LWA: Procedure: Return C2x(Storage(X2x(Asxb(), '14'),4))
ACEE: Procedure: Return C2x(Storage(X2x(Asxb(), 'C8'),4))
CSCB: Procedure: Return C2x(Storage(X2x(Ascb(), '38'),4))
TIOT: Procedure: Return C2x(Storage(X2x(Tcb(), 'C'),4))
JSCB: Procedure: Return C2x(Storage(X2x(Tcb(), 'B4'),4))
QDB: Procedure: Return C2x(Storage(X2x(Jscb(),'140'),4))
JCT: Procedure: Return X2x(C2x(Storage(X2x(Jscb(),'104'),4)),'10')
JMR: Procedure: Return C2x(Storage(X2x(Jct(), '86'),4))
SCT: Procedure: Return C2x(Storage(X2x(Jct(), '20'),4))
SSIB: Procedure: Return C2x(Storage(X2x(Jscb(),'13C'),4))
JESCT: Procedure: Return C2x(Storage(X2x(Cvt(), '128'),4))
SSCVT: Procedure: Return C2x(Storage(X2x(Jesct(),'18'),4))
IOCOM: Procedure:
Return C2x(Storage(X2x(Cvt(), '7C'),4))
IOVT: Procedure:
Return C2x(Storage(X2x(Iocom(), 'D0'),4))
ULUT: Procedure:
Return C2x(Storage(X2x(Iovt(), '08'),4))
ULUTE: Procedure:
Return C2x(Storage(X2x(Ulut(), '0C'),4))
X2x: Procedure: Return D2x(X2d(Arg(1))+X2d(Arg(2)))
X2xD: Procedure: Return D2x(X2d(Arg(1))-X2d(Arg(2)))
/*=========================================================
==========*/
DumpStor: Procedure
Parse Arg stor_address , stor_length
stor_data = Storage(stor_address,stor_length)
Do offset = 0 to ( stor_length - 1 ) by 16
chunk_length = Min(stor_length - offset , 16)
chunk_data = Substr(stor_data,offset+1,chunk_length)
chunk_hex = Left(C2x(chunk_data),32)
chunk_address = X2x(stor_address,D2x(offset))
Say Right(chunk_address,8,'0') ³³ ' ' ,
Right(D2x(offset),4,'0') ³³ ' ' ,
Substr(chunk_hex,1,8) ,
Substr(chunk_hex,9,8) ,
Substr(chunk_hex,17,8) ,
Substr(chunk_hex,25,8) ,
' ' ,
'*' ³³ Readable(Left(chunk_data,16)) ³³ '*'
End
Return
/*=========================================================
==========*/
C2b: Procedure
Parse Arg char_string
hex_string = C2x(char_string)
bin_string = ""
Do ptr = 1 to Length(hex_string)
hex_test = X2d(Substr(hex_string,ptr,1))
If hex_test >= 8 Then Do
bin_string = bin_string ³³ '1'
hex_test = hex_test - 8
End
Else Do
bin_string = bin_string ³³ '0'
End
If hex_test >= 4 Then Do
bin_string = bin_string ³³ '1'
hex_test = hex_test - 4
End
Else Do
bin_string = bin_string ³³ '0'
End
If hex_test >= 2 Then Do
bin_string = bin_string ³³ '1'
hex_test = hex_test - 2
End
Else Do
bin_string = bin_string ³³ '0'
End
If hex_test >= 1 Then Do
bin_string = bin_string ³³ '1'
hex_test = hex_test - 1
End
Else Do
bin_string = bin_string ³³ '0'
End
End
Return bin_string
/*=========================================================
==========*/
Readable: Procedure
/*
from = ""
Do i = 0 to 255
from = from ³³ X2c(D2x(i))
End
*/
to = "................"
to = to ³³ "................"
to = to ³³ "................"
to = to ³³ "................"
to = to ³³ " ...........<(+³"
to = to ³³ "&.........!$*);ª"
to = to ³³ "-.........í,%_>?"
to = to ³³ "..........:#@'="""
to = to ³³ ".abcdefghi......"
to = to ³³ ".jklmnopqr......"
to = to ³³ "..stuvwxyz......"
to = to ³³ "................"
to = to ³³ ".ABCDEFGHI......"
to = to ³³ ".JKLMNOPQR......"
to = to ³³ "./STUVWXYZ......"
to = to ³³ "0123456789......"
/*
Return Translate(Arg(1),to,from)
*/
Return Translate(Arg(1),to)
/*=========================================================
==========*/
/*-------------------------------------------------------------------*/
/* Convert timestamp to hours minutes seconds */
/*-------------------------------------------------------------------*/
Convert_Time: Procedure
Parse Arg seconds
Address TSO
hour = seconds % 360000
minute = (seconds - hour * 360000) % 6000
IF hour > 12 THEN
DO
hour = hour - 12
period = 'PM'
END
ELSE
period = 'AM'
minute = RIGHT(minute,2,'0')
Return hour ³³ ":" ³³ minute ³³ period
/*-------------------------------------------------------------------*/
/* Convert Julian Date to Gregorian. */
/*-------------------------------------------------------------------*/
Convert_Date: Procedure
Parse Arg jdate
Address TSO
yy = Substr(jdate,3,2)
ddd = Substr(jdate,5,3)
monthlist = '31' ³³ 28+Leapyear(yy) ³³ '31303130313130313031'
monthname = 'JanFebMarAprMayJunJulAugSepOctNovDec'
If Left(jdate,2) = "00" Then yy = "19" ³³ yy
Else yy = "20" ³³ yy
ddx = 0
ddy = 0
Do i = 1 to 12
ddx = ddy + Substr(monthlist,(2*i) -1,2)
If ddd > ddx Then Do
ddy = ddx
End
Else Do
mm = i
Leave
End
End
month = Substr(monthname,((mm-1)*3)+1,3)
dd = Right((ddd - ddy),2,'0')
Return dd month yy
/*-------------------------------------------------------------------*/
Leapyear: Procedure
Parse Arg year .
If Datatype(year) ª= 'NUM' Then Do /* moderate error check */
Say "LEAPYEAR invoked with invalid argument" year
Exit /* no value - abort process */
End
Return ((year//4=0)&(year//100<>0))³(year//400=0)
/*=========================================================
==========*/
/*=========================================================
==========*/
Syntax:
Say "SYNTAX raised in line" sigl". rc="rc "("errortext(rc)")."
zsigl = sigl /* Number of sourceline in error */
Parse Version impl langlevel . /* Look at language level */
Signal Common /* continue with common code */
NoValue:
Say "NOVALUE raised at line" sigl
zsigl = sigl /* Number of sourceline in error */
Parse Version impl langlevel . /* Look at language level */
If langlevel > 3.45 Then Do /* Condition BIF is supported */
Say "Then referenced variable is" "CONDITION"('D')
End
Signal Common /* continue with common code */
Common: /* Common error handling */
Trace 'o' /* Ensure no tracing */
If sourceline() <> 0 Then Do /* Source lines available */
Say '"'CompleteSource(zsigl)'"'/* Show the line in error */
End
If Left(impl,5) <> "REXXC" Then Do /* NOT running a compiled program*/
Say "You can look around now..." /* Tell user what they can do */
Trace ?R /* interactive tracing */
Nop
End
Exit
CompleteSource: Procedure
Parse Arg linenum
If Datatype(linenum) <> "NUM" Then linenum=1
line = Strip(SourceLine(linenum))
Do While (( Right(line,1) = ",") & (linenum <= SourceLine()))
linenum = linenum + 1
line = Left(line,(length(line)-1)) Strip(SouceLine(linenum))
End
Return line
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [EMAIL PROTECTED] with the message: GET IBM-MAIN INFO
Search the archives at http://bama.ua.edu/archives/ibm-main.html
