.title PFRAG .ident 'X02-000' ;++ ; ; Facility: PFRAG - Page file fragmentation analyzer ; ; Abstract: ; This is the main routine for the PFRAG utility. This file ; also contains subroutine GETPAGNAM, which returns file names ; of page files. This program has been extensively modified ; to run on VMS V5. ; ; Author: ; Lee K. Gleason 1-SEP-1988 ; Control-G Consultants ; 2416 Branard #D ; Houston TX 77098 ; Phone 713/528-1859 ; ;-- .SBTTL PFRAG ;++ ; Functional Description: ; ; This module calls other modules to gather fragmentation ; information, then formats it attractively and displays it. ;-- .library "sys$library:lib.mlb" $pfldef ;page file control block definitions $fcbdef ;file control block definitions $wcbdef ;window control block offsets $ucbdef ;unit control block offsets $ddbdef ;driver data block offsets $lnmdef ;logical name translation definitions numholes = 16 ;number of holes to report on ;if you increase this, change ;the FAO output control string. OK? .psect frapur pic,quad,usr,con,rel,gbl,shr,noexe,rd,nowrt,novec faoctr: .ascid - ~File !AS!/Size: !10 Total Free: !10~- ~Allocation Size: !4 Holes: !10!/~- ~Minfrepagcnt !9 Rsrvpagcnt: !9~- ~Ref. Count !4 Swap Ref. Count !4!/~- ~ Sixteen Largest Holes!/~- ~-------- -------- -------- -------- ~- ~-------- -------- -------- --------!/~- ~!8UL !8UL !8UL !8UL !8UL !8UL !8UL !8UL!/~- ~!8UL !8UL !8UL !8UL !8UL !8UL !8UL !8UL!/~ perpag: .ascid /SYSEXE]PAGEFILE.SYS/ ;page file name fragment perswp: .ascid /SYSEXE]SWAPFILE.SYS/ ;swap file name fragment logtab: .ascid /LNM$FILE_DEV/ ;logical name table roolog: .ascid /SYS$SYSROOT/ ;we'll need the translation... ;...of this in getpagnam ; Item list for $TRNLNM roolst: .word 128 ;return buffer length .word lnm$_string ;return logical name translation item code .address root+8 ;address of buffer for return string .address root ;where the returned length goes .long 0 ;end of the item list data_range: ;address range to lock down for hi IPL use .long psbdat .long psbdat+psb$k_len dopfrag_range: ;address range to lock for dopfrag routine .long dopfrag .long dopfrag_end getpagnam_range: ;address range to lock for getpagnam code .long getpagnam .long getpagnam_end count_range: ;address range to lock for count code .long count .long count_end faonam: .ascid /!AD!ZW/ ;fao format string for dev+unit .psect fradat pic,quad,usr,con,rel,gbl,noshr,noexe,rd,wrt,novec root: .long 128 ;descriptor and buffer for logical name... .address .+4 ;...translation .blkb 128 tmpstr: .long 128 ;temporary for FAO .address .+4 .blkb 128 ;++ ; ; The following defined a structure that will contain information ; about a page file. This information is gathered at high IPL, while ; holding a spinlock. After return to safe, dull old user mode, IPL ; 0, we use the info returned in the block to format and display ; it. PFRAG Version 1 managed to avoid all of this complication ; by running in exec mode, IPL 0 - but SMP made that unworkable. ; ; Don't anyone tell me that I shouldn't use dollar signs in my ; definitions. I like the way my code looks with dollar signs ; in it, OK? ;__ $DEFINI psb $DEF psb$l_pagdescadr ;address of PAGDESC, for FAO to use .blkl 1 $DEF psb$l_totsiz .blkl 1 ;total size of the page file bitmap $DEF psb$l_totfre .blkl 1 ;pages free in bitmap $DEF psb$l_asiz .blkl 1 ;allocation request size $DEF psb$l_holes .blkl 1 ;number of holes $DEF psb$l_minfre .blkl 1 ;lowest free count observed $DEF psb$l_resfre .blkl 1 ;reservable free pages left $DEF psb$l_prcref .blkl 1 ;count of processes using this file $DEF psb$l_swpref .blkl 1 ;count of procs using it for swapfile $DEF psb$l_retarr .blkb numholes*4 ;longword array of hole sizes $EQU psb$s_outstr 512 ;size of output string $DEF psb$l_outdesc ;output string descriptor $DEF psb$l_outlen .blkl 1 ;length part $DEF psb$l_outadr .blkl 1 ;address part $DEF psb$l_outbuf .blkb 512 ;string part $EQU psb$s_pagstr 512 ;size of page file name $DEF psb$l_pagdesc ;page file name descriptor $DEF psb$l_paglen .blkl 1 ;length part $DEF psb$l_pagadr .blkl 1 ;address part $DEF psb$l_pagbuf .blkb 512 ;string part $EQU psb$s_devstr 128 ;size of device name string $DEF psb$l_devdesc ;device name descriptor $DEF psb$l_devlen .blkl 1 ;length part $DEF psb$l_devadr .blkl 1 ;address part $DEF psb$l_devbuf .blkb 128 ;string part $DEF psb$l_curvec .blkl 1 ;current index into file vector $DEF psb$w_unit .blkw 1 ;unit number of device $EQU psb$s_fid 6 ;size of a file id $DEF psb$w_fid .blkw 3 ;a file id $DEF psb$k_len $DEFEND psb .align quad psbarglst: ;argument list for CMKRNL call to dopfrag .long 1 .address psbdat psbdat: .blkb psb$k_len .psect fracod pic,quad,usr,con,rel,gbl,shr,exe,rd,nowrt,novec .entry pfrag,^m<> ;+ ; get xlation of SYS$SYSROOT. We'll need it to calculate ; the names of files installed before XQP is running. ;-- $trnlnm_s attr = #lnm$m_case_blind,- ;ignore case tabnam = logtab,- ;use this table lognam = roolog,- ;use this name itmlst = roolst ;use this item list blbc r0,die clrl r8 ;clear high (and low) word of r8 addw3 sgn$gw_pagfilct,sgn$gw_swpfilct,r8 ;get total # of files moval psbdat,r6 ;use r6 as a pointer movl mmg$gl_pagswpvc,psb$l_curvec(r6) ;address of a vector ;+ ; here, we lock down all code and data that will be accessed ; while our IPL is dangerously high. This could have been done ; with one call, but several made it more "modular" ;- $lkwset_s inadr = data_range blbc r0,die $lkwset_s inadr = dopfrag_range blbc r0,die $lkwset_s inadr = getpagnam_range blbc r0,die $lkwset_s inadr = count_range blbc r0,die brb goon ;go on... die: brw end ;long branch to the egress goon: moval psb$l_pagdesc(r6),psb$l_pagdescadr(r6) moval psb$l_pagbuf(r6),psb$l_pagadr(r6) ;fix up descriptors moval psb$l_outbuf(r6),psb$l_outadr(r6) moval psb$l_devbuf(r6),psb$l_devadr(r6) loop: movl #psb$s_pagstr,psb$l_paglen(r6) ;restore sizes movl #psb$s_outstr,psb$l_outlen(r6) movl #psb$s_devstr,psb$l_devlen(r6) movc5 #0,#0,#0,#numholes*4,psb$l_retarr(r6) ;zero array of holes $cmkrnl_s routin = dopfrag,- ;do work in KRNL mode arglst = psbarglst blbs r0,getnam ;if ok, let's get file name cmpl #2,r0 ;was it empty vector? bneq 1$ ;if not, real error, so exit brw incit ;empty vector, go to next one 1$: brw end ;long branch getnam: tstw psb$w_fid(r6) ;opened by conventional means? beql get_funny_name ;if not, calculate file name movl #128,tmpstr ;restore length of tmpstr $fao_s ctrstr = faonam,- ;format device name... outbuf = tmpstr,- ;...for call to getpagnam outlen = tmpstr,- p1 = psb$l_devlen(r6),- ;len of dev+control... p2 = psb$l_devadr(r6),- ;..and addr p3 = psb$w_unit(r6) ;unit number. pushal psb$l_paglen(r6) ;trim string accordingly pushal psb$l_pagdesc(r6) ;put results here pushal psb$w_fid(r6) ;this file id pushal tmpstr ;this device name calls #4,g^lib$fid_to_name ;get the name brb doout get_funny_name: movq psb$l_pagdesc(r6),r2 ;output string desc to r2/r3 movl r3,r7 ;save starting addr, to calc len movc3 root,root+8,(r3) ;translated logical name decl r3 ;backup over ] cmpw mmg$gw_minpfidx,r8 ;get lowest possible page file index # blss swp ;if r8 > min page index, it's swap file movc3 perpag,perpag+8,(r3) ;append fixed page file name brb gotfil ;then go on swp: movc3 perswp,perswp+8,(r3) ;append fixed swap file name gotfil: subl3 r7,r3,psb$l_pagdesc(r6) ;calculate final length doout: $faol_s ctrstr = faoctr,- ;format the results attractively outbuf = psb$l_outdesc(r6),- outlen = psb$l_outdesc(r6),- prmlst = psb$l_pagdescadr(r6) ;items are blbc r0,end ;how'd it go, mate? pushal psb$l_outdesc(r6) ;push addr of output string calls #1,g^lib$put_output ;and write it incit: movl #1,r0 decl r8 ;this one's done bleq end ;any left? addl #4,psb$l_curvec(r6) ;next slide, please brw loop ;and when you get to the end,... ;...you want to start all over again end: $exit_s r0 ;going to leave this brokedown palace... psbarg = 4 ;arg offset to psbdat address argument .entry dopfrag,^m lock lockname = MMG ;round and round and round we spin ;with feet of lead, and wings of tin ;(freeze mmg structures, while we look) movl psbarg(ap),r6 ;r6->psbdat block movl @psb$l_curvec(r6),r9 ;r9->current pfl cmpl r9,mmg$ar_nullpfl ;is it an unused element? bneq gotone ;if not, do your duty movl #2,r0 ;tell calling proc, it's empty vector brb endo ;head for common unlock and exit gotone: pushal psb$l_retarr(r6) ;push addr of hole array pushal #numholes ;push # of longwords in hole array pushal psb$l_totfre(r6) ;longword for total free pushal psb$l_holes(r6) ;longword for number of holes pushl pfl$l_bitmap(r9) ;address of start of bitmap pushal pfl$l_bitmapsiz(r9) ;address of length of bitmap calls #6,count ;count 'em up movzbl pfl$b_allocsiz(r9),psb$l_asiz(r6) ;get allocation size mull3 #8,pfl$l_bitmapsiz(r9),psb$l_totsiz(r6) ;get bitmap (in bytes) movl pfl$l_swprefcnt(r9),psb$l_swpref(r6) ;count of swap users movl pfl$l_refcnt(r9),psb$l_prcref(r6) ;procs using this file movl pfl$l_rsrvpagcnt(r9),psb$l_resfre(r6) ;reservable pages movl pfl$l_minfrepagcnt(r9),psb$l_minfre(r6) ;lowest it's been pushl r6 ;psbdat block addr pushl r9 ;address of current PFL calls #2,getpagnam ;get info needed to get it's name endo: unlock lockname = MMG,- ;let em go newipl = #0,- condition = RESTORE,- preserve = YES ret dopfrag_end: ;this label is for figuring address range to lock ;++ ; Routine GETPAGNAM gathers information useful for divining the ; name of the file, when we get back to user mode. ; ; 4(AP) address of the PFL block ; 8(AP) address of the psbdat block ;-- .psect fracod pic,quad,usr,con,rel,gbl,shr,exe,rd,nowrt,novec .entry getpagnam,^m movl 4(ap),r6 ;addr of the PFL block to r6 movl 8(ap),r0 ;psb addr to r0 (temp) movq psb$l_devdesc(r0),r8 ;device name desc to r8/r9 movl pfl$l_window(r6),r7 ;addr of the WCB to r7 movl wcb$l_orgucb(r7),r10 ;addr of the UCB to r10 ;++ ; ; Well, I could have acquired the DEVICELOCK before reading the UCB ; and the DDB, but, I know the info I want can't be changed, so, ; I won't bother. In like wise, I choose to read the WCB and FCB ; without acquiring the FILESYS spinlock. ; ;-- movl ucb$l_ddb(r10),r11 ;get DDB addr from UCB movl ddb$l_sb(r11),r0 ;get address of system block from ddb movzbl sb$t_nodename(r0),r1 ;get scs nodename this device movl r1,r8 ;starting len movc3 r1,sb$t_nodename+1(r0),(r9) ;copy string body cmpl r3,r9 ;anything happen here? beql 11$ ;nope, so get on with it... movb #^A/$/,(r3)+ ;append a $ sign incl r8 ;and count it 11$: movzbl ddb$t_name(r11),r0 ;get count of device type name addl r0,r8 ;add length to string movc3 r0,ddb$t_name+1(r11),(r3) ;move body of string movl 8(ap),r0 ;psb addr to r0 (temp) movl r8,psb$l_devdesc(r0) ;store new len in block movw ucb$w_unit(r10),psb$w_unit(r0) ;unit number will be needed clrl psb$w_fid(r0) ;clear out data from previous call clrw psb$w_fid+4(r0) movl wcb$l_fcb(r7),r9 ;put fcb addr in r9 beql notxqp ;if not opened by xqp, go fake it movl fcb$w_fid(r9),psb$w_fid(r0) ;store six bytes... movw fcb$w_fid+4(r9),psb$w_fid+4(r0) ;...of File id notxqp: movl #1,r0 ;call it a victory ret getpagnam_end: ;++ ; Routine COUNT is a general bitmap investigation routine, for ; bitmaps that use a 0 bit value to indicate "in use". ; ; 4(AP) addr of a longword containing length of bitmap ; 8(AP) address of the bitmap ; 12(AP) address of longword to receive # of holes found ; 16(AP) address of longword to receive total # of free items ; 20(AP) address of longword size of array to contain top N hole sizes ; 24(AP) address of top N hole array ;-- .psect fracod pic,quad,usr,con,rel,gbl,shr,exe,rd,nowrt,novec .entry count,^m movl 8(ap),r0 ;starting address to r0 mull3 #8,@4(ap),r1 ;count of bits in bitmap clrl r3 ;clear pointer to bit field start reg clrl r9 ;clear current lowest max clrl @12(ap) ;clear number of holes found clrl @16(ap) ;clear total free count subl3 #1,@20(ap),r4 ;size of return array, less one... ;...to offset to last element movl 24(ap),r5 ;addr of return array moval (r5)[r4],r10 ;addr of one byte past array ; find the beginning of a hole find_free: cmpl r1,r3 ;compare # of bits total to # of bits checked... bleq done ;and get out if it's all over ffs r3,#32,(r0),r3 ;find beginning of a hole (bit set = unused) beql find_free ;keep looking incl @12(ap) ;count a hole movl r3,r2 ;save its start in r2 ; find the end of a hole, counting bits as we go find_alloc: cmpl r1,r3 ;are we done yet? bleq 1$ ;if so, get the hell out ffc r3,#32,(r0),r3 ;find end of hole beql find_alloc ;keep looking 1$: subl3 r2,r3,r2 ;get the length addl r2,@16(ap) ;how many, altogether cmpl r2,r9 ;is this one big enough to put in top array? bleq find_free ;nope movl r5,r8 ;copy array address to r8 movl r10,r6 ;copy of addr of last elem in array to r6 movl r4,r7 ;size of return array (less 1) to r7 bneq check ;is the return array only one longword? ;no, so see where this one fits in array cmpl r2,(r8) ;this hole bigger than one we already have? blss endin ;if so, go insert it brb find_free ;else get back to work check: cmpl r2,(r8) ;this element? blss next ;else get next 1$: movl -(r6),4(r6) ;copy an item down one position sobgeq r7,1$ ;done all array entries yet? movl r2,(r8) ;if so, this must be the place brb endin next: tstl (r8)+ ;advance one element sobgtr r7,check ;if not at end, do it again endin: movl (r10),r9 ;save current lowest brb find_free ;start looking for holes again done: movl #1,r0 ;return success... ret ;and get back count_end: .end pfrag