$! GET_GLOBALS11.COM $! $! Creation Date: 24-DEC-1990 $! $! Author: Dave Gordon $! $! Functional Description: Used to compile, assemble, and link $! the GET_GLOBALS program. $! $! How to use it: $! $ @GET_GLOBALS11 $! $MACRO GET_GLOBALS11 $FORTRAN TGET_GLOBALS6 $LINK/exe=tget_globals11 TGET_GLOBALS6,GET_GLOBALS11 ; GET_GLOBALS11 (November 28, 1990) ; ; Just added comments and neatened up. ; ; ; I attempted (October 10, 1990) to use LOCK_SYSTEM_PAGES and ; UNLOCK_SYSTEM_PAGES, but the later caused a fatal bugcheck ; 'not a system virtual address'. The reason is that the pages ; were indeed in the process' private P0 address space. I guess ; to lock these into memory, either $LCK... must be used or else ; the poor man's lockdown can be used. I am using the latter. ; I don't see why it works, though, since the pager can still run on ; a different CPU and conceivably could kick pages out of this process' ; working set. However, Jamie says it works in September DECUS SIG newsletter, ; p. VAX-3. ; ; GET_GLOBALS10 (Sept 27, 1990) ; ; The advance in this version is to check the window bit of valid pte's ; so as to not get an access violation with programs that map to IO space ; by pfn (such as DECW$SERVER) ; ; GET_GLOBALS9 (June 19, 1990) ; ; The advance in this version is to not use flo:habitat.mlb, but include ; any needed macros directly in this file. Also, pagesetting the fortran ; program is not necessary. ; ; GET_GLOBALS8 ; The significant advance of this version is that it sets an overflow flag if ; the maximum number of global sections is exceeded. ; This version (get_globals8) has been tested with different versions of the ; maximum. .TITLE GET_ALL_GLOBALS_FROM_PROCESS .IDENT /V03-00/ .LIBRARY /SYS$LIBRARY:LIB/ ; ; INPUTS: 04(AP) - EPID OF TARGET PROCESS ; ; OUTPUTS: a list of global sections put into a common called ; KERNEL_USER_LINK. Its structure is defined below. ; The calling procedure can access it by declaring ; an identical common. ; ; PURPOSE: Find all global sections mapped by a target process. ; ; ; OVERVIEW: ; ; Origin Process Target Process ; -------------- -------------- ; ; ; Changes to kernel mode ; ; Allocates a big chunk ; of non-paged pool ; ; Queues special kernel ; mode ast to target process ; ; Returns to user mode ; and hibernates ; Target process ; runs this code ; which looks for ; all its global ; sections and ; writes them into ; the nonpaged pool ; ; Queues special kernel ; mode ast back to origin ; process ; ; Origin process runs the ; ast which copies the data ; from the nonpaged pool to ; the origin, wakes up the ; origin process from hibernation, ; deallocates the nonpaged pool, ; and terminates ; ; ; ; ; ; ; ; ; ; The nonpaged pool looks like: ; ; ACB--used to queue the both asts (origin to ; target, and target back to origin) ; ; ACB_L_ORIGPID--used so that target process ; knows which process to send an ast back to ; ; ACB_L_IMGCNT--used to make sure that when the 2nd ; ast arrives back at the origin process, the origin ; process is still expecting it (isn't running something ; else) ; ; ACB_L_RETADR--address in origin process to put the ; final data ; ; all of the data about the global sections mapped by ; the target process ; ; the code to be run in the origin to target ast ; ; the code to be run in the target to origin ast ; ; ; ; ARGUMENT OFFSETS FROM AP ; $offset 4,, <- < EPID >,- > .MACRO VARIABLE NAME,LENGTH=4,TYPE=8,REPEAT .SAVE ABSOLUTE L.'NAME=LENGTH T.'NAME=TYPE .RESTORE .IF EQUAL TYPE-14 .IF BLANK REPEAT NAME: .BLKB LENGTH .IF_FALSE NAME: .BLKB REPEAT*LENGTH .ENDC .IF_FALSE .IF BLANK REPEAT .IIF EQUAL LENGTH-1, NAME: .BLKB 1 .IIF EQUAL LENGTH-2, NAME: .BLKW 1 .IIF EQUAL LENGTH-4, NAME: .BLKL 1 .IIF EQUAL LENGTH-8, NAME: .BLKQ 1 .IIF EQUAL LENGTH-16, NAME: .BLKQ 2 .IF_FALSE .IIF EQUAL LENGTH-1, NAME: .BLKB REPEAT .IIF EQUAL LENGTH-2, NAME: .BLKW REPEAT .IIF EQUAL LENGTH-4, NAME: .BLKL REPEAT .IIF EQUAL LENGTH-8, NAME: .BLKQ REPEAT .IIF EQUAL LENGTH-16, NAME: .BLKQ 2*REPEAT .ENDC .ENDC .ENDM VARIABLE .MACRO INTEGER NAME,LENGTH=4,REPEAT .IIF EQUAL LENGTH-1, VARIABLE NAME,LENGTH,2,REPEAT .IIF EQUAL LENGTH-2, VARIABLE NAME,LENGTH,7,REPEAT .IIF EQUAL LENGTH-4, VARIABLE NAME,LENGTH,8,REPEAT .IIF EQUAL LENGTH-8, VARIABLE NAME,LENGTH,9,REPEAT .ENDM INTEGER .MACRO STRING NAME,LENGTH,REPEAT VARIABLE NAME,LENGTH,14,REPEAT .ENDM STRING .MACRO READ_ONLY_DATA NAME=HABITAT_DATA_R .PSECT NAME,PIC,CON,REL,LCL,SHR,NOEXE,RD,NOWRT,LONG .ENDM READ_ONLY_DATA .MACRO READ_WRITE_DATA NAME=HABITAT_DATA_RW .PSECT NAME,PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG .ENDM READ_WRITE_DATA .MACRO EXECUTABLE_CODE NAME=HABITAT_CODE .PSECT NAME,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG .ENDM EXECUTABLE_CODE .MACRO COMMON_BLOCK NAME .IF EQUAL %LOCATE(<$>,NAME)-%LENGTH(NAME) .PSECT NAME,PIC,OVR,REL,GBL,NOSHR,NOEXE,RD,WRT,PAGE .IF_FALSE .PSECT NAME,PIC,OVR,REL,GBL,NOSHR,NOEXE,RD,WRT,LONG .ENDC .ENDM COMMON_BLOCK .MACRO SHARED_COMMON NAME=BLANK .PSECT SHR$'NAME,PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT,PAGE .ENDM SHARED_COMMON .MACRO ABSOLUTE .PSECT HABITAT_ABS,NOPIC,USR,CON,ABS,LCL,NOSHR,NOEXE,NORD,NOWRT,BYTE .=0 .ENDM ABSOLUTE .MACRO LITERAL .PSECT LITERAL_POOL,PIC,CON,REL,LCL,SHR,RD,NOWRT,NOEXE,LONG .ENDM LITERAL .MACRO GS_COMMON NAME .PSECT NAME,PIC,OVR,REL,GBL,NOSHR,NOEXE,RD,WRT,PAGE .ENDM GS_COMMON .MACRO FORTRAN_COMMON NAME .PSECT NAME,PIC,OVR,REL,GBL,SHR,NOEXE,RD,WRT .ENDM FORTRAN_COMMON ; CONNECTION BETWEEN KERNEL MODE AND USER MODE CODE ; ; This is the common block which is used to communicate the list of ; global sections back to the calling procedure. ; MAX_NUM_GSDNAMS = 200 ; the maximum number of global ; sections that the data structures ; can handle FORTRAN_COMMON KERNEL_USER_LINK KERNEL_USER_LINK_BEGIN: INTEGER KU_PP0BR, 4, 1 INTEGER KU_MAX_ARRAY_LENGTH, 4, 1 INTEGER KU_ARRAY_LENGTH, 4, 1 INTEGER KU_VGBL_PTE_ADDR, 4, MAX_NUM_GSDNAMS STRING KU_GSDNAM_ARRAY, 45, MAX_NUM_GSDNAMS STRING KU_PTE_TYPE, 4, MAX_NUM_GSDNAMS INTEGER KU_FOR_DEBUG1, 4, 1 INTEGER KU_FOR_DEBUG2, 4, 1 INTEGER KU_FOR_DEBUG3, 4, 1 INTEGER KU_FOR_DEBUG4, 4, 1 INTEGER KU_FOR_DEBUG5, 4, 1 INTEGER KU_FOR_DEBUG6, 4, 1 INTEGER KU_FOR_DEBUG7, 4, 1 INTEGER KU_FOR_DEBUG8, 4, 1 INTEGER KU_FOR_DEBUG9, 4, 1 STRING KU_OVERFLOW_GSDNAMS, 1, 1 KERNEL_USER_LINK_LENGTH = .-KERNEL_USER_LINK_BEGIN ; VMS MACROS AND ROUTINES .DISABLE GLOBAL .LINK \SYS$SYSTEM:SYS.STB\ /SELECTIVE_SEARCH $PCBDEF $PHDDEF $IPLDEF $PRDEF $SSDEF $ACBDEF $PRIDEF $STATEDEF $GSDDEF $PFNDEF $PTEDEF .EXTERNAL CTL$GL_PHD ; a process can find its header ; using this address .EXTERNAL EXE$ALLOCBUF ; routine to allocate nonpaged ; pool .EXTERNAL EXE$DEANONPAGED ; routine to deallocate ; nonpaged pool .EXTERNAL EXE$EPID_TO_IPID ; routine to convert an ; external (cluster unique) ; pid to an internal pid .EXTERNAL MMG$GL_GPTBASE ; contains address of base of ; global page table .EXTERNAL MMG$GL_SYSPHD ; contains address of the ; system process header .EXTERNAL PFN$AB_STATE ; contains address of the pfn ; state array .EXTERNAL PFN$AB_TYPE .EXTERNAL PFN$AL_BAK .EXTERNAL SCH$CHSEP .EXTERNAL SCH$GL_MAXPIX .EXTERNAL SCH$GL_PCBVEC .EXTERNAL SCH$GL_SWPPID .EXTERNAL SCH$QAST .EXTERNAL SCH$WAKE ; ; OUR CUSTOM AST CONTROL BLOCK WHICH WILL HOLD A HUGE AMOUNT OF DATA ; AND CODE ; ; Extensions to the standard ACB ; $DEFINI ACB,,ACB$K_LENGTH $EQU ACB_L_ORIGPID ACB$L_AST ; original pid of requestor $DEF ACB_L_IMGCNT .BLKL ; image execution count of ; requestor $DEF ACB_L_RETADR .BLKL ; address to write returned ; data to $DEF ACB_C_SIZE ; size of fixed portion of ACB ; extension $DEF ACB_START_OF_DATA_TO_RETURN ; start of data to be gathered ; from the remote process by ; first skast and returned to ; original process by the 2nd ; skast $DEF ACB_PP0BR .BLKL $DEF ACB_MAX_ARRAY_LENGTH .BLKL $DEF ACB_ARRAY_LENGTH .BLKL $DEF ACB_VGBL_PTE_ADDR .BLKL MAX_NUM_GSDNAMS $DEF ACB_GSDNAM_ARRAY .BLKB <45 * MAX_NUM_GSDNAMS> $DEF ACB_PTE_TYPE .BLKL MAX_NUM_GSDNAMS $DEF ACB_FOR_DEBUG1 .BLKL $DEF ACB_FOR_DEBUG2 .BLKL $DEF ACB_FOR_DEBUG3 .BLKL $DEF ACB_FOR_DEBUG4 .BLKL $DEF ACB_FOR_DEBUG5 .BLKL $DEF ACB_FOR_DEBUG6 .BLKL $DEF ACB_FOR_DEBUG7 .BLKL $DEF ACB_FOR_DEBUG8 .BLKL $DEF ACB_FOR_DEBUG9 .BLKL $DEF ACB_OVERFLOW_GSDNAMS .BLKB $DEF ACB_END_OF_DATA_TO_RETURN ACB_SIZE_OF_DATA_TO_RETURN = ACB_END_OF_DATA_TO_RETURN - - ACB_START_OF_DATA_TO_RETURN ; below are a few temporary fields ; used by the 1st skast in gathering ; the information to return. The ; fields below do not need to be ; returned (they are, but are not ; copied to the original process' ; P0 space). $DEF ACB_LOC_STATE .BLKB ; state of a physical page containing ; the global page (F, M, or P for ; on free page list, modified page ; list, or release pending list) $DEF ACB_PPTE_TYPE .BLKL ; type of the pte currently being ; examined (e.g., PVAL, PTRF, GSTX,etc) $DEF ACB_BEGINNING_OF_ACB_CODE ; AST code follows data $DEFEND ACB ; the rest of the nonpaged pool is occupied by the ast code, starting ; with ORIGIN_TO_TARGET_AST_CODE: and of length AST_CODE_LENGTH ; TYPES OF GLOBAL PAGES PVAL = ^A/PVAL/ ; process pte is valid and points to a global page ; ; The process pte looks like this: ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|1 | 1 1 1 1 |0 |--| 1 1 |--| 0| 002B0D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Vld Prot= UR M Own=U W Page Frame Number ; ; Page is Active and Valid GVAL = ^A/GVAL/ ; process pte is invalid, but points to a valid ; global page table entry ;The process pte looks like this: ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|0 | 1 1 1 1 |0 |--| 1 1 | 1| 0A998D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Inv Prot= UR T1 Own=U T0 Global Page Table Index ; ; Page is an Invalid Global Page ; ; ;While the global page table pte looks like this: ; ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|1 | 0 0 0 0 |0 |--| 1 1 |--| 0| 002B0D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Vld Prot= NA M Own=U W Page Frame Number ; ; Page is Active and Valid ; GSTX = ^A/GSTX/ ; process pte is invalid, and so is the global page ; table pte, which points to the gstx ; ; ;The process pte looks like this: ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|0 | 1 1 1 1 |0 |--| 1 1 | 1| 0A998D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Inv Prot= UR T1 Own=U T0 Global Page Table Index ; ; Page is an Invalid Global Page ; ; ;and the global page table looks like this: ; ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|0 | 0 0 0 0 |1 |--| 1 1 | 1|--|--|--| 1| 0| 0| A0A0 ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Inv Prot= NA T1 Own=U T0 WRT DZ CRF Process Section Table Index ; (SDA says this, but really ; this is the global section ; table index) ; ; Page is in an Image File (SDA says this, but really the page is in ; the global section disk file) ; ; ; The process pte can be invalid pointing to the global page table pte ; which can be itself in transition: GTRN = ^A/GTR / ; last letter will be filled in by one of the letters ; F, M, or P by CHECK_STATE_OF_TRANSITION_PAGE GTRF = ^A/GTRF/ ; global page table pte is in transition, and points to ; a physical page on the free page list GTRM = ^A/GTRM/ ; global page table pte is in transition, and points to ; a physical page on the modified page list GTRP = ^A/GTRP/ ; global page table pte is in transition, and points to ; a physical page that it marked for release pending ; ; The process pte looks like this: ; ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|0 | 1 1 1 1 |0 |--| 1 1 | 1| 0A998D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Inv Prot= UR T1 Own=U T0 Global Page Table Index ; ; Page is an Invalid Global Page ; ; ; and the global page table pte looks like this: ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|0 | 0 0 0 0 |0 |--| 1 1 | 0|--| 002B0D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Inv Prot= NA T1 Own=U T0 Page Frame Number ; ; Page is in Transition ; ; ; USER MODE ROUTINE .PSECT _GLOBALS_CODE PIC,CON,REL,SHR,LCL,EXE,RD,NOWRT,LONG .ENTRY GET_ALL_GLOBALS_FROM_PROCESS ^M MOVL #SS$_INSFARG,R0 ; assume insufficient args CMPB (AP),#1 ; have we 1 args at least? BLSSU 10$ $CMKRNL_S KERNEL_MODE_CODE,(AP) ; must be in kernel mode to send ; kernel mode ASTs BLBC R0,10$ ; If anything goes wrong in sending ; the skast, do not hibernate $HIBER_S ; Hibernate until the 2nd skast comes ; back to origin process and wakes it ; up. 10$: RET KERNEL_MODE_CODE: .WORD 0 MOVL R4,R6 ; save pcb address in R6 MOVL #ACB_BEGINNING_OF_ACB_CODE+AST_CODE_LENGTH,R1 ; find out how much ; nonpaged pool we need for the ACB, ; our custom data extention (which will ; contain all the global section ; names), and all the code for both ; special kernel mode asts. ; ; Allocate a block of nonpaged pool. ; Input: R1, size of the block ; R4, PCB address of process requesting the pool ; Outputs: ; R0, status ; R1, size of requested buffer ; R2, address of allocated buffer ; R3, destroyed ; JSB @#EXE$ALLOCBUF BLBS R0,22$ ; If error getting nonpaged pool, leave ; kernel mode with error in R0 RET ; leave kernel mode--could not get ; the memory we need for the skast 22$: MOVL R2,R5 ; save ACB address in R5 MOVB #1@ACB$V_KAST,ACB$B_RMOD(R5) ; Tell VMS this is a special kernel ; mode AST MOVAB ACB_BEGINNING_OF_ACB_CODE(R5),- ACB$L_KAST(R5) ; Tell VMS the address of the code for ; the first skast MOVAL KERNEL_USER_LINK_BEGIN,ACB_L_RETADR(R5) ; This tells 2nd ast where ; to copy the data to in the ; address space of the origin ; process. MOVL @#CTL$GL_PHD,R0 MOVL PHD$L_IMGCNT(R0),- ; When the 2nd skast returns ACB_L_IMGCNT(R5) ; to us, it should check that ; we haven't ^Y'd out and are ; running something else before ; it starts running. MOVL PCB$L_PID(R6),ACB_L_ORIGPID(R5) ; The first skast needs to know ; where to send the 2nd skast. ; This is the source process ; internal pid. PUSHL R5 ; Copy all the code for both MOVC3 #AST_CODE_LENGTH,W^ORIGIN_TO_TARGET_AST_CODE,@ACB$L_KAST(R5) ; the first and 2nd skast's. POPL R5 ; Now translate the external pid to the internal pid, which is needed to ; queue the kast. MOVL @EPID(AP),R0 ; R0 contains extended pid MOVL R0,R9 ; save the extended pid JSB G^EXE$EPID_TO_IPID ; warning--this routine will ; not know whether the epid ; is valid or not. Thus we ; need to check that ourselves. MOVL R0,R7 ; Save the returned IPID MOVZWL R0,R0 ; get just the index into ; the PCBVEC ; Now let's check to see that the returned IPID is valid and ; refers to the process with EPID. While we do this, lock out ; scheduler--do not let it run (on ANY cpu) until we have queued ; the skast to that process. That way the process won't be ; allowed to be deleted until it has received our skast. Since ; we are raising IPL, we cannot get pagefaults. So use the ; trick of locking code into memory by the IPL value being ; specified at the end of the code to lock into memory. 25$: LOCK LOCKNAME=SCHED,- LOCKIPL=120$,- PRESERVE=YES CMPW R0,G^SCH$GL_MAXPIX ; is index greater than the ; maximum possible? BGTR 90$ ; Yes, bad epid passed MOVL @L^SCH$GL_PCBVEC[R0],R8 ; R8 now contains PCB address of the ; target process CMPL R7,PCB$L_PID(R8) ; check that this PCB has ; the same ipid that ; exe$epid_to_ipid gave us BNEQ 90$ ; bad epid passed to this routine CMPL R9,PCB$L_EPID(R8) ; compare the actual epid's BNEQ 90$ ; bad epid passed to this routine ; if got here, epid passed to us is good ; If the target process is being deleted, being suspended, ; is currently suspended, or is MWAIT state, don't bother ; sending a skast to it. (Note: This is a hole in this ; utility--if a process maps to a global section and then ; is suspended or goes into an MWAIT state, we won't know ; it is mapped to that global section.) BBS #PCB$V_DELPEN,PCB$L_STS(R8),90$ BBS #PCB$V_SUSPEN,PCB$L_STS(R8),80$ CMPW #SCH$C_SUSP,PCB$W_STATE(R8) BEQLU 80$ CMPW #SCH$C_MWAIT,PCB$W_STATE(R8) BEQLU 80$ MOVL R7,ACB$L_PID(R5) ; this is the ipid that we went to ; all the work above to find MOVZBL #PRI$_TICOM,R2 ; ; Queue the special kernel mode ast!!!! ; ; Inputs: R2, the priority increment class ; R5, a pointer to the AST control block ; Outputs: ; R0, completion code ; R4, PCB address of the process for which the AST was queued JSB @#SCH$QAST ; If the target process is computable, then boost its priority to that ; of the source process. But don't boost the priority into realtime range. CMPW #SCH$C_COM,PCB$W_STATE(R4) BNEQU 70$ MOVB PCB$B_PRI(R6),R0 CMPB R0,PCB$B_PRI(R4) BGEQU 70$ CMPB #16,R0 BGTRU 70$ JSB @#SCH$CHSEP 70$: UNLOCK LOCKNAME=SCHED,- ; unlock--mainly to lower IPL to that NEWIPL=#IPL$_ASTDEL,- ; of the AST delivery code. It seems PRESERVE=YES ; to me that this leaves a small hole ; in which the process could be deleted ; while the AST was being queued to it. MOVZWL #SS$_NORMAL,R0 RET 80$: MOVZWL #SS$_SUSPENDED,-(SP) BRB 100$ 90$: MOVZWL #SS$_NONEXPR,-(SP) 100$: UNLOCK LOCKNAME=SCHED,- NEWIPL=#IPL$_ASTDEL,- PRESERVE=NO MOVL R5,R0 ; ; Deallocate the nonpaged pool. ; ; Inputs: R0, the address of the block to deallocate ; Destroys: R3 ; Outputs: none ; JSB @#EXE$DEANONPAGED SETIPL #0 POPL R0 RET 120$: .BYTE IPL$_SYNCH ; To prevent page faulting at elevated IPL, the distance between where IPL is ; elevated and the reference to 120$ must be a page or less. Otherwise some code ; in between could still be not paged in and thus could cause a page fault. ASSUME <.-25$> LE 512 ; ; Origin to target AST code ; ; ; ; Inputs (supplied by VMS ast delivery code): ; R4, PCB address (of process executing the ast) ; R5, ACB address ; ORIGIN_TO_TARGET_AST_CODE: CALLS #0,GET_GLOBAL_SECTIONS 10$: MOVL ACB_L_ORIGPID(R5),ACB$L_PID(R5) MOVB #1@ACB$V_KAST,ACB$B_RMOD(R5) MOVAB B^TARGET_TO_ORIGIN_AST,ACB$L_KAST(R5) MOVZBL #PRI$_TICOM,R2 JMP @#SCH$QAST ; ; Target to origin AST code ; ; Purpose: copies the global section information from the ; ACB extension to the origin process's local ; memory ; ; Inputs (supplied by VMS ast delivery code): ; R4, PCB address (of process executing the ast) ; R5, ACB address ; TARGET_TO_ORIGIN_AST: MOVL @#CTL$GL_PHD,R3 CMPL PHD$L_IMGCNT(R3),- ACB_L_IMGCNT(R5) BNEQU 40$ PUSHL R5 MOVC3 #ACB_SIZE_OF_DATA_TO_RETURN,ACB_START_OF_DATA_TO_RETURN(R5),- @ACB_L_RETADR(R5) POPL R5 30$: MOVL ACB$L_PID(R5),R1 SETIPL #IPL$_SYNCH,UNIPROCESSOR JSB @#SCH$WAKE SETIPL #IPL$_ASTDEL,UNIPROCESSOR 40$: MOVL R5,R0 JMP @#EXE$DEANONPAGED ; ; GET_GLOBAL_SECTIONS ; ; ; More Origin to target AST code ; This is the code that finds all global sections this process is mapped ; to and copies them to the fields in the ACB extension. ; ; Inputs: ; R4, PCB address (of process executing the ast) ; R5, ACB address ; .entry GET_GLOBAL_SECTIONS,^M MOVL R5,R7 ; R7 will henceforth be the ACB address MOVL PCB$L_PHD(R4),R5 ; r5 now contains the address of the PHD MOVL PHD$L_P0LRASTL(R5),R6 EXTZV #PHD$V_P0LR,#PHD$S_P0LR,R6,R6 ; r6 now contains the length of the P0 ; page table (in entries) MOVL PHD$L_P0BR(R5),R5 ; P0BR is now in R5 MOVL R5,ACB_PP0BR(R7) ; save the address of the page table MULL2 #4,R6 ; R6 now is the size of the P0 page table in ; bytes ADDL2 R5,R6 ; R6 now contains the 1st address after the ; P0 page table--We will use this to ; determine when we have reached the end of ; the P0 page table. CLRL ACB_ARRAY_LENGTH(R7) ; start with no global sections found MOVB #^A/N/,ACB_OVERFLOW_GSDNAMS(R7) ; start with no overflow CHECK_PTE: JSB G^CHECK_IF_VALID_GLOBAL BLBS R0,FOUND_VALID_GLOBAL JSB G^CHECK_IF_INVALID_GLOBAL BLBS R0,FOUND_INVALID_GLOBAL GET_NEXT_PTE: ADDL #4,R5 ; find next pte CMPL R5,R6 ; is this the end of the page table? BLSS CHECK_PTE ; No, check this pte GO_HOME: MOVL #1,R0 ; indicate success RET ; found a valid global page FOUND_VALID_GLOBAL: PUSHR #^M ; put pfn and svapte onto stack CALLS #2,G^PFN_TO_GSDNAM BRW GET_NEXT_PTE ; found an invalid process pte that maps a global page FOUND_INVALID_GLOBAL: PUSHR #^M CALLS #1,G^SAVE_GSDNAM_OF_INVALID_GLOBAL BRW GET_NEXT_PTE ; Purpose: A process pte is found to be pointing to the global ; page table. Sort through the many different forms ; of gpte's, taking those that refer to disk file ; global sections. Of those, find the global section ; names and write them to an array. ; Input: 4(AP), the address of the process pte (by value) ; R7, ACB address ; Output: R0 will indicate whether this routine was successful ; in finding a global page we are interested in. SAVE_GSDNAM_OF_INVALID_GLOBAL: .WORD ^M MOVL 4(AP),R5 ; R5 contains the svapte BICL3 #^C,(R5),R0 ; R0 contains the global ; page table index MOVL G^MMG$GL_GPTBASE,R1 MOVAL (R1)[R0],R3 ; R3 contains the global ; page table entry address ; MOVAL @L^MMG$GL_GPTBASE[R0],R3 ; R3 contains the global ; page table entry address ; Unfortunately, there are many possibilities for the gpte. ; 1) It might be a valid pte in which case it will contain the pfn ; 2) It might be a page-file global section pte (several forms) ; 3) It might be a pte of a disk-file global section, in which ; case it would contain the gstx (global section table index). ; 4) It might be a global pte in transition (the pte is invalid but ; still contains the pfn) ; 5) It might be a demand-zero page. ; ; We are only interested in possibilites 1, 3, and 4. BICL3 #^C, (R3), R0 BLSS GBLVALID ; bit 31 is set so page is of case 1 BEQL NOT_INTERESTED ; the page of of case 5 EXTV #PTE$V_TYP0,#, R0, R1 ; In other words, make a sign-extended ; longword out of 2 bits--typ1 and typ0 ; R1 = 0 means page is in transition (note that due to a check ; above, the pte$m_bakx bits are not zero. In fact, they ; contain the pfn) ; R1 = negative. typ1 is set. This gives 2 possibilities: ; typ0 0 means page file global section ; typ0 1 means disk file global section ; R1 positive, error BGTR NOT_INTERESTED BEQL GLOBAL_TRANSITION ; if we reached here, typ1 is set. Check typ0 BLBS R1, DISK_FILE_SECTION NOT_INTERESTED: CLRL R0 RET ; ;and the global page table looks like this: ; ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|0 | 0 0 0 0 |1 |--| 1 1 | 1|--|--|--| 1| 0| 0| A0A0 ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Inv Prot= NA T1 Own=U T0 WRT DZ CRF Process Section Table Index ; (SDA says this, but really ; this is the global section ; table index) ; ; Page is in an Image File (SDA says this, but really the page is in ; the global section disk file) ; ; DISK_FILE_SECTION: MOVL #GSTX, ACB_PPTE_TYPE(R7) ; record what type of pte BICL3 #^C,(R3),R3 ; get the gstx PUSHR #^M ; save the gstx and svapte CALLS #2, G^GSTX_TO_GSDNAM ; returns R0 RET ;The situation below has global page table pte looking like this: ; ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|1 | 0 0 0 0 |0 |--| 1 1 |--| 0| 002B0D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Vld Prot= NA M Own=U W Page Frame Number ; ; Page is Active and Valid ; GBLVALID: MOVL #GVAL, ACB_PPTE_TYPE(R7) ; record the pte type BICL3 #^C,(R3),R3 ; get pfn PUSHR #^M ; save pfn and svapte CALLS #2,PFN_TO_GSDNAM RET ; The situation below has global page table pte looking like this: ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|0 | 0 0 0 0 |0 |--| 1 1 | 0|--| 002B0D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Inv Prot= NA T1 Own=U T0 Page Frame Number ; ; Page is in Transition ; ; GLOBAL_TRANSITION: BICL3 #^C,(R3),R3 ; get the pfn ; To be safe, let's only consider transition global pages that are ; 1) on free list ; 2) on modified page list ; 3) release pending ; Let's not consider pages that are on bad page list, read in progress, write ; in progress, etc. JSB G^CHECK_STATE_OF_TRANSITION_PAGE BLBS R0,INTERESTED_TRANSITION_TYPE RET ; R0 is already set to 0 INTERESTED_TRANSITION_TYPE: MOVL #GTRN,ACB_PPTE_TYPE(R7) ; record pte type MOVB ACB_LOC_STATE(R7),(R7) ; set letter indicating transition type PUSHR #^M CALLS #2,G^PFN_TO_GSDNAM RET ; Purpose: takes the pfn of a physical page that contains a ; global page and finds the global section name of ; that page and stores it in an array ; Inputs: 4(AP), pfn ; 8(AP), svapte (the addresss of the process pte ; that maps this global page) ; R7, ACB address PFN_TO_GSDNAM: .WORD ^M MOVL 8(AP), R5 ; the svapte MOVL 4(AP), R3 ; pfn JSB G^CHECK_THAT_PFN_TYPE_IS_GLOBAL BLBS R0, REALLY_GLOBAL_PAGE RET ; problem--not a global page REALLY_GLOBAL_PAGE: MOVL G^PFN$AL_BAK,R2 MOVL (R2)[R3],R1 ; get BAK array element, which should ; contain global section table index ; (unless it is a page-file global section) EXTZV #22,#<31-22+1>,R1,R0 ; get bits 22 to 31 CMPL #1,R0 BEQL DISK_FILE_GLOBAL_SECTION CLRL R0 ; must be a page-file global section RET DISK_FILE_GLOBAL_SECTION: BICL3 #^C^X0000FFFF,R1,R3 ; R3 now should contain the negative ; global section table index ; (see Fig. 14-10, p. 340 in Black ; Book) PUSHR #^M CALLS #2, GSTX_TO_GSDNAM ; get global section name RET ; Purpose: gstx -> gsdnam ; Uses the global section table index and gets ; the global section name ; Inputs: 4(AP), gstx (directly onto stack, by value) ; 8(AP), svapte (also by value) ; The address of the process pte that maps ; this page of the global section ; R7, ACB address GSTX_TO_GSDNAM: .WORD ^M MOVL 8(AP), R5 ; get svapte MOVL 4(AP), R1 ; get global section table index BISL2 #^XFFFF0000,R1 ; make it negative MOVL G^MMG$GL_SYSPHD,R2 ; get the system header ADDL3 PHD$L_PSTBASOFF(R2),R2,R2 ; R2 now contains the base of the ; global section table MOVAL (R2)[R1],R0 ; R0 is the address of the global ; section table entry MOVL (R0),R0 ; now R0 contains the address of ; the global section descriptor MOVAL GSD$T_GSDNAM(R0),R2 ; R2 is now the address of the the ; counted global section name PUSHR #^M CALLS #2,G^MOVE_GSDNAM_TO_ARRAY MOVL #-1,R0 RET ; Purpose: Moves the global section name into an array so they can ; be displayed by a user-mode routine ; ; Inputs: 4(AP), the address of the counted string global section name ; 8(AP), the svapte, the address of the process pte that maps ; this page of the global section ; R7, ACB address MOVE_GSDNAM_TO_ARRAY: .WORD ^M CMPL ACB_ARRAY_LENGTH(R7),#MAX_NUM_GSDNAMS BLSS MORE_ROOM ; There is no room to put this gsdnam into the gsdnam array. Set the ; overflow flag. (It may be set already.) MOVB #^A/Y/,ACB_OVERFLOW_GSDNAMS(R7) CLRL R0 RET MORE_ROOM: MOVL 4(AP), R2 ; address of counted string gsdnam MOVL 8(AP), R5 ; svapte PUSHL R2 CALLS #1,G^CHECK_IF_SAME_GSDNAM ; check if the gsdnam is the same as the last ; one BLBC R0,DIFFERENT_GSDNAM_OR_PTE MOVL #-1,R0 ; gsdnam is the same as ; the last added one, so don't add it RET DIFFERENT_GSDNAM_OR_PTE: MOVL ACB_ARRAY_LENGTH(R7), R0 MULL2 #4,R0 ; R0 is offset from beginning of array MOVAL ACB_VGBL_PTE_ADDR(R7), R1 ADDL R0,R1 ; R1 is now address of next available slot MOVL R5,(R1) ; add new pte address to array MOVAL ACB_PTE_TYPE(R7),R1 ; the beginning of the ACB_PTE_TYPE array ADDL R0,R1 ; locate next avail slot in ACB_PTE_TYPE ; array MOVL ACB_PPTE_TYPE(R7),(R1) ; we've already set ACB_PPTE_TYPE MOVAL ACB_GSDNAM_ARRAY(R7),R1 MOVL ACB_ARRAY_LENGTH(R7),R0 MULL2 #45,R0 ; R0 is offset from beginning of array ADDL R0,R1 MOVL (R2),R3 ; get the length of the string BICL2 #^C^X000000FF,R3 ; we only want the lowest order byte ; is the length of gsdnam INCL R2 ; point to first character is gsdnam MOVC5 R3,(R2),#32,#45,(R1); move counted global section name into ; the array element of acb_gsdnam_array INCL ACB_ARRAY_LENGTH(R7) ; say that there is one more slot used MOVL #-1,R0 ; return successful status RET ; Purpose: Check if the currently considered pte is of the ; same type as the last one added to the array .ENTRY CHECK_IF_SAME_PTE_TYPE, ^M MOVAL ACB_PTE_TYPE(R7),R1 MOVL ACB_ARRAY_LENGTH(R7),R0 BLEQ NOT_SAME ; If no elements have been added yet to the ; array, then add the current pte the array ; (so say it is different than the last) DECL R0 MULL2 #4,R0 ADDL R0,R1 ; R1 now points to the last added acb_pte_type MOVAL ACB_PPTE_TYPE(R7),R2 ; make R2 point to the 4-character current ; pte type CMPC3 #4,(R2),(R1) ; compare the 4 bytes of acb_ppte_type with the ; full 4 bytes of the last added acb_pte_type BNEQ NOT_SAME2 MOVL #-1,R0 ; they are the same RET NOT_SAME2: CLRL R0 RET ; Purpose: Check if the newly found gsdnam is the same ; as the last one we found .ENTRY CHECK_IF_SAME_GSDNAM, ^M MOVL 4(AP),R2 ; address of counted string gsdnam MOVZBL (R2),R3 ; get the string length INCL R2 ; now R2 points to the first character of ; gsdnam MOVAL ACB_GSDNAM_ARRAY(R7),R1 MOVL ACB_ARRAY_LENGTH(R7),R0 BLEQ NOT_SAME ; case in which there are no entries yet in the ; array DECL R0 MULL2 #45,R0 ADDL R0,R1 ; R1 now points to the last added gsdnam CMPC5 R3,(R2),#32,#45,(R1) ; pad the gsdnam out to 45 characters with ; blanks and compare to the last gsdnam added BNEQ NOT_SAME MOVL #-1,R0 ; they are the same RET NOT_SAME: CLRL R0 RET CHECK_IF_VALID_GLOBAL: ; Purpose: Check if the process pte is valid and maps ; a global page ; R4 contains the PCB address ; R5 contains the PTE address ; R6 is the address of the end of the page table ; R3 is returned with the pfn of the valid global page ; R0 is returned with 0 (not a valid global page) ; or 1 (a valid global page) ; ; ; The process pte looks like this: ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|1 | 1 1 1 1 |0 |--| 1 1 |--| 0| 002B0D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Vld Prot= UR M Own=U W Page Frame Number ; ; Page is Active and Valid CLRL R0 BBS #31,(R5),VALID_PAGE ; check if the page is in the working set RSB ; no, it isn't in the working set VALID_PAGE: ; Check that the window bit of the pte is not set. If it is set, ; this means that the page may be in IO space (not in physical ; memory) and the PFN is bogus and not in the PFN database. ; If you attempted to use the PFN to access the PFN database, ; you would run off the end and get an access violation. BBS #PTE$V_WINDOW,(R5),BAD_TYPE BICL3 #^C,(R5),R3 ; get the PFN portion of the pte JSB G^CHECK_THAT_PFN_TYPE_IS_GLOBAL BLBC R0,BAD_TYPE MOVL #PVAL,ACB_PPTE_TYPE(R7) BAD_TYPE: RSB CHECK_IF_INVALID_GLOBAL: ; Purpose: Checks whether a pte represents an global page ; not currently in the working set ; ;The process pte looks like this: ; ; ;|31 28|27 24|23 20|19 16|15 12|11 8|7 ;| | | | | | | ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;|0 | 1 1 1 1 |0 |--| 1 1 | 1| 0A998D ;+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--> ;Inv Prot= UR T1 Own=U T0 Global Page Table Index ; ; Page is an Invalid Global Page ; ; ; Inputs: R5, svapte ; Outputs: R0, -1 if pte represents invalid global page ; 0 otherwise ; Destroys: R1 CLRL R0 BICL3 #^C, (R5), R1 CMPL R1,#PTE$M_TYP0 BNEQ NOT_INVALID_GLOBAL MOVL #-1,R0 NOT_INVALID_GLOBAL: RSB ; Input: R3 is pfn ; Returns: R0 ; 1 if there is a global page at that physical ; page ; 0 if the physical page does not contain a ; global page ; Destroys: R1 CHECK_THAT_PFN_TYPE_IS_GLOBAL: MOVL G^PFN$AB_TYPE,R1 ; get type array address MOVB (R1)[R3],R1 ; get type array element ; changed from single process version ; MOVB @L^PFN$AB_TYPE[R3],R1 ; get type array element BICL2 #^C,R1 ; Mask out the low 3 bytes MOVL #1,R0 ; Set flag that it is a global page in advance CMPB #2,R1 ; Is it a global read-only page? BEQL VALID_GLOBAL_PAGE; Yes. CMPB #3,R1 ; Is it a global read/write page? BEQL VALID_GLOBAL_PAGE; Yes. CLRL R0 ; It is not a global page. VALID_GLOBAL_PAGE: RSB CHECK_STATE_OF_TRANSITION_PAGE: ; ; Purpose: Takes the pfn of a transition page and checks that ; that physical page is either on the free page list, the ; modified page list, or is a release pending page ; Let's not consider pages that are on bad page list, read in progress, write ; in progress, etc. ; Inputs: R3, pfn ; R7, ACB address ; Outputs: R0, -1 if a state is OK ; 0 otherwise ; Destroys: R1 ; changed from single-process version MOVL G^PFN$AB_STATE,R1 ; get state array address MOVB (R1)[R3],R1 ; get state array element EXTV #PFN$V_LOC,#PFN$S_LOC,R1,R0 CMPL #0,R0 ; on free page list BEQL ON_FREE_PAGE_LIST CMPL #1,R0 BEQL ON_MODIFIED_PAGE_LIST CMPL #3,R0 BEQL RELEASE_PENDING CLRL R0 RSB ON_FREE_PAGE_LIST: MOVB #^A/F/,ACB_LOC_STATE(R7) BRB OK_TRANSITION_STATE ON_MODIFIED_PAGE_LIST: MOVB #^A/M/,ACB_LOC_STATE(R7) BRB OK_TRANSITION_STATE RELEASE_PENDING: MOVB #^A/P/,ACB_LOC_STATE(R7) BRB OK_TRANSITION_STATE OK_TRANSITION_STATE: MOVL #-1,R0 RSB AST_CODE_LENGTH = .-ORIGIN_TO_TARGET_AST_CODE .END PROGRAM TGET_GLOBALS !++ ! ! Creation Date: 27-MAY-1990 ! ! Author: Dave Gordon ! ! Modification History: ! ! 19-JUN-1990 TGET_GLOBALS5.FOR ! ! This version prints out the process ! name and pid, but little global ! section debugging information. It ! gives all global sections for every ! process on the system. ! ! 23-DEC-1990 TGET_GLOBALS6.FOR ! ! Added more comments ! ! Functional Description: ! ! This program prints out, for each process on the ! system, the names of the global sections mapped ! by that process. ! ! How to Use It: ! ! $ @GET_GLOBALS11 ! (to compile, assemble, and link it) ! $ SET PROC/PRIV=ALL ! (in particular, CMKRNL is required) ! $ RUN TGET_GLOBALS11 ! (to run it) ! ! Warning: This program runs in kernel mode at elevated ! IPL and thus theoretically could crash VMS. ! I suggest that the first few times, ! you try it on a system that is OK to crash. ! !-- IMPLICIT NONE INCLUDE 'SYS$LIBRARY:FORSYSDEF($JPIDEF)' INCLUDE 'SYS$LIBRARY:FORSYSDEF($SSDEF)' C Externals INTEGER*4 SYS$GETJPIW INTEGER*4 SYS$GETJPI INTEGER*4 SYS$WAITFR INTEGER*4 GET_ALL_GLOBALS_FROM_PROCESS INTEGER*4 STATUS INTEGER*4 INADR (2) INTEGER*4 EPID INTEGER*4 EPID_TO_GETJPI INTEGER*4 PTE_ADDRESS INTEGER*4 P0BR INTEGER*4 VIRTUAL_ADDRESS INTEGER*4 K INTEGER*4 LL INTEGER*4 MMAX_ARRAY_LENGTH PARAMETER (MMAX_ARRAY_LENGTH = 200) INTEGER*4 PP0BR INTEGER*4 MAX_ARRAY_LENGTH INTEGER*4 ARRAY_LENGTH INTEGER*4 VGBL_PTE_ADDR CHARACTER*45 GSD_NAM CHARACTER*4 PTE_TYPE INTEGER*4 FOR_DEBUG1 INTEGER*4 FOR_DEBUG2 INTEGER*4 FOR_DEBUG3 INTEGER*4 FOR_DEBUG4 INTEGER*4 FOR_DEBUG5 INTEGER*4 FOR_DEBUG6 INTEGER*4 FOR_DEBUG7 INTEGER*4 FOR_DEBUG8 INTEGER*4 FOR_DEBUG9 CHARACTER*1 OVERFLOW_GSDNAMS C This common is used for receiving data C from the kernel mode portion of the program COMMON /KERNEL_USER_LINK/ PP0BR COMMON /KERNEL_USER_LINK/ MAX_ARRAY_LENGTH COMMON /KERNEL_USER_LINK/ ARRAY_LENGTH COMMON /KERNEL_USER_LINK/ VGBL_PTE_ADDR (MMAX_ARRAY_LENGTH) COMMON /KERNEL_USER_LINK/ GSD_NAM (MMAX_ARRAY_LENGTH) COMMON /KERNEL_USER_LINK/ PTE_TYPE (MMAX_ARRAY_LENGTH) COMMON /KERNEL_USER_LINK/ FOR_DEBUG1 COMMON /KERNEL_USER_LINK/ FOR_DEBUG2 COMMON /KERNEL_USER_LINK/ FOR_DEBUG3 COMMON /KERNEL_USER_LINK/ FOR_DEBUG4 COMMON /KERNEL_USER_LINK/ FOR_DEBUG5 COMMON /KERNEL_USER_LINK/ FOR_DEBUG6 COMMON /KERNEL_USER_LINK/ FOR_DEBUG7 COMMON /KERNEL_USER_LINK/ FOR_DEBUG8 COMMON /KERNEL_USER_LINK/ FOR_DEBUG9 COMMON /KERNEL_USER_LINK/ OVERFLOW_GSDNAMS integer*4 myiosb(2) CHARACTER*80 USERNAME CHARACTER*255 IMAGE_NAME CHARACTER*15 PROCESS_NAME INTEGER*4 UIC STRUCTURE /ITEMLIST_STRUCTURE/ INTEGER*2 BUFFER_LENGTH INTEGER*2 ITEM_CODE INTEGER*4 BUFFER_ADDRESS INTEGER*4 RETURN_LENGTH_ADDRESS END STRUCTURE RECORD /ITEMLIST_STRUCTURE/ ITEMLIST(6) C Set up item list for $GETJPI EPID_TO_GETJPI = -1 ITEMLIST(1).BUFFER_LENGTH = 4 ITEMLIST(1).ITEM_CODE = JPI$_PID ITEMLIST(1).BUFFER_ADDRESS = %LOC (EPID) ITEMLIST(2).BUFFER_LENGTH = 80 ITEMLIST(2).ITEM_CODE = JPI$_USERNAME ITEMLIST(2).BUFFER_ADDRESS = %LOC (USERNAME) ITEMLIST(3).BUFFER_LENGTH = 255 ITEMLIST(3).ITEM_CODE = JPI$_IMAGNAME ITEMLIST(3).BUFFER_ADDRESS = %LOC (IMAGE_NAME) ITEMLIST(4).BUFFER_LENGTH = 15 ITEMLIST(4).ITEM_CODE = JPI$_PRCNAM ITEMLIST(4).BUFFER_ADDRESS = %LOC (PROCESS_NAME) ITEMLIST(5).BUFFER_LENGTH = 4 ITEMLIST(5).ITEM_CODE = JPI$_UIC ITEMLIST(5).BUFFER_ADDRESS = %LOC (UIC) ITEMLIST(6).BUFFER_LENGTH = 0 ITEMLIST(6).ITEM_CODE = 0 C loop once for each process on the system DO WHILE (.TRUE.) 100 STATUS = SYS$GETJPIW (%VAL(1),EPID_TO_GETJPI, > ,ITEMLIST,myiosb,,) C If $GETJPI returned an error, it could be because C of various reasons. IF (.NOT. STATUS) THEN C If we have looked at all processes on the system, C then stop. IF (STATUS .EQ. SS$_NOMOREPROC) THEN GOTO 200 C If a process is suspended, don't send C it an AST since it might not execute it. ELSE IF (STATUS .EQ. SS$_SUSPENDED) THEN PRINT *, 'SUSPENDED' GOTO 100 C Any other reason for the error, quit. ELSE CALL LIB$SIGNAL (%VAL (STATUS)) ENDIF ENDIF C avoid swapper since could crash VMS IF (PROCESS_NAME(1:7) .EQ. 'SWAPPER') GOTO 100 MAX_ARRAY_LENGTH = MMAX_ARRAY_LENGTH ARRAY_LENGTH = 0 TYPE *, ' ' TYPE *, ' ' TYPE *, process_name STATUS = GET_ALL_GLOBALS_FROM_PROCESS( EPID) C If a SKAST could not be sent to the process, quit. IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) C If the COMMON area could not contain all the names of C the global sections mapped by the process, alert the C user that the list is incomplete. IF (OVERFLOW_GSDNAMS .EQ. 'Y') THEN TYPE *, 'NOT ALL GLOBAL SECTION NAMES LISTED' ELSE type *, 'NUMBER OF GLOBAL SECTIONS = ',array_length ENDIF DO K = 1, ARRAY_LENGTH TYPE *, ' ', GSD_NAM(K) ENDDO END DO 200 CONTINUE 1000 FORMAT (1X,A,Z8,A,Z8) 1001 FORMAT (1X,A,Z8,5X,Z8,5X,Z8) END