Google
 

Trailing-Edge - PDP-10 Archives - BB-JF18A-BM - sources/diu/diusho.b36
There are 4 other files named diusho.b36 in the archive. Click here to see a list.
%TITLE 'Data Interchange Utility Show Queue'

MODULE DIUSHO(IDENT = '252',
              LANGUAGE(BLISS36),
              ENTRY(SHOQUE)             ! SHOW REQUEST
              ) =
BEGIN

!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
!	ALL RIGHTS RESERVED.
!
!	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
!	THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE  OR
!	ANY  OTHER  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
!	AVAILABLE TO ANY OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE
!	SOFTWARE IS HEREBY TRANSFERRED.
!
!	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!	EQUIPMENT CORPORATION.
!
!	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
! FACILITY:	DIU    Data Interchange Utility
!
! ENVIRONMENT:  TOPS-20 V6.1    XPORT      
!		BLISS-36 V4     FAO-36
!
! ABSTRACT:     This module dumps a DIU request block to the file specified
!               by the RAB's associated $FAB, or to the TTY if no RAB given.
!
! AUTHOR:  Rick Fricchione			CREATED: 30-Oct-1984
! HISTORY:
!
!  252	Remove library of CONDIT.
!	Sandy Clemens  1-Jul-86
!
!  215  Call IP_FIND from SHOQUE to simplify things.
!       Gregory A. Scott 3-Jun-86
!
!  174  Remove library of TOPS20.
!       Gregory A. Scott 20-May-86
!
!  164  Using RMS for terminal IO was  causing us problems: If we were  showing
!       the queues when we  got an IPCF  interrupt, we would  bomb out with  "?
!       Channel 0 interrupt at blah" because the chntab entry points to a PUSHJ
!       P,INTHAN instruction,  but the  stack  is in  section  3 so  the  PUSHJ
!       doesn't work.  Cure is to not use RMS for terminal IO when showing  the
!       queues.
!       Gregory A. Scott 16-May-86
!
!  161  Don't attempt to display information that is not returned to us because
!       we are not prived or the owner of the request even if SHOW QUEUE/ALL.
!       Gregory A. Scott 14-May-86
!
!  156  Remove reference to DIU$H_TRIES since it it not implemented.
!       Gregory A. Scott 13-May-86
!
! 121   Bug in  SHO_FILES  caused it  to  move  way too  many  characters  when
!       excluding the  access  string.  This  bug  was  covered up  by  bug  in
!       DEF$ACCESS which gave an  extra null after  each filespec (which  broke
!       LOG files among other things).
!       Gregory A. Scott 19-Apr-86
!
! 117   Change "entry"  to  "request  number",  reformat  show  queue  display.
!       Rename DIU$$SHO_FULL  to be  SHO_ALL and  DIU$SFILES to  be  SHO_FILES.
!       Make fao fabs in own storage.
!       Gregory A. Scott 17-Apr-86
!
! 114   Show the passwords always if /DEBUG switch is on in DIU$SFILES.
!       Gregory A. Scott 8-Apr-86
!
! 104   Show the source and destination files on SHOW QUEUE/ALL.
!       Adds routine DIU$SFILES, called only by DIU$$SHO_ALL.
!       Gregory A. Scott 31-Mar-86
!
!    46  Remove /NOTIFY:FAILURE code.
!        Sandy Clemens	4-Nov-85
!
!    40  Put the REQUIRE/LIBRARY of 'TOPS20' into a TOPS-20 only
!        conditional.
!        Sandy Clemens  7-Oct-85
!
!	RDF0001	V01-000		Rick Fricchione		1-Nov-1984
!		Original version of DIU$SHO_
!
!--
%SBTTL 'Libraries and Externals'

! Libraries

LIBRARY 'BLI:XPORT';                    ! XPORT of course
LIBRARY 'FAO';                          ! FAO services
LIBRARY 'DIU';                          ! DIU Data Structures

