.TITLE GETCMD .IDENT /02-001/ ; ; Copyright 1991 by Hunter Goatley. This code may be freely distributed ; and modified for non-commercial purposes as long as this copyright notice ; is retained. ; ;++ ; ; Program: GETCMD ; ; Author: Hunter Goatley ; ; Date: April 29, 1991 ; ; Functional description: ; ; This program will display another process's DCL command recall ; buffer. A special kernel mode AST is queued to the target process ; to gather the information; this AST then queues another AST back ; to the requesting process to copy the information to this program's ; buffer. ; ; This program works on VMS v4.0 and higher. ; ; Modified by: ; ; 02-001 Hunter Goatley 27-SEP-1991 07:36 ; Modified poor-man's lockdown so it's correct. ; ; 02-000 Hunter Goatley 29-APR-1991 09:05 ; Major rewrite of program written in September 1987. This ; version cleans up a considerable amount of code, as well ; as properly synchronizes all access to VMS structures. ; ;-- .SUBTITLE Data area .LIBRARY /SYS$LIBRARY:LIB.MLB/ .LINK "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH .LINK "SYS$SYSTEM:DCLDEF.STB"/SELECTIVE_SEARCH .DSABL GLOBAL ; Declare external references .ENABL SUPPRESSION ; Don't list unreferenced syms .NOSHOW BINARY ; Turn off binary in listings ; ; External RTL routines: ; .EXTRN LIB$GET_FOREIGN ; Get foreign command line .EXTRN LIB$PUT_OUTPUT ; Write to SYS$OUTPUT .EXTRN OTS$CVT_TZ_L ; Convert ASCII to hex ; ; External system routines: ; .EXTRN EXE$ALONONPAGED ; Allocate from nonpaged pool .EXTRN EXE$DEANONPAGED ; Deallocate to nonpaged pool .EXTRN EXE$EPID_TO_PCB ; Convert EPID to PCB address .EXTRN SCH$CLREFR ; Clear event flag .EXTRN SCH$CHSEP ; Set priority .EXTRN SCH$POSTEF ; Post an event flag setting .EXTRN SCH$QAST ; Queue AST to a process ; ; Global variables used here: ; .EXTRN CTL$AG_CLIDATA ; Pointer to DCL data area .EXTRN CTL$GL_PCB ; Current process's PCB .EXTRN PPD$L_PRC ; Pointer process's PRC area .EXTRN PRC_G_COMMANDS ; Pointer to cmd recall buffer .EXTRN PRC_L_RECALLPTR ; Ptr to last command entered .EXTRN PRC_S_COMMANDS ; Size of the cmd recall buffer .EXTRN SCH$GL_PCBVEC ; Address of PCB vectors $ACBDEF ; AST Control Block definitions $DSCDEF ; Descriptor symbols $DYNDEF ; Data structure type codes $IPLDEF ; Synchronization IPL values $JIBDEF ; Job Information Block (quotas) $PCBDEF ; Software PCB fields $PHDDEF ; Process Header symbols $PRIDEF ; Priority boost classes $PSLDEF ; Fields in PSL $SSDEF ; System service status codes $STATEDEF ; State symbol definitions ; ; Define extended AST control block ; $DEFINI ACB . = ACB$K_LENGTH ; Get past normal ACB fields $DEF ACB_L_USERBUF ; Address of this program's .BLKL 1 ; ... command buffer $DEF ACB_L_PID ; This process's PID .BLKL 1 ; ... $DEF ACB_L_KAST_STATUS ; Working status for the ASTs .BLKL 1 ; ... $DEF ACB_L_2ND_KAST ; Beginning address of 2nd AST .BLKL 1 ; ... for original process $DEF ACB_L_EFN ; Event Flag to set upon .BLKL 1 ; ... second KAST completion $DEF ACB_L_IMGCNT ; The image count (incremented .BLKL 1 ; ... by SYSRUNDWN) $DEF ACB_L_USERPTR ; Address of this program's .BLKL 1 ; ... recall pointer $DEF ACB_L_RECALLPTR ; Pointer to last DCL command .BLKL 1 ; ... $DEF ACB_T_DCLBUFFER ; Buffer for DCL command buffer .BLKB 1025 ; ... $DEF ACB_K_LENGTH ; Symbol for extended length $DEFEND ACB ; ; Macro to see if we've gone past the end of the command recall buffer. ; .MACRO CHECK ?HERE CMPL R11,R10 ; Have we gone past the beginning? BNEQ HERE ; No -- skip next instruction MOVAB CMD_BUF_END,R10 ; Make R10 point to one byte past the ; ... end of the data area. With next ; ... autodecrement, it will point to ; ... the last byte of the table. HERE: .ENDM CHECK ; ; PUSHREG and POPREG macros ; ; These macros are used instead of PUSHR and POPR; they generate the ; necessary PUSHLs and POPLs, which are faster than PUSHR and POPR. ; .MACRO PUSHREG REG0,REG1,REG2,REG3,REG4,REG5,REG6,REG7,REG8,REG9,- REG10,REG11 .IRP REG .IIF NB, REG, PUSHL REG ; Save the contents of REG .ENDR ;* Loop until all regs saved .ENDM PUSHREG .MACRO POPREG REG0,REG1,REG2,REG3,REG4,REG5,REG6,REG7,REG8,REG9,- REG10,REG11 .IRP REG .IIF NB, REG, POPL REG ; Restore the contents of REG .ENDR ;* Loop until all regs restored .ENDM POPREG .SHOW BINARY ; Include binary in listings .PSECT _GETCMD_DATA RD,WRT,NOEXE,PIC,LONG EPID_D: .WORD 8 ; ASCII PID descriptor .BYTE DSC$K_DTYPE_T ; ... .BYTE DSC$K_CLASS_S ; ... .ADDRESS .+4 ; ... .BLKB 8 ; ... Buffer EPID: .LONG 0 ; The PID of the target process PID_PROMPT: .LONG 3 ; LIB$GET_FOREIGN argument list .ADDRESS EPID_D ; ... Buffer to receive PID .ADDRESS 10$ ; ... The prompt .ADDRESS EPID_D ; ... Buffer to receive length 10$: .ASCID /PID: / .ALIGN LONG CVTPID: .LONG 2 ; OTS$CVT_TZ_L argument list .ADDRESS EPID_D ; ... ASCII PID address .ADDRESS EPID ; ... Hex PID address KGET_ARGS: .LONG 4 ; GET_DCLBUFFER arg. list .LONG 0 ; ... Event Flag Number .ADDRESS EPID ; ... Target process's PID .ADDRESS BUFFER ; ... User's cmd buffer addr .ADDRESS RECALLPTR ; ... User's cmd recall ptr RECALLPTR: .LONG 0 ; Pointer to last command BUFF_DESC: .QUAD 0 ; Space for descriptor BUFFER: .BLKB 1025 ; Buffer for DCL commands CMD_BUF_END = . .ALIGN LONG MAXCMDLEN = 256 ; Max length of a DCL command ; CMDBUFFER_D: ; Descriptor for command buffer .WORD MAXCMDLEN ; ... .BYTE DSC$K_DTYPE_T ; ... .BYTE DSC$K_CLASS_S ; ... .ADDRESS .+4 ; ... CMDBUFFER: ; The command buffer .BYTE ^A/ /[MAXCMDLEN] ; ... ; FAOCTR: .ASCID /!3UL !AS/ ; $FAO control string for cmds FAOUT: .WORD MAXCMDLEN+4 ; $FAO output buffer .BYTE DSC$K_DTYPE_T ; ... .BYTE DSC$K_CLASS_S ; ... .ADDRESS .+4 ; ... .BLKB MAXCMDLEN+4 ; ... NO_CMDS_MSG: .ASCID /No DCL commands to recall/ ; ; Main routine ; .PSECT _GETCMD_CODE RD,NOWRT,EXE,PIC,LONG .ENTRY GETCMD,^M<> CALLG PID_PROMPT,G^LIB$GET_FOREIGN ; Get the specified PID BLBC R0,20$ ; Branch on error CALLG CVTPID,G^OTS$CVT_TZ_L ; Convert PID from ASCII to hex BLBC R0,20$ ; Branch on error 10$: $CMKRNL_S - ; Change mode to kernel to ROUTIN=GET_DCLBUFFER, - ; ... queue an AST to the ARGLST=KGET_ARGS ; ... target process BLBC R0,20$ ; Error? Exit $WAITFR_S - ; Wait for the second AST to EFN=#0 ; ... complete (and set EFN 0) CALLS #0,LIST_CMDS ; List the commands outs 20$: RET ; Return to VMS ; ; This routine prints the command recall buffer to SYS$OUTPUT. ; .ENTRY LIST_CMDS,^M MOVL RECALLPTR,R10 ; Addr of end of most recent cmd BNEQ 10$ ; Branch if we have any commands PUSHAQ NO_CMDS_MSG ; Print "No DCL commands" CALLS #1,G^LIB$PUT_OUTPUT ; .... BRW 50$ ; Return to caller 10$: MOVAB BUFFER,R11 ; R11 -> beginning of data block ADDL2 R11,R10 ; Make R10 a real address MOVL R10,R9 ; Make a copy of it CLRL R6 ; Initialize command counter 20$: INCL R6 ; Increment command counter MOVAB CMDBUFFER,R8 ; Get the buffer address MOVC5 #0,#0,#^A/ /,#MAXCMDLEN,(R8) ; Clear the buffer MOVZBL -(R10),R7 ; Get length of first command BNEQU 30$ ; 2 null bytes in a row? End BRW 50$ ; 2 null bytes in a row? End 30$: MOVW R7,CMDBUFFER_D ; Move length to the descriptor CHECK ; Check to see if command wraps ; ... to end of the data area ADDL2 R7,R8 ; Make R8 point to end of buffer 40$: MOVB -(R10),-(R8) ; Move the first byte CHECK ; Check our addresses SOBGTR R7,40$ ; Loop until command is moved $FAO_S CTRSTR = FAOCTR, - ; Format for output OUTBUF = FAOUT, - ; ... OUTLEN = FAOUT, - ; ... P1 = R6, - ; ... P2 = #CMDBUFFER_D ; ... PUSHAQ FAOUT ; Write it to the terminal CALLS #1,G^LIB$PUT_OUTPUT ; .... MOVW #256,FAOUT ; Reset FAO output descriptor DECL R10 ; Should point to prefix count CHECK ; Check our addresses DECL R10 ; Should now point to 0 byte CHECK ; Check our addresses CMPL R10,R9 ; If current addr = start BEQL 50$ ; ... end of data BRW 20$ ; Loop until all cmds printed 50$: MOVL #SS$_NORMAL,R0 ; Set return code RET ; Return to caller .PAGE .SBTTL GET_DCLBUFFER ;+ ; ; Routine: GET_DCLBUFFER ; ; Functional Description: ; ; This routine queues an AST to the target process to retrieve the ; other process's command recall buffer. ; ; Environment: ; ; Kernel mode ; ; Inputs: ; ; 4(AP) - Event Flag to clear and set (by value) ; 8(AP) - Address of longword containing the PID of the target process ; 12(AP) - Address of 1024-byte user buffer to receive command buffer ; 16(AP) - Address of longword to receive pointer to last command ; ; Outputs: ; ; None. ; ; Returns: ; ; R0 - Status ; ; Side effects: ; ; Sets the specified event flag when the second AST completes. ; ;- ; ; Argument List Definition ; EFN = 1*4 ; Event Flag Number to set PIDADR = 2*4 ; Address of process ID BUFADR = 3*4 ; Buffer address PTRADR = 4*4 ; Recall pointer address .ENTRY GET_DCLBUFFER,^M ; ; First, see if the process even exists. We do this by grabbing the SCHED ; spinlock and calling EXE$EPID_TO_PCB, which returns 0 if the process does ; not exist. If the process exists, the IPID is copied from the PCB to R11. ; MOVL @PIDADR(AP),R0 ; Put EPID in R0 CLRL R11 ; Start with 0 as IPID 10$: .IF DEFINED PCB$L_CPU_ID ;* VMS 5.x code DSBINT 50$,ENVIRON=UNIPROCESSOR ; Fault in code and raise IPL ; ... (and save IPL on stack) LOCK LOCKNAME=SCHED, - ; Grab the scheduler spinlock PRESERVE=YES ; ... R0 has EPID .IFF ;* VMS 4.x code DSBINT 50$ ; Disable interrupts .ENDC ;* End of VMS version check JSB G^EXE$EPID_TO_PCB ; Lookup the PCB address BEQL 20$ ; Branch on error MOVL PCB$L_PID(R0),R11 ; Store the IPID in R11 20$: .IF DEFINED PCB$L_CPU_ID ;* VMS 5.x code UNLOCK LOCKNAME=SCHED, - ; Grab the scheduler spinlock NEWIPL =(SP)+, - ; ... Save the IPL CONDITION=RESTORE,- ; ... Release only this one PRESERVE=YES ; ... R0 has EPID .IFF ;* VMS 4.x code ENBINT ; Enable interrupts .ENDC ;* End of VMS version check 30$: TSTL R0 ; Does R0 have an address? BNEQ 60$ ; Branch if so MOVL #SS$_NONEXPR,R0 ; Return error to caller 40$: RET ; ... 50$: .LONG IPL$_SCHED ; Target IPL ASSUME <.-10$> LE 512 ; ; Clear the specified event flag ; 60$: MOVL EFN(AP),R3 ; Get the event flag to clear JSB G^SCH$CLREFR ; Go clear it BLBC R0,40$ ; Error? Return it to caller ; ; Raise our IPL to 2 to block ASTs so we can't be deleted ; .IF DEFINED PCB$L_CPU_ID ;* VMS 5.x code SETIPL #IPL$_ASTDEL,- ; Set IPL to 2 to prevent ENVIRON=UNIPROCESSOR ; .... deletion .IFF ;* VMS 4.x code SETIPL #IPL$_ASTDEL ; Set IPL to 2 .ENDC ;* End of VMS 5.x check ; ; Now allocate an AST control block (ACB) and initialize it ; MOVL #ACB_K_LENGTH,R1 ; Set size of extended ACB JSB G^EXE$ALONONPAGED ; Allocate nonpaged pool space BLBS R0,70$ ; Branch if successful BRW 150$ ; Branch to lower IPL and exit 70$: MOVL R11,ACB$L_PID(R2) ; Store PID of target process MOVW R1,ACB$W_SIZE(R2) ; Store size of structure MOVB #DYN$C_ACB,ACB$B_TYPE(R2) ; ... and its type MOVPSL R1 ; Get the current PSL EXTZV #PSL$V_PRVMOD,#PSL$S_PRVMOD,- ; Get caller's access mode R1,R1 ; ... and store it in ACB BISB3 #ACB$M_KAST,R1,ACB$B_RMOD(R2) ; ... (with KAST set, too) CLRL ACB$L_KAST(R2) ; Clear the ast address ; ... (filled in later) ; ; Now initialize our extended ACB fields ; MOVL EFN(AP),ACB_L_EFN(R2) ; Store the caller's EFN MOVL BUFADR(AP),ACB_L_USERBUF(R2) ; Store the buffer addr MOVL PTRADR(AP),ACB_L_USERPTR(R2) ; Store pointer address MOVL PCB$L_PID(R4),ACB_L_PID(R2) ; Save this PID MOVL PCB$L_PHD(R4),R1 ; Get the process header MOVL PHD$L_IMGCNT(R1), - ; Save this image reference ACB_L_IMGCNT(R2) ; ... number (used by second ; ... AST to be sure this ; ... program is still running) CLRL ACB_L_2ND_KAST(R2) ; Clear address of 2nd AST ; ; Allocate some nonpaged pool and move the AST code into it ; MOVL R2,R5 ; Save ACB address MOVL #AST_LENGTH+12,R1 ; Allow 12 bytes for a header JSB G^EXE$ALONONPAGED ; Allocate nonpaged pool BLBC R0,80$ ; Branch on error CLRQ (R2)+ ; Clear two link longwords MOVW R1,(R2)+ ; Store the size of the code CLRW (R2)+ ; Clear type and spare byte PUSHREG R0,R1,R2,R3,R4,R5 ; Save registers from MOVC3 MOVC3 #AST_LENGTH,AST_CODE,(R2) ; Copy the AST code to pool POPREG R0,R1,R2,R3,R4,R5 ; Restore registers MOVL R2,ACB$L_KAST(R5) ; Store address of KAST in ACB ; ; Now allocate nonpaged pool for the second AST.... ; MOVL #AST2_LENGTH+12,R1 ; Allow 12 bytes for a header JSB G^EXE$ALONONPAGED ; Allocate nonpaged pool BLBC R0,80$ ; Branch on error CLRQ (R2)+ ; Clear two link longwords MOVW R1,(R2)+ ; Store the size of the code CLRW (R2)+ ; Clear type and spare byte PUSHREG R0,R1,R2,R3,R4,R5 ; Save registers from MOVC3 MOVC3 #AST2_LENGTH,AST2_CODE,(R2) ; Copy the AST code to pool POPREG R0,R1,R2,R3,R4,R5 ; Restore registers MOVL R2,ACB_L_2ND_KAST(R5) ; Store address of this 2nd AST BRB 90$ ; Branch to continue 80$: BRW 130$ ; Branch to deallocate the pool ; ; Now we're ready to queue the AST to the target process. First, make sure ; the process is not suspended or anything. Then call SCH$QAST to queue ; the AST. ; 90$: .IF DEFINED PCB$L_CPU_ID ;* VMS 5.x code DSBINT 160$,ENVIRON=UNIPROCESSOR ; Raise IPL and lock down this ; ... section of code (old IPL ; ... is saved on stack) LOCK LOCKNAME=SCHED ; Grab the SCHED spinlock and ; ... (No SAVIPL because DSBINT ; ... pushes the IPL) .IFF ;* VMS V4.x code SETIPL 160$ ; Lock down this section of code .ENDC ;* End check for VMS V5.x MOVZWL ACB$L_PID(R5),R4 ; Get the target PID MOVL G^SCH$GL_PCBVEC,R1 ; Get target PCB address MOVL (R1)[R4],R4 ; ... (using low word of PID) CMPL PCB$L_PID(R4),ACB$L_PID(R5) ; Are the PIDs the same? BNEQ 120$ ; No - error - return BBS #PCB$V_DELPEN,PCB$L_STS(R4),120$ ; Check if target being deleted BBS #PCB$V_SUSPEN,PCB$L_STS(R4),120$ ; Check if target being suspended CMPW #SCH$C_SUSP,PCB$W_STATE(R4) ; Exit if the process is BEQLU 120$ ; ... SUSPended CMPW #SCH$C_SUSPO,PCB$W_STATE(R4) ; ... or SUSPended, Out of BEQLU 120$ ; ... memory CMPW #SCH$C_MWAIT,PCB$W_STATE(R4) ; ... or in a long Miscellaneous BEQLU 120$ ; ... WAIT state MOVL #PRI$_TICOM,R2 ; Give a big priority increment JSB G^SCH$QAST ; Queue AST to other process ; ; If process is in compute state and at a lower priority than the requesting ; process, boost its current priority to the requesting process's current ; priority. (Required because event reporting won't normally boost a COM ; state process's priority.) (Modelled after $GETJPI.) ; CMPW #SCH$C_COM,PCB$W_STATE(R4) ; Is process in compute state? BEQLU 100$ ; Yes - bump its priority CMPW #SCH$C_COMO,PCB$W_STATE(R4) ; Is it in Compute, Out of BNEQU 110$ ; .. memory? Yes - bump priority 100$: MOVL G^CTL$GL_PCB,R3 ; Get requestor's PCB address MOVB PCB$B_PRI(R3),R0 ; Get requestor's current priority CMPB R0,PCB$B_PRI(R4) ; Other process have higher? BGEQU 110$ ; If GEQU yes - don't boost it CMPB #16,R0 ; Will boost be into realtime? BGTRU 110$ ; If GTRU yes - don't boost JSB G^SCH$CHSEP ; Boost other process's priority ; ; Return to the caller ; 110$: .IF DEFINED PCB$L_CPU_ID ;* VMS V5.x code UNLOCK LOCKNAME=SCHED,- ; Release the SCHED spinlock NEWIPL=(SP)+,- ; ... and lower IPL CONDITION=RESTORE,- ; ... PRESERVE=NO ; ... Don't save R0 SETIPL #0,- ; Set the IPL back down to 0 ENVIRON=UNIPROCESSOR ; ... .IFF ;* VMS V4.x code SETIPL #0 ; Lower our IPL now .ENDC ;* End check for VMS V5.x MOVZWL #SS$_NORMAL,R0 ; Set successful status RET ; Return to caller ; ; Here, either there was an error allocating the needed memory, or the process ; went away. We need to deallocate the memory we allocated above; if the ; KAST and 2ND_KAST fields are non-zero, the memory for those ASTs is ; deallocated. In all cases, the ACB is deallocated. ; ; Entry 130$ is used while at IPL 2; entry 120$ is used while SCHED is held. ; 120$: MOVZWL #SS$_NONEXPR,R0 ; Status to return to caller .IF DEFINED PCB$L_CPU_ID ;* VMS V5.x code UNLOCK LOCKNAME=SCHED,- ; Release the SCHED spinlock NEWIPL=(SP)+,- ; ... and lower IPL CONDITION=RESTORE ; ... .IFF ;* VMS V4.x code SETIPL #IPL$_ASTDEL ; Lower our IPL now .ENDC ;* End check for VMS V5.x 130$: PUSHL R0 ; Save the status MOVL ACB$L_KAST(R5),R0 ; Was 1st AST copied to pool? BEQL 140$ ; No, neither had 2nd KAST.... SUBL #12,R0 ; Yes - point to top of block JSB G^EXE$DEANONPAGED ; Deallocate the buffer MOVL ACB_L_2ND_KAST(R5),R0 ; Had the 2nd AST been copied to BEQL 140$ ; ... nonpaged pool yet? SUBL #12,R0 ; Yes - point to top of block JSB G^EXE$DEANONPAGED ; Deallocate the buffer 140$: MOVL R5,R0 ; Deallocate the nonpaged pool JSB G^EXE$DEANONPAGED ; ... used for the ACB POPL R0 ; Restore status 150$: .IF DEFINED PCB$L_CPU_ID ;* VMS V5.x code SETIPL #0,- ; Set the IPL back down to 0 ENVIRON=UNIPROCESSOR ; ... .IFF ;* VMS V4.x code SETIPL #0 ; Lower our IPL now .ENDC ;* End check for VMS V5.x RET ; Return to caller 160$: .LONG IPL$_SYNCH ; All code between here and ; ... 90$ is locked down ASSUME <.-90$> LE 512 ; Can only lock 512 bytes .PAGE .SUBTITLE AST_CODE & AST_CODE2 ;+ ; ; Routines: AST_CODE and AST2_CODE ; ; Functional descriptions: ; ; AST_CODE executes as a special kernel AST in the context of the ; target process. It copies the DCL command recall buffer from the ; process's P1 space to the extended ACB and then uses the same ACB ; to queue another special kernel AST (AST2_CODE) back to the original ; process. ; ; AST2_CODE copies the DCL command recall buffer from the extended ; ACB to the caller's buffer (this program). Once the buffer has ; been copied, an event flag is set. ; ; Input Parameters: ; ; R0:R3 - Scratch ; R4 - PCB address of target process ; R5 - Address of extended ACB ; ; Calling Sequence: ; ; JSB AST_CODE from AST delivery routine at IPL IPL$_ASTDEL ; ; Side Effects: ; ; The target process's DCL command buffer is copied from the extended ; ACB to the original caller's buffer (address in ACB_L_USERBUFF). ; ;- AST_CODE: CLRL ACB_L_KAST_STATUS(R5) ; Clear status (assume error) MOVAB G^CTL$AG_CLIDATA,R3 ; Get address if CLI data MOVL PPD$L_PRC(R3),R3 ; Get address of proc work area BEQLU 10$ ; If zero, exit PUSHREG R0,R1,R2,R3,R4,R5 ; Save the registers from MOVC3 MOVL PRC_L_RECALLPTR(R3),R0 ; Get pointer to last command MOVAB PRC_G_COMMANDS(R3),R1 ; Get addr of beg. of buffer SUBL3 R1,R0,ACB_L_RECALLPTR(R5) ; Cvt recall ptr to rel. off. MOVC3 #PRC_S_COMMANDS,(R1), - ; Move the command buffer to ACB_T_DCLBUFFER(R5) ; ... the extended ACB POPREG R0,R1,R2,R3,R4,R5 ; Restore registers ; ; Queue the second AST back to original caller. ; 10$: MOVL ACB_L_2ND_KAST(R5),- ; Set up ACB for other AST ACB$L_KAST(R5) ; ... MOVL ACB_L_PID(R5),ACB$L_PID(R5) ; Store originator's PID in ACB BISB2 #ACB$M_KAST,ACB$B_RMOD(R5) ; Set Special KAST again .IF DEFINED PCB$L_CPU_ID ;* VMS 5.x code LOCK LOCKNAME=SCHED,- ; Grab the SCHED spinlock and SAVIPL=-(SP) ; ... raise IPL .IFF ;* VMS V4.x code SETIPL #IPL$_SYNCH ; Set IPL to SYNCH .ENDC ;* End check for VMS V5.x MOVZWL ACB_L_PID(R5),R1 ; Get the PID of the target proc MOVL G^SCH$GL_PCBVEC,R0 ; Get target PCB address (using MOVL (R0)[R1],R1 ; ... the low word from PID) CMPL PCB$L_PID(R1),ACB$L_PID(R5) ; Are they still the same? BNEQU 20$ ; No - error --> deallocate BBS #PCB$V_DELPEN,PCB$L_STS(R1),20$ ; If delete pending, exit CLRL R2 ; Clear priority increment JSB G^SCH$QAST ; Queue the AST MOVL #1,ACB_L_KAST_STATUS(R5) ; Set success flag 20$: .IF DEFINED PCB$L_CPU_ID ;* VMS V5.x code UNLOCK LOCKNAME=SCHED,- ; Release the SCHED spinlock NEWIPL=(SP)+,- ; ... and lower IPL CONDITION=RESTORE ; ... .IFF ;* VMS V4.x code SETIPL #IPL$_ASTDEL ; Lower our IPL now .ENDC ;* End check for VMS V5.x ; ; Now deallocate any memory that should be freed. Normally, this will just ; be the pool that contains this AST, but if the original process is deleted, ; we need to delete the pool for the second AST and the ACB. ; PUSHL ACB$L_KAST(R5) ; Save address of of this AST TSTL ACB_L_KAST_STATUS(R5) ; Did original process go away? BNEQ 30$ ; Branch if not MOVL ACB_L_2ND_KAST(R5),R0 ; Get address of 2nd AST buffer SUBL2 #12,R0 ; Point to header JSB G^EXE$DEANONPAGED ; Deallocate the memory MOVL R5,R0 ; Now deallocate the AST JSB G^EXE$DEANONPAGED ; Deallocate the memory 30$: POPL R0 ; R0 -> this AST buffer SUBL #12,R0 ; Point to block header JMP G^EXE$DEANONPAGED ; Deallocate this block and ; ... dismiss the AST AST_LENGTH = .-AST_CODE ; ; This is the code for the second AST. It runs in the context of the ; original process and copies the command buffer from the extended ACB ; into the caller's buffer. ; AST2_CODE: MOVL PCB$L_PHD(R4),R1 ; Get the process header ; ; If the process is not running the same image, then don't copy the buffer ; to the caller, since we'd just trash whatever program is currently running. ; CMPL PHD$L_IMGCNT(R1), - ; Is same image still running? ACB_L_IMGCNT(R5) ; ...(incremented by SYSRUNDWDN) BNEQU 10$ ; No - just forget about it PUSHREG R0,R1,R2,R3,R4,R5 ; Save registers from MOVC5 MOVL ACB_L_USERBUF(R5),R3 ; Get address of user's buffer MOVL ACB_L_USERPTR(R5),R1 ; Get address of user's ptr buff MOVL ACB_L_RECALLPTR(R5),(R1) ; Move pointer to user's buffer MOVC3 #PRC_S_COMMANDS, - ; Move commands to user's buffer ACB_T_DCLBUFFER(R5),(R3) ; ... POPREG R0,R1,R2,R3,R4,R5 ; Restore the registers ; ; Set the event flag to indicate that all is finished ; MOVL ACB_L_EFN(R5),R3 ; Get event flag number MOVL ACB_L_PID(R5),R1 ; ... and PID for process CLRL R2 ; Set null priority increment JSB G^SCH$POSTEF ; Set event flag ; ; Deallocate the AST Control Block and this block of code. ; 10$: PUSHL ACB_L_2ND_KAST(R5) ; Get addr of this AST MOVL R5,R0 ; Move address of ACB to R0 JSB G^EXE$DEANONPAGED ; Deallocate ACB POPL R0 ; Restore address of KAST SUBL #12,R0 ; Point to block header JMP G^EXE$DEANONPAGED ; Deallocate this block ; And dismiss the AST AST2_LENGTH = . - AST2_CODE .END GETCMD