.TITLE GPFRAG - Global Section Fragmentation Report .IDENT /X01-006/ ;++ ; Copyright (C) 1988 James F. Duff. All rights reserved. ; ; This program is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation; either version 1, or (at your option) ; any later version. ; ; This program is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with this program; if not, write to the Free Software ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ; ; The author can be contacted on the Internet at DUFF@DECUS.COM.AU. ;-- ;++ ; ; FACILITY: ; ; Management Utilities ; ; ABSTRACT: ; ; The VMS utility INSTALL has the ability to return the number of ; global pages used verses unused. However, it is possible for the ; area of memory where global sections are located to become fragmented. ; Thus it is possible to be misled by INSTALL into thinking that the ; unused pages are available to create a new section. As sections are ; contiguous, this may not be the case. ; This utility will analyze this area of memory and return the size of ; the largest block of memory available. It will also return the number ; of unused fragments. ; ; ; ENVIRONMENT: ; ; User and Kernel Modes ; ; AUTHOR: ; ; James F. Duff, 04-Mar-1988 ; ; MODIFIED BY: ; ; X01-000 Jim Duff 04-Mar-1988 ; Original version of module ; ; X01-001 Jim Duff 09-Mar-1988 ; Improve performance ; ; X01-002 Jim Duff 16-Mar-1988 ; Modify data structures. Data structure used to consist of ; one array of quadword entries with the address in the first ; longword and the size in the second. Changed to use two arrays ; of longwords one containing addresses and the other sizes. ; Implemented a quicksort algorithm to sort arrays if the array ; contains more than 50 elements. ; ; X01-003 Jim Duff 24-Mar-1988 ; Obsessed with performance, am I not? Lock down data area in ; working set if the user has the privilege. ; ; X01-004 Jim Duff 2-Jun-1988 ; Call $SETPRV to enable privileges needed. ; Lock proram in memory. ; ; X01-005 Jim Duff 30-Jun-1988 ; Count number of used sections in kernal routine instead of ; analyze routine. ; ; X01-006 Jim Duff 28-Nov-1988 ; Do some code cleanup. ;-- .SBTTL External symbol definitions ; External symbols .LINK "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH .LIBRARY /SYS$LIBRARY:LIB.MLB/ $SSDEF $GSDDEF $PHDDEF $PRVDEF $DYNDEF $SECDEF ; Macro definitions .MACRO JMPERR A=ERROR,?B BLBS R0,B JMP A B: .ENDM JMPERR .SBTTL GPF$RODATA, Read only data .PSECT GPF$RODATA QUAD,PIC,USR,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,NOVEC .ALIGN QUAD REQ_PRIV: .QUAD GSD_LISTS: .ADDRESS - EXE$GL_GSDSYSFL, - EXE$GL_GSDGRPFL, - EXE$GL_GSDDELFL .LONG 0 SYILST: .WORD 4 .WORD SYI$_GBLSECTIONS .ADDRESS - GBLSEC .LONG 0 .WORD 4 .WORD SYI$_GBLPAGES .ADDRESS - GBLPAGES .LONG 0 .LONG 0 FAOSTR: .ASCID /Frags: !SL Largest: !SL Pages used: !SL Sections used: !SL/ .SBTTL GPF$RWDATA, Read/write data .PSECT GPF$RWDATA QUAD,PIC,USR,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,NOVEC .ALIGN QUAD IOSTS: .BLKQ 1 DATA_ADR: .BLKQ 1 PROG_ADDR: .BLKQ 1 SEED: .BLKF 1 PCB_ADR:.BLKL 1 GBLSEC_TAB: .BLKL 1 GBLSEC: .BLKL 1 GBLPAGES: .BLKL 1 USED_SECT: .BLKL 1 USED_PAGES: .LONG 0 FRAG_SPACE: .LONG 0 DATA_SIZ: .BLKL 1 KRNLST: .LONG 2 .BLKL 1 .ADDRESS - USED_SECT NO_FRAG:.LONG 0 BIG_FRAG: .LONG 0 OUTSTR_D: .LONG 80 .ADDRESS - OUTSTR OUTSTR: .BLKB 80 .SBTTL GPF$CODE, Mainline code .PSECT GPF$CODE BYTE,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC .ENTRY GPFRAG,^M<> $SETPRV_S - ; Enable the privilege. ENBFLG = #1, - PRVADR = REQ_PRIV, - PRMFLG = #0 JMPERR MOVAB GPFRAG,PROG_ADDR ; Address start of code ADDL3 #PROG_LEN,PROG_ADDR, - ; Calculate end of code PROG_ADDR+4 $LCKPAG_S - ; Lock pages containing code in memory INADR=PROG_ADDR JMPERR ; Check for error $GETSYIW_S - ; Call system service to get max number ITMLST=SYILST, - ; of global sections for this boot and IOSB=IOSTS ; max number of global pages JMPERR ; Check for error MOVL IOSTS,R0 ; I/O status to R0 JMPERR ; Check for I/O error MULL3 #8,GBLSEC,DATA_SIZ ; Number of sections times 8 PUSHAL DATA_ADR ; Write the address of the memory here PUSHAL DATA_SIZ ; Requested size of memory CALLS #2,G^LIB$GET_VM ; Get memory JMPERR ; Did we get it ? ADDL3 DATA_ADR,DATA_SIZ, - ; End address of data area DATA_ADR+4 $LKWSET_S INADR=DATA_ADR ; Lock data area in working set JMPERR ; Check for errors MOVL DATA_ADR,R0 ; Address of returned memory to R0 MOVC5 #0,#0,#0,DATA_SIZ,(R0) ; Init data area to nulls MOVL DATA_ADR,KRNLST+4 ; Address of memory to arglist $CMKRNL_S - ROUTIN=SCAN_GSD_LISTS,- ; Get to kernal mode to execute this ARGLST=KRNLST JMPERR ; Successful completion ? .SBTTL SORT, sort data SORT: CMPL USED_SECT,#50 ; Do we have more than 50 elements ? BLEQ BSORT ; No, do a bubble sort MOVL DATA_ADR,R1 ; R1 points to addresses MULL3 #4,GBLSEC,R9 ; Calculate pointer for sizes... ADDL2 R1,R9 ; and store it in R9 SUBL3 #1,USED_SECT,-(SP) ; Yes, push number of elements - 1 PUSHL #0 ; Push base zero CALLS #2,QSORT ; Do a quicksort BRW ANALYZE ; Branch after quicksort to analyze BSORT: SUBL3 #1,USED_SECT,R0 ; Max number of elements in ... ; data area - 1 MOVL DATA_ADR,R1 ; Address of data area for addresses MULL3 GBLSEC,#4,R7 ; Calculate address of data area for ADDL2 R1,R7 ; sizes CLRL R2 ; Clear index variable 1$: ADDL3 #1,R2,R3 ; Add 1 to get second index variable 2$: CMPL (R1)[R2],(R1)[R3] ; Based on the two Longwords... BLEQ 3$ ; do nothing if 1st <= 2nd... MOVL (R1)[R2],R6 ; Else swap addresses... MOVL (R1)[R3],(R1)[R2] MOVL R6,(R1)[R3] MOVL (R7)[R2],R6 ; swap sizes MOVL (R7)[R3],(R7)[R2] MOVL R6,(R7)[R3] 3$: AOBLEQ R0,R3,2$ ; Inner loop AOBLSS R0,R2,1$ ; Outer loop .SBTTL ANALYZE, Analyze data ANALYZE: ;++ ; This bit of code figures if there are any fragments and the size of ; the biggest fragment. ;-- SUBL3 #1,USED_SECT,R0 ; Number of elements - 1 MOVL DATA_ADR,R1 ; Address of data area for addresses MULL3 GBLSEC,#4,R10 ; Calculate address of data area for ADDL2 R1,R10 ; sizes CLRL R2 ; Initialize first index 1$: ADDL3 #1,R2,R3 ; Add 1 to get second index ADDL3 (R1)[R2],(R10)[R2],R9 ; Add the address and size of 1st elem ADDL2 (R10)[R2],USED_PAGES ; Count pages in use CMPL R9,(R1)[R3] ; Compare the result with the 2nd elem BEQL 2$ ; If they are equal there is no frag INCL NO_FRAG ; They are not equal so inc frag count SUBL3 R9,(R1)[R3],R9 ; Subtract the two addresses ADDL2 R9,FRAG_SPACE ; Count the fragmented space CMPL R9,BIG_FRAG ; Bigger than saved biggest frag? BLEQ 2$ ; No branch MOVL R9,BIG_FRAG ; Yes so save this one 2$: AOBLSS R0,R2,1$ ; Loop ADDL2 (R10)[R3],USED_PAGES ; Add last section size to used pages SUBL3 USED_PAGES,GBLPAGES,R9 ; Calculate unused paged... SUBL2 FRAG_SPACE,R9 ; ... BEQL REPORT ; Equal to zero, branch to report INCL NO_FRAG ; Count the free space as a fragment CMPL R9,BIG_FRAG ; See if the space at the end of the ; table is larger than biggest frag BLEQ REPORT ; No branch to report MOVL R9,BIG_FRAG ; Yes .SBTTL REPORT, Write report to terminal REPORT: $FAO_S CTRSTR=FAOSTR, - ; Format the report line OUTLEN=OUTSTR_D, - OUTBUF=OUTSTR_D, - P1=NO_FRAG, - P2=BIG_FRAG, - P3=USED_PAGES, - P4=USED_SECT JMPERR ; Check for error PUSHAQ OUTSTR_D ; Push addr of output string desc CALLS #1,G^LIB$PUT_OUTPUT ; Write it out JMPERR ; Check for error $ULWSET_S INADR=DATA_ADR ; Unlock the pages we locked previously JMPERR ; Check for error PUSHAL DATA_ADR ; Address of memory PUSHAL DATA_SIZ ; Size of block CALLS #2,G^LIB$FREE_VM ; Get rid of the memory JMPERR ; Check for error EXIT: MOVZWL #SS$_NORMAL,R0 ; Indicate success ERROR: $EXIT_S R0 ; Exit with status .SBTTL SCAN_GSD_LISTS, Kernal routine to get data .ENTRY SCAN_GSD_LISTS,^M ;++ ; ; This routine scans the three lists of Global Section Descriptors (GSDs), ; using information found in the GSD data structure to locate the ; Global Page Table Entry (GPTE) contained in the system header. ; The base virtual page frame number of the global section obtained ; from the GPTE is then stored in the next available longword of the ; data area passed to this routine. The routine then determines if the ; GSD is in extended format. If it is it stores the size of the global ; section from the GSD. Else it stores the size obtained from the GPTE. ; ; This routine executes in kernal mode as it needs to lock the mutex ; that syncronizes access to the list of GSDs. ; ; WARNING: If this routine is modified, it should be first tested in ; executive mode (all the data is executive read) with the ; calls to lock the mutex commented out. If the mutex is ; locked and this routine loops, the only way to stop it is ; to use an emergency crash procedure. This is because the ; call to SCH$LOCKR raises IPL to 2 thus blocking process ; deletion. ; ;-- MOVL 4(AP),R6 ; Addr of data area to for addresses to ; R6 MULL3 #4,GBLSEC,R7 ; Addr of data area for sizes... ADDL2 R6,R7 ; to R7 MOVL R4,PCB_ADR ; Save our PCB address. R4 is loaded ; curtesy of the CMKRNL dispatcher MOVAB EXE$GL_GSDMTX,R0 ; Address of the mutex MOVL PCB_ADR,R4 ; Our PCB address JSB SCH$LOCKR ; Get lock on the mutex for read MOVL MMG$GL_SYSPHD,R0 ; Addr of system header MOVAB @PHD$L_PSTBASOFF(R0)[R0], -; This piece of obscure code gets GBLSEC_TAB ;the address of the global section table CLRL R11 ; Clear list index 1$: MOVL GSD_LISTS[R11],R10 ; Get a listhead MOVL (R10),R9 ; And the first entry on this list 2$: CMPL R9,R10 ; Is this the end of the list ? BEQL 99$ ; Yes branch INCL @8(AP) ; Count number of sections CVTWL GSD$W_GSTX(R9),R8 ; Get index into global section table, ; use CVT as we must sign extend. MOVAL @GBLSEC_TAB[R8],R8 ; Get the GSTE address PROBEW #0,#4,(R6) ; Test if the user can write to location BEQL ACCVIO ; They can't, exit with access violation EXTV #0,#22,SEC$L_VPXPFC(R8),(R6)+ ; Store PFN in data area, inc pointer CMPB GSD$B_TYPE(R9),#DYN$C_EXTGSD ; Is this an extended GSD ? BEQL 3$ ; Yes branch ADDL3 #3,SEC$L_PAGCNT(R8),R5 ; Store size from GPTE, ; add 3 for rounding BRB 4$ 3$: ADDL3 #3,GSD$L_PAGES(R9),R5 ; Store size from GSD, ; add 3 for rounding 4$: PROBEW #0,#4,(R7) ; Test if the user can write to location BEQL ACCVIO ; They can't, exit with access violation BICL3 #1,R5,(R7)+ ; Round to next highest even page and ; store in data area. Inc pointer. MOVL (R9),R9 ; Next list entry BRB 2$ ; Loop 99$: AOBLEQ #2,R11,1$ ; Branch for next list MOVAB EXE$GL_GSDMTX,R0 ; Address of mutex MOVL PCB_ADR,R4 ; Address of our PCB JSB SCH$UNLOCK ; Unlock the mutex MOVZWL #SS$_NORMAL,R0 ; Indicate normal completion RET ; Return to user mode ACCVIO: MOVAB EXE$GL_GSDMTX,R0 ; Address of mutex MOVL PCB_ADR,R4 ; Address of our PCB JSB SCH$UNLOCK ; Unlock the mutex MOVZWL #SS$_ACCVIO,R0 ; Indicate access violation RET ; Return to user mode .SBTTL RANDOM, Random number generator RANDOM: .WORD ^M 1$: EMUL SEED,#69069,#1,R2 MOVL R2,SEED EXTZV #8,#24,SEED,R0 CVTLF R0,R0 BEQL 10$ SUBW #24@7,R0 10$: RET .SBTTL QSORT, Quicksort algorithm QSORT: .WORD ^M MOVL 4(AP),R2 ; Lower limit to R2 MOVL 8(AP),R3 ; Upper limit to R3 1$: CMPL R3,R2 ; Compare upper and lower limits BGTR 2$ ; If upper > lower then continue BRW QSORT_END ; Else we have finished 2$: SUBL3 R2,R3,R0 ; Difference between upper and lower INCL R0 ; Add one to it CVTLF R0,R8 ; and convert to F_Floating CALLS #0,RANDOM ; Generate a random number MULF2 R0,R8 ; Multiply giving 0 <= R8 <= diff+1 CVTFL R8,R8 ; Convert back to longword ADDL3 R8,R2,R4 ; Add to lower limit MOVL (R1)[R3],R5 ; Partition array by the random... MOVL (R1)[R4],(R1)[R3] ; element and the upper element MOVL R5,(R1)[R4] MOVL (R9)[R3],R5 ; Synch both arrays MOVL (R9)[R4],(R9)[R3] MOVL R5,(R9)[R4] MOVL (R1)[R3],R6 ; Partition element to R6 MOVL R2,R4 ; Lower limit to R4 MOVL R3,R7 ; Upper limit to R7 BRB 14$ ; Begin WHILE loop 1 3$: BRB 5$ ; Begin WHILE loop 2 4$: DECL R7 ; DEC upper limit 5$: CMPL (R1)[R7],R6 ; Compare this element with partition BLSS 7$ ; Exit WHILE loop 2 CMPL R7,R2 ; Compare upper limit with lower BGEQ 4$ ; Complete WHILE loop 2 7$: BRB 9$ ; Begin WHILE loop 3 8$: INCL R4 ; INC lower limit 9$: CMPL (R1)[R4],R6 ; Compare this element with partition BGEQ 11$ ; Exit WHILE loop 3 CMPL R4,R3 ; Compare lower limit with upper BLEQ 8$ ; Complete WHILE loop 3 11$: CMPL R4,R7 ; Compare new upper and lower limits BGEQ 14$ ; Exit WHILE loop 1 MOVL (R1)[R7],R5 ; Swap the elements if nessarary MOVL (R1)[R4],(R1)[R7] MOVL R5,(R1)[R4] MOVL (R9)[R7],R5 ; both arrays MOVL (R9)[R4],(R9)[R7] MOVL R5,(R9)[R4] INCL R4 ; INC new lower limit DECL R7 ; DEC new upper limit 14$: CMPL R4,R7 ; Compare new upper and lower limits BLEQ 3$ ; Complete WHILE loop 1 CMPL R4,R2 ; Only two elements in partition ? BNEQ 17$ ; No branch ? MOVL (R1)[R3],R5 ; Yes Swap addresses MOVL (R1)[R2],(R1)[R3] MOVL R5,(R1)[R2] MOVL (R9)[R3],R5 ; Synch arrays by swapping sizes MOVL (R9)[R2],(R9)[R3] MOVL R5,(R9)[R2] INCL R4 ; Bump both limits... INCL R7 ; ... 17$: SUBL3 #1,R4,-(SP) ; Push new limit - 1 PUSHL R2 ; Push original lower limit CALLS #2,QSORT ; Recursive call to sort sub array PUSHL R3 ; Push original upper limit ADDL3 #1,R7,-(SP) ; Push new limit + 1 CALLS #2,QSORT ; Recursive call to sort sub array QSORT_END: RET ; Return to caller PROG_LEN = .-GPFRAG .END GPFRAG