! Externals

EXTERNAL tty : $XPO_IOB();              ! IOB for the TTY

EXTERNAL ROUTINE IP_FIND;               ! Find a chain of requests

! Forward Routine

FORWARD ROUTINE sho_files : NOVALUE,    ! Print filenames on terminal
                sho_all : NOVALUE,      ! Print extened queue listing
                shoque : NOVALUE;       ! Print queue listing
%SBTTL 'FAO Output'

! Define FAO output buffers

LITERAL fao_buf_len = 160;              ! fao_buf size in bytes

OWN fao_desc : $STR_DESCRIPTOR(CLASS=BOUNDED),
    fao_buf :  VECTOR[CH$ALLOCATION(fao_buf_len)];

! Macro to print a FAOized string to the terminal

MACRO $put_fao (control) = 

      BEGIN

      LOCAL fao_ctl : $STR_DESCRIPTOR(STRING=%STRING(control,%CHAR(13,10)));

      $STR_DESC_INIT(DESC=fao_desc,           ! Re-init the buffer
                     CLASS=BOUNDED,
                     STRING=(fao_buf_len,CH$PTR(fao_buf)));

      $FAO(fao_ctl,0,fao_desc,%REMAINING);    ! Format string

      $XPO_PUT(IOB=tty,                       ! Slurp to terminal
               STRING=fao_desc);

      END %;

! Macro to put a string to the terminal without a trailing crlf

MACRO $append_fao (control) = 

      BEGIN

      LOCAL fao_ctl : $STR_DESCRIPTOR(STRING=control);

      $STR_DESC_INIT(DESC=fao_desc,           ! Re-init the buffer
                     CLASS=BOUNDED,
                     STRING=(fao_buf_len,CH$PTR(fao_buf)));

      $FAO(fao_ctl,0,fao_desc,%REMAINING);    ! Format string

      $XPO_PUT(IOB=tty,                       ! Slurp to terminal
               STRING=fao_desc);

      END %;
%SBTTL 'Routine SHO_FILES'

ROUTINE sho_files (p_buffer,p_length,p_descr,p_dlength,
                   p_source_or_dest): NOVALUE = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine shows the source or destination filenames that are
!       listed in the given buffer.  Called only from SHO_ALL.
!
! FORMAL PARAMETERS:
!
!       p_buffer          Filespec buffer address
!       p_length          Filespec buffer length in characters
!       p_source_or_dest  'Source:' or 'Destination:'
!       p_descr           Description filespec  buffer address
!       p_dlength         Description filespec length in characters
!
!--
BIND
         buffer = .p_buffer,
         length = p_length,
         descr = .p_descr,
         dlength = p_dlength,
         source_or_dest = .p_source_or_dest;

LOCAL
         file_ptr, next_ptr, file_rem, file_len, prt_flg,
         b_acc_ptr, e_acc_ptr, n_len, f_len,
         temp_file: VECTOR[CH$ALLOCATION(DIU$K_NORMAL_FILE_SIZE)];

! Init flag and pointer to the filespecs

prt_flg = 0;                            ! We haven't printed anything yet
file_ptr = CH$PTR(buffer);              ! Point to filespec buffer
file_rem = .length;                     ! Remaining chars in buffer

DO BEGIN
    next_ptr = CH$FIND_CH(.file_rem,.file_ptr,$ETG); ! find start of a filespec
    IF CH$FAIL(.next_ptr) THEN EXITLOOP;        ! Return if no more tags

    file_len = CH$A_RCHAR(next_ptr);    ! Get length of this file spec
    IF .file_len EQL 0 THEN EXITLOOP;   ! Return if finished

    file_rem = .file_rem-(2+.file_len); ! Compute chars remaining
    file_ptr = CH$PLUS(.next_ptr,1);    ! Skip over the count byte

