From:	MERC::"uunet!WKUVX1.BITNET!FILESERV-Mgr"  3-JUN-1992 09:45:18.13
To:	galaxy::gleeve
CC:	
Subj:	GETCMD.02_OF_04

-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X%SBTTL`09'LIST_CMDS'
XROUTINE list_cmds (buf_a, ptr_a) =
XBEGIN
X!+
X!
X!  Routine:`09LIST_CMDS
X!
X!  Functional Description:
X!
X!`09This routine mimics the RECALL/ALL command.  It steps through a
X!`09command recall buffer, writing each command to SYS$OUTPUT.  The
X!`09commands are printed in LIFO order (last in, first out, so the
X!`09most recently executed command is printed first).
X!
X!  Environment:
X!
X!`09User-mode.
X!
X!  Formal parameters:
X!
X!`09buf_a`09- Address of the command buffer.  By reference.
X!`09ptr_a`09- Offset in buffer of the end of the last command.
X!`09`09  Longword, by reference.
X!
X!  Implicit inputs:
X!
X!`09PRC_S_COMMANDS
X!
X!  Outputs:
X!
X!`09None.
X!
X!  Returns:
X!
X!`09R0`09- Status
X!
X!-
XBIND
X`09buffer`09= .buf_a`09: REF $BBLOCK,
X`09lastptr`09= .ptr_a`09: LONG;
X
XEXTERNAL
X`09PRC_S_COMMANDS`09: ADDRESSING_MODE (ABSOLUTE);
X
XBIND
X`09fao_ctr_str`09= %ASCID'!3UB !AS';
X
XMACRO
X`09overflow (address) =`09`09`09`09!Macro to check for
X`09`09(address) GEQU end_buff_ptr %,`09`09!... wrapping past end
X`09underflow (address) =`09`09`09`09!Macro to check for
X`09`09(address) LSSU buffer %;`09`09!... wrapping past begin
X
XLOCAL
X`09loop`09`09: UNSIGNED LONG,`09!Loop control flag
X`09src`09`09: REF $BBLOCK,`09`09!Work pointer into buffer
X`09save_lastptr`09: REF $BBLOCK,`09`09!Saved address of last command
X`09end_buff_ptr`09: UNSIGNED LONG`09`09!Pointer to last byte in buffer
X`09`09`09  INITIAL(buffer + PRC_S_COMMANDS),
X`09length`09`09: UNSIGNED LONG,`09!Length of each command
X`09status`09`09: UNSIGNED LONG,`09!Status from LIB$PUT_OUTPUT
X`09cmd_buffer`09: $BBLOCK`5B256`5D,`09`09!Local copy of each command
X`09cmd_buffer_d`09: $staticdesc(256,cmd_buffer),
X`09fao_buffer`09: $BBLOCK`5B270`5D,`09`09!Output buffer for FAOL
X`09fao_buffer_d`09: $staticdesc(260,fao_buffer),
X`09faol_prmlst`09: VECTOR`5B2,LONG`5D`09!$FAOL parameter list
X`09`09`09  INITIAL (0,`09`09!... Command number
X`09`09`09`09 cmd_buffer_d);`09!... Command descriptor
X
X  IF (.lastptr EQLU 0)`09`09`09`09!If the offset is 0, then
X  THEN`09`09`09`09`09`09!... there are no commands
X     RETURN (GETCMD_NOCMDS);`09`09`09!... in the buffer.  Return.
X
X  save_lastptr = buffer + .lastptr;`09`09!Save address of beginning
X!  save_lastptr = .lastptr;
X  src = .save_lastptr;`09`09`09`09!And start there
X
X  loop = true;`09`09`09`09`09!Initialize loop control
X  WHILE .loop DO`09`09`09`09!Loop until no more commands...
X    BEGIN
X    src = .src - 1;`09`09`09`09!Point to the length byte
X    IF underflow(.src)`09`09`09`09!See if we passed the beginning
X    THEN`09`09`09`09`09!... of the buffer.  If so, we
X       src = .end_buff_ptr - 1;`09`09`09!... need to point to the end
X    length = .src`5B0,0,8,0`5D;`09`09`09!Now get the command length
X    IF (.length NEQU 0)`09`09`09`09!If we have a command,
X    THEN`09`09`09`09`09!... then process it
X       BEGIN
X       IF underflow(.src - .length)`09`09!If we'll underflow, we must
X       THEN`09`09`09`09`09!... copy the string in two
X`09  BEGIN`09`09`09`09`09!... pieces
X`09  LOCAL
X`09      temp1 : UNSIGNED LONG,
X`09      temp2 : UNSIGNED LONG;
X`09  temp1 = (.src - buffer);`09`09!Size of second piece of cmd
X`09  temp2 = .length - .temp1;`09`09!Size of command at buffer end
X`09  CH$MOVE (.temp2, .end_buff_ptr - .temp2, cmd_buffer);
X`09  CH$MOVE (.temp1, buffer, cmd_buffer + .temp2);
X`09  src = .end_buff_ptr - .temp2;`09`09!Now point src to the beginning
X`09  END
X       ELSE`09`09`09`09`09!No underflow---just copy it
X`09  BEGIN
X`09  src = .src - .length;
X`09  CH$MOVE (.length, .src, cmd_buffer);`09!Copy the string
X`09  END;
X       !
X       !  Here, src is pointing to the first character in the cmd string.
X       !  Now back to the preceding length byte and check for overflow....
X       !
X       src = .src - 1;
X       IF underflow(.src)
X       THEN
X`09  src = .end_buff_ptr-1;
X       !
X       !  And back up so src is pointing to the null byte (with overflow
X       !  check).
X       !
X       src = .src - 1;
X       IF underflow(.src)
X       THEN
X`09  src = .end_buff_ptr-1;
X
X       !
X       !  Now src points to 0, so we're ready to process the next command.
X       !
X       !  This command is formatted using $FAOL and written to SYS$OUTPUT.
X       !
X       faol_prmlst`5B0`5D = .faol_prmlst`5B0`5D + 1;`09!Increment the comman
Vd number
X       fao_buffer_d`5BDSC$W_LENGTH`5D = 260;`09!Reset length of $FAO buffer
X       cmd_buffer_d`5BDSC$W_LENGTH`5D = .length;`09!Copy cmd length to descr
Viptor
X       IF ($FAOL (CTRSTR = fao_ctr_str,`09`09!Format the string
X`09`09  OUTLEN = fao_buffer_d,`09!... and store in fao_buffer
X`09`09  OUTBUF = fao_buffer_d,`09!...
X`09`09  PRMLST = faol_prmlst))`09!...
X       THEN`09`09`09`09`09!If format was OK, then write
X`09  status = LIB$PUT_OUTPUT (fao_buffer_d);`09!... to SYS$OUTPUT
X       !
X       !  To avoid a potential infinite loop, we need to make sure that
X       !  we haven't worked our way through the buffer and landed on our
X       !  starting point.
X       !
X       IF (.src EQLU .save_lastptr)`09`09!Are we back where we started?
X       THEN`09`09`09`09`09!If so, we need to exit the
X`09  loop = false;`09`09`09`09!... (infinite) loop
X       END
X    ELSE`09`09`09`09`09!Length was 0, which means we
X       loop = false;`09`09`09`09!... are finished looping
X
X  END;  !WHILE loop DO
X
X  RETURN (SS$_NORMAL);
X`09
XEND;
X
X`0C
X%SBTTL`09'KRNL_GET_DCLBUFFER'
XFORWARD
X`09wslock_end;
XROUTINE krnl_get_dclbuffer (efn, pid_a, buf_a, ptr_a, stat_a) =
X!+
X!
X!  Routine:`09KRNL_GET_DCLBUFFER
X!
X!  Functional Description:
X!
X!`09This routine queues a special Kernel AST to the target process.
X!`09It peforms the following steps:
X!
X!`09  1.  Make sure the target process exists
X!`09  2.  Clear the specified Event Flag
X!`09  3.  Allocates an extended ACB with enough room for a command
X!`09      buffer and the code for two ASTs.
X!`09  4.  Initializes the ACB and copies the AST code to it.
X!`09  5.  Queues the AST to the target process.
X!
X!  Environment:
X!
X!`09Kernel-mode, elevated IPL (2 and IPL$_SCHED).
X!
X!  Formal parameters:
X!
X!`09efn`09- The event flag number.  Longword, by value.
X!`09pid_a`09- EPID of the process.  Longword, by reference.
X!`09buf_a`09- 1025-byte buffer to receive DCL command buffer.  By reference.
X!`09ptr_a`09- Longword to receive PRC_L_RECALLPTR.  By reference.
X!`09stat_a`09- Longword to receive status from AST.  By reference.
X!
X!  Implicit inputs:
X!
X!`09CTL$GL_PCB, CTL$GL_PHD
X!
X!  Outputs:
X!
X!`09None.
X!
X!  Returns:
X!
X!`09R0`09- Status
X!
X!  Side effects:
X!
X!`09Raises IPL to 2 and IPL$_SCHED; acquires and releases the SCHED
X!`09spinlock.
X!
X!-
XBEGIN
X
XMAP
X`09efn`09: UNSIGNED LONG;`09`09`09!Event flag (by value)
XBIND
X`09pid`09= .pid_a`09: UNSIGNED LONG,`09!Target EPID
X`09bufadr`09= .buf_a`09: $BBLOCK,`09`09!Local buffer
X`09ptradr`09= .ptr_a`09: $BBLOCK,`09`09!Local pointer
X`09ustat`09= .stat_a;`09`09`09`09!Local status
X
XLOCAL
X`09old_ipl`09`09: UNSIGNED LONG,`09`09!Place to save old IPL
X`09wslock_range`09: VECTOR`5B2,LONG`5D`09`09!Addr range for $LKWSET
X`09`09`09  INITIAL (krnl_get_dclbuffer,`09!Lock down all code
X`09`09`09`09   wslock_end);`09`09!... from here to end
X
XREGISTER
X`09temp_ptr`09: REF $BBLOCK,
X`09temp`09`09: UNSIGNED LONG,
X`09ast_size`09: UNSIGNED LONG,
X`09acb_size`09: UNSIGNED LONG,
X`09acb_addr`09: REF $BBLOCK,
X`09ipid`09`09: UNSIGNED LONG,
X`09pcb`09`09: REF $BBLOCK,
X`09status`09`09: UNSIGNED LONG;
X
X  !
X  !  Page faulting is not allowed at IPLs above 2.  Because this routine
X  !  raises IPL to IPL$_SCHED, we must ensure that the routine is locked
X  !  into memory.  The $LKWSET system service is called to lock down all
X  !  the pages for this routine and the two AST routines.  The AST routines
X  !  are only accessed from IPL 2, but let's be safe and lock them down too.
X  !
X  status = $LKWSET (INADR  = wslock_range,`09`09!Lock this routine into
X`09`09    RETADR = wslock_range);`09`09!... memory
X  IF NOT(.status) THEN RETURN(.status);`09`09`09!Return any errors
X
X  !
X  !  Before allocating non-paged pool and initializing the extended ACB,
X  !  check to make sure that the target process exists and get its internal
X  !  PID (the IPID).
X  !
X  !  The process could be deleted while we're in this routine, but we
X  !  check its validity up front so that we don't waste the processing
X  !  time for a process that never existed.
X  !
X  IF ((ipid = .pid) EQLU 0)`09`09`09!If the specified PID is 0,
X  THEN`09`09`09`09`09`09!... then use our own process
X     !
X     ! It's inefficient to queue the ASTs to our own process when we could
X     ! just go get the buffer.  However, it *is* useful for debugging.
X     !
X     ipid = .CTL$GL_PCB`5BPCB$L_PID`5D`09`09!This process is the target
X  ELSE
X     BEGIN
X     !
X     !  Get the IPID of the target process.  We call EXE$EPID_TO_PCB instead
X     !  of EXE$EPID_TO_IPID because the latter doesn't check to see if eithe
Vr
X     !  PID is valid, while the former ensures that the IPID matches the IPI
VD
X     !  stored in the PCB, returning 0 if the process doesn't exist.
X     !
X     !  The SCHED spinlock is held while we copy the PID out of the PCB.
X     !  Because it is released afterward, it is possible that the process
X     !  could be deleted before the AST is queued.  SCH$QAST will catch
X     !  this condition.
X     !
X     $SYS_LOCK (LOCKNAME = SCHED,`09`09!Grab the SCHED spinlock
X`09`09SAVIPL   = old_ipl);`09`09!... Save IPL for restoring
X
X     !
X     !  EXE$EPID_TO_PCB is described in module SYSPCNTRL in the VMS source.
X     !
X     EXE$EPID_TO_PCB (.ipid; pcb);`09`09!Convert to PCB address
X
X     IF (.pcb NEQU 0)`09`09`09`09!Is the process real?
X     THEN`09`09`09`09`09!If so, copy the IPID out
X`09ipid = .pcb`5BPCB$L_PID`5D;`09`09`09!... of the PCB
X
X     $SYS_UNLOCK (LOCKNAME = SCHED,`09`09!Release the SCHED spinlock
X`09`09  NEWIPL = .old_ipl);`09`09!... and restore the IPL
X
X     IF (.pcb EQLU 0)`09`09`09`09!If there was no such process
X     THEN`09`09`09`09`09!... then return an error
X`09 RETURN (SS$_NONEXPR);`09`09`09!...
X
X     IF (.ipid LEQU .SCH$GL_SWPPID)`09`09!If the process is SWAPPER or
X     THEN`09`09`09`09`09!... NULL, return NOCLI error
X`09 RETURN (GETCMD_NOCLI);`09`09`09!... to caller
X
X     END;
X
X  !
X  !  At this point, the process exists (or did) and its IPID is stored in ip
Vid.
X  !
X  !  Clear the specified event flag using SCH$CLREF.  SCH$CLREF is described
X  !  in module SYSEVTSRV; it accepts two inputs: R3 = event flag number,
X  !  R4 = PCB address.  On success, it returns via RSB, otherwise it RETs,
X  !  eliminating the need to check for errors because it will RETurn to
X  !  the CMKRNL dispatcher.
X  !
X  status = SCH$CLREF (.efn, .CTL$GL_PCB);`09!Clear the event flag
X  !No need to check status....
X
X  !
X  !  Now raise IPL to 2 to avoid process deletion while non-paged pool is
X  !  is held.
X  !
X  $SETIPL (NEWIPL = IPL$_ASTDEL, ENVIRON=UNIPROCESSOR);
X
X  !
X  !  Now allocate an extended ACB from non-paged pool by calling
X  !  EXE$ALONONPAGED (in module MEMORYALC in SYS).
X  !
X  ast_size = CH$DIFF(wslock_end, ast_code);`09!Size of both AST routines
X  status = EXE$ALONONPAGED (.ast_size + ACB_K_LENGTH; acb_size, acb_addr);
X
X  IF (.status)`09`09`09`09`09!Enough memory allocated?
X  THEN`09`09`09`09`09`09!If so, begin filling in the
X    BEGIN`09`09`09`09`09!... fields in the ACB
X    acb_addr`5BACB$L_PID`5D = .ipid;`09`09!Save the PID of target process
X    acb_addr`5BACB$W_SIZE`5D = .acb_size;`09`09!Save size of ACB
X    acb_addr`5BACB$B_TYPE`5D = DYN$C_ACB;`09`09!Set type to ACB
X    MOVPSL(temp_ptr);`09`09`09`09!Get the current PSL
X    temp = .temp_ptr BITFLD(PSL$V_CURMOD);`09!Get our access mode (kernel)
X    acb_addr`5BACB$B_RMOD`5D = ACB$M_KAST OR .temp;`09!Store in ACB with Spe
Vcial KAST
X
X    !
X    !  Now fill in the extended ACB fields
X    !
X    acb_addr`5BACB_L_EFN`5D = .efn;`09`09`09!Store the event flag to set
X    acb_addr`5BACB_L_USERBUF`5D = bufadr;`09`09!Store the process buffer add
Vr
X    acb_addr`5BACB_L_USERPTR`5D = ptradr;`09`09!Store the process pointer ad
Vdr
X    acb_addr`5BACB_L_USERSTAT`5D = ustat;`09`09!Store the process status add
Vr
X    acb_addr`5BACB_L_PID`5D = .CTL$GL_PCB`5BPCB$L_PID`5D;`09!Store our PID
X    acb_addr`5BACB_L_IMGCNT`5D = .CTL$GL_PHD`5BPHD$L_IMGCNT`5D;`09!And our i
Vmage count
X
X    !
X    !  Now copy the AST routines to the extended ACB.
X    !
X    CH$MOVE(.ast_size, ast_code, acb_addr`5BACB_T_ASTCODE`5D);
X
X    acb_addr`5BACB$L_KAST`5D = acb_addr`5BACB_T_ASTCODE`5D;`09`09!AST addres
Vs
X    acb_addr`5BACB_L_2ND_KAST`5D = acb_addr`5BACB_T_ASTCODE`5D +`09!2nd AST
V address
X`09`09`09`09CH$DIFF(ast2_code, ast_code);
X
X    !
X    !  Now we're ready to queue the AST to the target process.  We could jus
Vt
X    !  call SCH$QAST, but it doesn't check to see if the target process is
X    !  swapped out of memory.  To avoid swapping the process into memory jus
Vt
X    !  to get its recall buffer, let's make those checks and then queue it..
V..
X    !
X    $SYS_LOCK (LOCKNAME = SCHED,`09`09!Grab the SCHED spinlock again
X`09       SAVIPL`09= old_ipl);`09`09!... and save the IPL
X    EXE$IPID_TO_PCB (.ipid; pcb);`09`09!Look up the PCB again
X    IF ((.pcb NEQU 0)`09`09`09AND`09!If there is a PCB and it is
X`09(.ipid EQLU .pcb`5BPCB$L_PID`5D)`09AND`09!... still the same process
X`09NOT(.pcb`5BPCB$V_DELPEN`5D)`09`09AND`09!... and delete is not pending
X`09NOT(.pcb`5BPCB$V_SUSPEN`5D)`09`09AND`09!... and suspend is not pending
X`09(.pcb`5BPCB$W_STATE`5D NEQU SCH$C_SUSP) AND`09!... and state is not SUSP,
X`09(.pcb`5BPCB$W_STATE`5D NEQU SCH$C_SUSPO) AND!... SUSPO, or MWAIT
X`09(.pcb`5BPCB$W_STATE`5D NEQU SCH$C_MWAIT))`09!...
X    THEN`09`09`09`09`09!Then queue the AST with a
X`09BEGIN`09`09`09`09`09!... priority increment
X`09status = SCH$QAST (PRI$_TICOM, .acb_addr; pcb);
X`09!
X`09!  If the AST was successfully queued to the target process and
X`09!  the process is in the COM state, temporarily boost its priority
X`09!  to match ours so this runs at quickly as possible.
X`09!
X`09IF ((.status) AND`09`09`09!If AST was queued and the
X`09    ((.pcb`5BPCB$W_STATE`5D EQLU SCH$C_COM) OR`09!... process is in
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-
