|
HP OpenVMS Systemsask the wizard |
|
The Question is:
It was encouraging to read that Compaq will provide process/global section
cross referencing in a future release. When?
I have made a DCL which in the meantime does what we need. Except it is
painfully slow. Upwards of 1 hour on an OpenVMS 7.2-1 AlphaServer hosting
only our software package which holds about 80 global sections and 200
processes.
What can I do to speed it up?
What takes the time is the search of the ASCII dump of the p0 page table of
each process for the pfn/gptx of each section. Using the search utility
instead of DCL read is even slower.
How can I get SDA to filter out info irrelevant to this task? Get rid of
page and column headers? Does SDA export any shared image entry points which
I can use? Anything to reduce the ASCII step would help. Without it the task
is probably solved in no tim
e.
Thanks
$ !
$ ! GSUSER.COM
$ !
$ ! Description
$ !
$ ! Site independent procedure to output a cross reference
$ ! of user mode group global sections and mapping processes.
$ !
$ ! Invocation
$ !
$ ! $ GSUSER [gsnam [prcnam] ]
$ !
$ ! Wildcards are supported. Default of both arguments is *.
$ ! Argument placeholder is "".
$ !
$ ! Notes
$ !
$ ! Use the arguments for a faster response.
$ !
$ ! Method
$ !
$ ! Using SDA
$ ! dump group gsd's -> gste's -> gpte's -> pfn/gptx's
$ ! loop processes
$ ! dump p0
$ ! loop p0 records
$ ! loop pfn/gptx's
$ ! search p0 record for pfn/gptx
$ ! if hit then process maps global section
$ !
!---------------------------------------------------------------------------
--
$ !
$ ! announce
$ !
$ say := write sys$output
$ say ""
$ say "User mode group global sections by process
$ say ""
$ say " P = page file section"
$ say " * = not accessed"
$ say ""
$ !
$ ! initialize
$ !
$ iniprv = f$getjpi("","CURPRIV") ! initial privileges
$ set proc /priv=all ! take all privileges
$ mypid = f$getjpi("","PID") ! my pid
$ myfilspc = f$environment("PROCEDURE")
$ myfilnam = f$parse(myfilspc,,,"NAME")
$ pagtypX = "GPTX"
$ pagtypW = "GBLWRT"
$ !
$ ! set work files
$ !
$ filcom = "sys$scratch:''myfilnam'_''mypid'" ! common file spec items
$ sdain = "''filcom'.IN" ! SDA input
$ sdaerr = "''filcom'.ERR" ! SDA error
$ gsdfil = "''filcom'.GSD" ! global section descriptor
$ gstfil = "''filcom'.GST" ! global section table
$ ptefil = "''filcom'.PTE" ! page table entry
$ pt0fil = "''filcom'.PT0" ! P0 page table
$ !
$ ! set condition handlers
$ !
$ on control_y then goto l_main_ctly
$ on error then goto l_main_error
$ !
$ ! get GPTE address of all group global sections
$ !
$ gosub s_ggs
$ !
$ ! loop all processes
$ !
$ ctx = ""
$ l_main_prc_nxt:
$ pid = F$PID(ctx)
$ if pid .eqs. "" ! if no more
$ then
$ goto l_main_done
$ endif
$ prcnam = f$getjpi(pid,"PRCNAM")
$ prcnam = f$edit(prcnam,"TRIM")
$ !
$ ! wildcard filter
$ !
$ if p2 .nes. "" ! if commandline argument
$ then
$ tststr = prcnam
$ wldstr = p2
$ gosub s_wldcmp
$ if .not.wldcmp ! if mismatch
$ then
$ goto l_main_prc_nxt
$ endif
$ endif
$ !
$ ! output process name
$ !
$ idx=0
$ pidstr = ""
$ l_main_dig_nxt:
$ if f$extract(idx,1,pid) .eqs. "0"
$ then
$ pidstr = pidstr+"." ! replace leading "0" with
"."
$ idx = idx+1
$ goto l_main_dig_nxt
$ endif
$ pidstr = pidstr+f$extract(idx,f$length(pid)-idx,pid)
$ say "''pidstr' ''prcnam'"
$ !
$ ! find GPTE in process P0 page table
$ !
$ gosub s_pt0
$ !
$ ! next process
$ !
$ goto l_main_prc_nxt
$ !
$ ! close files
$ !
$ l_main_close:
$ inimsg = f$environment("MESSAGE") ! initial message setting
$ set message /nofac /nosev /noid /notext ! discard messages, if any
$ close sdain
$ close gsdfil
$ close gstfil
$ close ptefil
$ close pt0fil
$ set message 'inimsg' ! initial message setting
$ return
$ !
$ ! control-y handler
$ !
$ l_main_ctly:
$ say "Procedure cancelled"
$ gosub l_main_close
$ goto l_main_done
$ !
$ ! error handler
$ !
$ l_main_error:
$ say "Procedure internal error"
$ gosub l_main_close
$ if f$search("''filcom'.*") .nes. ""
$ then
$ purge 'filcom'.* ! leave last for debug
$ endif
$ goto l_main_exit
$ !
$ ! done
$ !
$ l_main_done:
$ if f$search("''filcom'.*") .nes. ""
$ then
$ delete 'filcom'.*;* ! cleanup
$ endif
$ goto l_main_exit
$ !
$ ! exit
$ !
$ l_main_exit:
$ set proc /priv=('iniprv') ! set initial privileges
$ exit
$ !
$ ! subroutines
$ !
!---------------------------------------------------------------------------
--
$ !
$ ! get GPTE of group global sections
$ !
$ s_ggs:
$ !
$ ! get group GSD's and GPTBASE
$ !
$ sdacmd0 = "exa MMG$GQ_GPT_BASE"
$ sdacmd1 = "show gsd /group"
$ cmdmax = 2
$ def /user sdaout 'gsdfil'
$ gosub s_sda ! execute SDA commands
$ !
$ ! process group GSD's
$ !
$ open /read gsdfil 'gsdfil'
$ read /end=l_ggs_gsdfil_end gsdfil record
$ GPTBASE = %X'f$extract(27,8,record) ! convert from hexadecimal
$ gsdidx = 0
$ read /end=l_ggs_gsdfil_end gsdfil record
$ l_ggs_gsdfil_nxt:
$ read /end=l_ggs_gsdfil_end gsdfil record
$ subrec = f$extract(53,f$length(record),record)
$ len = f$length(subrec)
$ if f$locate("WRT AMOD=USER",subrec) .eq. len ! verify access mode
$ then
$ goto l_ggs_gsdfil_nxt
$ endif
$ !
$ ! extract GSD name and GSTE index
$ !
$ gsdnam = f$extract(9,44,record) ! extract name
$ gsdnam = f$edit(gsdnam,"TRIM")
$ !
$ ! wildcard filter
$ !
$ if p1 .nes. "" ! if commandline argument
$ then
$ tststr = gsdnam
$ wldstr = p1
$ gosub s_wldcmp
$ if .not.wldcmp ! if mismatch
$ then
$ goto l_ggs_gsdfil_nxt
$ endif
$ endif
$ !
$ ! save in symbol array
$ !
$ gsdnam'gsdidx = gsdnam ! save
$ gstx = f$extract(53,4,record) ! extract index
$ if f$locate("PAGFIL",subrec) .eq. len ! if user file section
$ then
$ gsftyp'gsdidx = ""
$ else ! if page file section
$ gsftyp'gsdidx = "P"
$ endif
$ !
$ ! write SDA commands
$ !
$ sdacmd'gsdidx = "show gst /sec=''gstx'"
$ gsdidx = gsdidx+1
$ goto l_ggs_gsdfil_nxt
$ !
$ ! get GSTE
$ !
$ l_ggs_gsdfil_end:
$ close gsdfil
$ gsdhix = gsdidx ! 1-origin
$ cmdmax = gsdhix
$ def /user sdaout 'gstfil'
$ gosub s_sda ! execute SDA commands
$ !
$ ! process GSTE's
$ !
$ gsdidx = 0
$ open /read gstfil 'gstfil'
$ l_ggs_gstfil_nxt:
$ read /end=l_ggs_gstfil_end gstfil record
$ len = f$length(record)
$ if f$locate("WRT AMOD=USER",record) .eq. len ! find record
$ then
$ goto l_ggs_gstfil_nxt
$ endif
$ !
$ ! extract GPTE
$ !
$ record = f$edit(record,"TRIM,COMPRESS")
$ gpte = f$element(2," ",record)
$ !
$ ! write SDA commands
$ !
$ sdacmd'gsdidx = "exa ''gpte'"
$ gsdidx = gsdidx+1
$ goto l_ggs_gstfil_nxt
$ !
$ ! get GPTE
$ !
$ l_ggs_gstfil_end:
$ close gstfil
$ cmdmax = gsdhix
$ def /user sdaout 'ptefil'
$ gosub s_sda ! execute SDA commands
$ !
$ ! process GPTE's
$ !
$ gsdidx = 0
$ open /read ptefil 'ptefil'
$ l_ggs_ptefil_nxt:
$ read /end=l_ggs_ptefil_end ptefil record
$ !
$ ! extract GPTE
$ !
$ valid = f$extract(36,1,record)
$ valid = f$integer(valid) ! convert to integer
$ if valid/2*2 .eq. valid ! if page not valid
$ then
$ gptea = %x'f$extract(9,8,record) ! gpte address from hex
$ gptx = (gptea-GPTBASE)/8 ! gpte index decimal
$ gptx = f$fao("!XL",gptx) ! convert to hex
$ pte'gsdidx = gptx ! save index
$ pagtyp'gsdidx = pagtypX ! save type
$ else
$ pte'gsdidx = f$extract(20,8,record) ! save pfn
$ pagtyp'gsdidx = pagtypW ! save type
$ endif
$ gsdidx = gsdidx+1
$ goto l_ggs_ptefil_nxt
$ !
$ ! end
$ !
$ l_ggs_ptefil_end:
$ close ptefil
$ return
$ !
$ ! find contents of GPTE in P0 page table
$ !
$ s_pt0:
$ !
$ ! get P0 page table
$ !
$ sdacmd0 = "show proc /id=''pid' /page /p0"
$ cmdmax = 1
$ def /user sdaout 'pt0fil'
$ gosub s_sda ! execute SDA commands
$ !
$ ! process P0 page table
$ !
$ recidx=0
$ open /read pt0fil 'pt0fil'
$ l_pt0_pt0fil_nxt:
$ read /end=l_pt0_pt0fil_end pt0fil record
$ recidx = recidx+1
$ if f$extract(54,4,record) .eqs. pagtypX ! if GPTX
$ then
$ pagtyp = pagtypX
$ goto l_pt0_pte
$ endif
$ if f$extract(77,6,record) .eqs. pagtypW ! if GBLWRT
$ then
$ pagtyp = pagtypW
$ goto l_pt0_pte
$ endif
$ goto l_pt0_pt0fil_nxt
$ l_pt0_pte:
$ pte = f$extract(36,8,record)
$ gsdidx = 0
$ l_pt0_ggs_nxt:
$ if gsdidx .eq. gsdhix ! if end of gs table
$ then
$ goto l_pt0_pt0fil_nxt ! next page table record
$ endif
$ if pte .nes. pte'gsdidx
$ then
$ gsdidx = gsdidx+1
$ goto l_pt0_ggs_nxt ! next table entry
$ endif
$ if pagtyp .nes. pagtyp'gsdidx
$ then
$ gsdidx = gsdidx+1
$ goto l_pt0_ggs_nxt ! next table entry
$ endif
$ !
$ ! match
$ !
$ accflg = "" ! access flag
$ if pagtyp .eqs. pagtypX ! if not page faulted
$ then
$ accflg = "*"
$ endif
$ gsftyp = gsftyp'gsdidx' ! global section file type
$ gsdnam = gsdnam'gsdidx'
$ say f$fao("!24* !1AS!1AS !AS", gsftyp, accflg, gsdnam)
$ goto l_pt0_pt0fil_nxt ! next page table record
$ !
$ ! end
$ !
$ l_pt0_pt0fil_end:
$ close pt0fil
$ purge 'pt0fil' ! leave last for debug
$ return
$ !
$ ! execute SDA commands
$ !
$ s_sda:
$ open /write sdain 'sdain'
$ write sdain "$ def /user sys$output nl:"
$ write sdain "$ def /user sys$error ''sdaerr'"
$ write sdain "$ def /user sys$command sys$input"
$ write sdain "$ ana /sys"
$ write sdain "set output /noindex sdaout"
$ cmdidx = 0
$ s_sda_cmd_nxt:
$ if cmdidx .lt. cmdmax ! if more commands
$ then
$ sdacmd = sdacmd'cmdidx'
$ write sdain "''sdacmd'"
$ cmdidx = cmdidx+1
$ goto s_sda_cmd_nxt ! next command
$ endif
$ close sdain
$ @'sdain' ! execute SDA commands
$ purge 'sdain' ! leave last for debug
$ return
$ !
$ ! string compare with wildcard
$ !
$ ! tststr = string without wildcards
$ ! wldstr = string with wildcards
$ ! wldcmp = 0 -> mismatch
$ ! wldcmp = 1 -> match
$ !
$ s_wldcmp:
$ tststrsiz = f$length(tststr)
$ wld = 0
$ tst = 0
$ rem = 0
$ l_wldcmp_nxt:
$ if f$extract(wld,1,wldstr) .eqs. "*"
$ then
$ wld = wld+1
$ rem = wld
$ else
$ if tst .eq. tststrsiz
$ then
$ wldcmp = wld .eq. f$length(wldstr)
$ return
$ else
$ if f$extract(wld,1,wldstr) .eqs. "%" -
.or. f$extract(wld,1,wldstr) .eqs. f$extract(tst,1,tststr)
$ then
$ tst = tst+1
$ wld = wld+1
$ else
$ if rem .ne. 0
$ then
$ tst = tst-(wld-rem)+1
$ wld = rem
$ else
$ wldcmp = 0
$ return
$ endif
$ endif
$ endif
$ endif
$ goto l_wldcmp_nxt
The Answer is : The most straightforward solution to your problem is to re-write your DCL procedure into an SDA Extension. This will allow you to do whatever you need, and gives you access to the SDA features you need to safely poke around in the system address space, without a single call to SYS$CMKRNL. SDA Extensions are documented in the Alpha System Analysis Tools Manual, chapter 6. This manual is available on the OpenVMS web site: start with www.openvms.digital.com, click on "Documentation" and scan the list for this manual. There is an example in SYS$EXAMPLES:MBX$SDA.C. Please also see 3635, 3530, and 3365.
|