! Remove any access control stuff and  copy the filespec to temp_file.   First,
! search for a quote followed by a double colon, which is the end of the access
! control string.  If it was found look for the first quote which is the  start
! of the access control string, and if its present, copy the node name  (before
! the first quote) and the double colon and filename to the temp_file area.  If
! there is no access control information, just copy the whole filespec over  to
! temp_file.

%IF %SWITCHES(DEBUG)                    ! IF debugging mode
%THEN CH$COPY(.file_len,.file_ptr,      ! Print the whole thing always
                  0,DIU$K_NORMAL_FILE_SIZE,CH$PTR(temp_file));
%ELSE
    e_acc_ptr = CH$FIND_SUB(.file_len,.file_ptr,3,CH$PTR(UPLIT('"::')));
    IF NOT CH$FAIL(.e_acc_ptr) 
    THEN BEGIN
         b_acc_ptr = CH$FIND_CH(.file_len,.file_ptr,%C'"');
         IF NOT CH$FAIL(.b_acc_ptr) 
         THEN BEGIN
              n_len = CH$DIFF(.b_acc_ptr,.file_ptr);    ! Get # chars in node
              e_acc_ptr = CH$PLUS(.e_acc_ptr,1);        ! Get past the ending "
              f_len = .file_len - CH$DIFF(.e_acc_ptr,.file_ptr); ! Chars in fs
              CH$COPY(.n_len,.file_ptr,                 ! Move the node
                      .f_len,.e_acc_ptr,                ! and the rest
                      0,DIU$K_NORMAL_FILE_SIZE,CH$PTR(temp_file)); ! to display
              END;
         END 
     ELSE CH$COPY(.file_len,.file_ptr,
                  0,DIU$K_NORMAL_FILE_SIZE,CH$PTR(temp_file));
%FI

! The sanitized  file spec  is now  in  temp_file, ready  to print.   Output  a
! description field if we are through here  for the first time followed by  the
! filespec and a cr lf.  If coming here after the first time, just output  some
! spaces to line up the filespec.

    IF .prt_flg THEN
                     $PUT_FAO('!_             !AZ',CH$PTR(temp_file))
                ELSE BEGIN
                     prt_flg = 1;       ! We have printed the prolog line
                     $PUT_FAO('!_!AZ!AZ',
                                 CH$PTR(source_or_dest),CH$PTR(temp_file));
                     END;

! Do until the entire buffer has been examined, signified by a 0 length byte.

END WHILE .file_rem NEQ 0;

!Output description file, if present.

IF .dlength NEQ 0 THEN $PUT_FAO('!2(_)     Description: !AZ',CH$PTR(descr));

END;                                    ! sho_files
%SBTTL 'Routine SHO_ALL'

ROUTINE sho_all (request: REF $DIU_BLOCK): NOVALUE  = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!       This routine will display  items only seen when  /FULL is added to  the
!       SHOW command.  This adds the finer level of detail to the request block
!       display.  All available information we  can pry from the request  block
!       is displayed if it is set.
!
!
! FORMAL PARAMETERS:
!
!	request  	Address of a DIU request block which will 
!			be displayed.
!
!
!--

IF .request[DIU$H_SOURCE_FILESPEC] NEQ 0        ! We were passed anything?
THEN BEGIN                                      ! Yes, show it

     ! Print the source and destination filespecs

     SHO_FILES(request[DIU$T_SOURCE_FILESPEC],
               .request[DIU$H_SOURCE_FILESPEC],
               request[DIU$T_SOURCE_DESCRIPTION],
               .request[DIU$H_SOURCE_DESCRIPTION],
               UPLIT(%ASCIZ'Source:      '));

     SHO_FILES(request[DIU$T_DESTINATION_FILESPEC],
               .request[DIU$H_DESTINATION_FILESPEC],
               request[DIU$T_DESTINATION_DESCRIPTION],
               .request[DIU$H_DESTINATION_DESCRIPTION],
               UPLIT(%ASCIZ'Destination: '));

     ! Print transformation filespec

     IF .request[DIU$H_TRANSFORM] NEQ 0
     THEN $PUT_FAO('!_Transform:   !AZ',CH$PTR(request[DIU$T_TRANSFORM]));

     ! Print the log file spec, None if none

     IF .request[DIU$H_LOG_FILESPEC] EQL 0
     THEN $PUT_FAO('!_Log File:    none')
     ELSE $PUT_FAO('!_Log File:    !AD',.request[DIU$H_LOG_FILESPEC],
                                    CH$PTR(request[DIU$T_LOG_FILESPEC]));

     ! Print creation date-time of request

     $PUT_FAO('!_Creation:    !20%D',.request[DIU$G_CREATION]);

     ! Minimum starting time

     IF .request[DIU$G_AFTER] NEQ 0
     THEN $PUT_FAO('!_After:       !20%D',.request[DIU$G_AFTER]);

     ! Deadline job must complete by

     IF .request[DIU$G_DEADLINE] NEQ 0
     THEN $PUT_FAO('!_Deadline:    !20%D',.request[DIU$G_DEADLINE]);

     ! Notify code and priority

     $PUT_FAO('!_Priority:    !SW     Notify: !AZ',
              .request[DIU$B_PRIORITY],
              (IF .request[DIU$V_NOTIFY_MAIL] 
               THEN CH$PTR(UPLIT(%ASCIZ'Mail'))
               ELSE IF .request[DIU$V_NOTIFY_TERMINAL]
                    THEN CH$PTR(UPLIT(%ASCIZ'Terminal'))
                    ELSE CH$PTR(UPLIT(%ASCIZ'None'))));

     ! Any dependent requests?  If so display the information

     IF .request[DIU$H_DEPENDENT_ID] NEQ 0 
        OR .request[DIU$H_PREREQUISITE_ID] NEQ 0
     THEN BEGIN
          $APPEND_FAO('!_Sequence:    !AZ',
                      (IF .request[DIU$V_SEQ_CONTINUE]
                       THEN CH$PTR(UPLIT(%ASCIZ'Continue'))
                       ELSE CH$PTR(UPLIT(%ASCIZ'Abort'))));
          IF .request[DIU$H_DEPENDENT_ID] NEQ 0
             THEN $APPEND_FAO(', Dependent: !SW',
                              .request[DIU$H_DEPENDENT_ID]);
          IF .request[DIU$H_PREREQUISITE_ID] NEQ 0
          THEN $APPEND_FAO(', Prerequisite: !SW',
                           .request[DIU$H_PREREQUISITE_ID]);
          $PUT_FAO(' ');
          END;

     ! Show how many requeues have taken place - we never get tired.

     IF .request[DIU$G_REQUEUE_COUNT] NEQ 0
     THEN $PUT_FAO('!_Requeues:    !SL',
                   .request[DIU$G_REQUEUE_COUNT]);

     END;                               ! End of "if we were passed anything"

! A blank line for neatness.

$PUT_FAO(' ');

END;                                    ! sho_all
%SBTTL 'Routine SHOQUE'

GLOBAL ROUTINE SHOQUE (p_req_block, verbosity) : NOVALUE = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!       List the queue.  We send a FIND request to the DIU master job via IPCF,
!       receive zero  or more  request blocks,  and list  them in  intelligible
!       form.
!
! FORMAL PARAMETERS:
!
!       p_req_block: pointer to request block to match on
!       verbosity: Level to list, TRUE if listing all
!
!--

BIND req_block = .p_req_block : $DIU_BLOCK;

LOCAL chain,
      retcode,
      job_status,
      request  : REF $DIU_BLOCK;

%IF %SWITCHES (TOPS10) 
%THEN
LOCAL user_number_desc : $STR_DESCRIPTOR(CLASS=BOUNDED),
      user_number : VECTOR[CH$ALLOCATION(16)];
%FI

OWN function: VECTOR[8] INITIAL(UPLIT(%ASCIZ'COPY'),
                                UPLIT(%ASCIZ'APPEND'),
                                UPLIT(%ASCIZ'DELETE'),
                                UPLIT(%ASCIZ'RENAME'),
                                UPLIT(%ASCIZ'PRINT'),
                                UPLIT(%ASCIZ'SUBMIT'),
                                UPLIT(%ASCIZ'DIRECTORY'));

! Get the chain of requests that match what the user asked for.

IF NOT (retcode = ip_find (req_block, chain))
THEN IF .retcode EQL DIU$_QUEUE_EMPTY
     THEN BEGIN
          $XPO_PUT (IOB = tty,
                    STRING = %STRING('[The queue is empty]',%CHAR(13,10)));
          RETURN;
          END
     ELSE BEGIN
          SIGNAL(.retcode);
          END;

! We know that the queue isn't empty, so output the headers

$PUT_FAO('!/!AZ!2(_)!%D!/Request Queue Display!/',diu$$system_banner,0);
$PUT_FAO('Jobname Req #  Function  Status   Username');
$PUT_FAO('------- ----- --------- --------- --------');

! Processing loop starts here.  List each request in the chain.

DO BEGIN

   BIND request = .chain + %UPVAL : $DIU_BLOCK;


   job_status = (IF .request[DIU$V_HOLDING] 
                    THEN CH$PTR(UPLIT(%ASCIZ' holding'))
                    ELSE IF .request[DIU$V_ACTIVE]
                         THEN CH$PTR(UPLIT(%ASCIZ'executing'))
                         ELSE IF .request[DIU$V_DELETED]
                                 THEN CH$PTR(UPLIT(%ASCIZ' deleted'))
                                 ELSE CH$PTR(UPLIT(%ASCIZ' pending')));


%IF %SWITCHES (TOPS20) %THEN            ! TOPS-20 ONLY

   $PUT_FAO(' !7AZ!4SW  !10AZ!10AZ!AD',
            CH$PTR(request[DIU$T_JOBNAME]),
            .request[DIU$H_REQUEST_ID],
            CH$PTR(.function[.request[DIU$H_FUNCTION]-1]),
            .job_status,
            .request[DIU$H_USERNAME],
            CH$PTR(request[DIU$T_USERNAME]));

%ELSE                                   ! TOPS-10 ONLY

! Create a string of the form "[10,33]" from the project programmer number

   $STR_DESC_INIT(DESC = user_number_desc, STRING = (15, CH$PTR(user_number)));
   $STR_COPY(TARGET = user_number_desc,
	STRING = $STR_CONCAT(
            '[',
	    $STR_ASCII(.(request[DIU$G_USER_NUMBER])<lh>,BASE8,LEADING_BLANK),
	    ',',
	    $STR_ASCII(.(request[DIU$G_USER_NUMBER])<rh>,BASE8,LEADING_BLANK),
	    ']'));

   $PUT_FAO('!8AZ!4SW  !10AZ!10AZ!AD !AS',
            CH$PTR(request[DIU$T_JOBNAME]),
            .request[DIU$H_REQUEST_ID],
            CH$PTR(.function[.request[DIU$H_FUNCTION]]),
            .job_status,
            .request[DIU$H_USERNAME],
            CH$PTR(request[DIU$T_USERNAME],
            user_number_desc));
%FI                                     ! END TOPS-10 / TOPS-20 CONDITIONAL

! If we are being verbose today, then spill our guts about this request.

   IF .verbosity                        ! If SHOW QUEUE /ALL
   THEN sho_all(request);               ! then display them

! Continue until no more jobs in the chain

   END UNTIL (chain = ..chain) EQL 0;

! Print a blank line, close the show fab, and return normally

IF NOT .verbosity THEN $PUT_FAO(' ');

END;                                    ! SHOQUE
END 
ELUDOM