The ModulaTor

The ModulaTor
Erlangen's First Independent Modula_2 Journal! Nr. 10/Nov-1991 
______________________________________________________________

Batch Queue Information under VMS 

by Helmut Wiacker, Isotopenforschung Dr. Sauerwein GmbH, Bergische Str. 16, W-5657 Haan/Rheinland 1 

A simple Modula-2 program shows how to get and print information about VMS's batch queues using the 
LIB$GETQUI procedure. In the program QueTst I take advantage of so-called array- and record- 
constructors for the initialisation of data structures. This feature improves readability and helps to keep the 
source code short. Since there can be arbitrary many jobs in several queues, QueTst doesn't declare an 
array of fixed maximal size to store the jobs' information. Instead QueTst uses a ring buffer to dynamically 
allocate storage for each job. I chose a ring buffer as an appropriate data structure, since the each queue 
attribut or item of each job must be requested by an individual call of LIB$GETQUI. 

For compilation, I used the Modula-2 compiler MVR V3 from ModulaWare GmbH. Except for the standard 
library modules which come along with MVR, all separate modules imported by QueTst are included in 
source code below. 

The only problem I had, was the type of the parameter out_len in the VMS procedure LIB$GETQUI defined in 
module CommonInputOutputProcedures (see below). The VMS documentation specifies shortword data 
type for out_len, but obviously the type must be a longword (INTEGER). This error was corrected in the 
corresponding foreign definition module of the MVR distribution kit in Jan-1991. 

When QueTst is executed, it prints entry number, username, jobnumber, submission's date and time and the 
job status of the SYS$BATCH* queues, e.g.: 

__________________________________________________________________________________________________ 

2         SYSTEM   BATCH_JOB 22-OCT-1991 13:10:16.37      executing

__________________________________________________________________________________________________ 

MODULE QueTst;

FROM SYSTEM IMPORT SHORTWORD, NOP, CAST;
FROM Storage IMPORT ALLOCATE;
FROM String IMPORT Insert;
FROM SSDefinitions IMPORT SS$_NORMAL;
FROM CommonInputOutputProcedures IMPORT LIB$GETQUI;

FROM QUIDefinitions IMPORT
  QUI$_DISPLAY_QUEUE, QUI$_DISPLAY_JOB, QUI$_CANCEL_OPERATION,
  QUI$_QUEUE_NAME, QUI$_ENTRY_NUMBER, QUI$_USERNAME, 
  QUI$_JOB_NAME, QUI$_SUBMISSION_TIME, QUI$_JOB_STATUS, 
  QUI$_PENDING_JOB_REASON, QUI$M_JOB_ABORTING, 
  QUI$M_JOB_EXECUTING, QUI$M_JOB_HOLDING,
  QUI$M_JOB_INACCESSIBLE, QUI$M_JOB_PENDING, QUI$M_JOB_REFUSED,
  QUI$M_JOB_RETAINED, QUI$M_JOB_STARTING, QUI$M_JOB_SUSPENDED,
  QUI$M_JOB_TIMED_RELEASE;

FROM JBCMSGDefinitions IMPORT JBC$_NOMOREJOB;
FROM LibError IMPORT CheckError, CheckSuccessList;
FROM InOut IMPORT ReadInt, WriteString, WriteInt, WriteCard, WriteLn;
FROM Queue IMPORT ringptr, RingInsertA, NextElement;

CONST
  search_nam= 'SYS$BATCH*'; (* Must contain a wildcard character ! *)

TYPE
  typ14 = ARRAY [0..13] OF CHAR;
  typ31 = ARRAY [0..30] OF CHAR;
  typ80 = ARRAY [0..79] OF CHAR;
  jobstatus_type = (aborting, executing, holding, inaccessible, pending,
    refused, retained, starting, suspended, timed_release);
  jobstatus_rectype = ARRAY jobstatus_type OF RECORD
    val: CARDINAL;
    msg : typ14;
  END;
  itemtype= (entry_number,username,job_name,submission_time,job_status);
  item_code_type= ARRAY itemtype OF CARDINAL;
  strpos_type= ARRAY itemtype OF INTEGER;
  success_listtype= ARRAY [0..2] OF INTEGER;

VAR
  res_str: typ80;
  search_flg, status, res_val: CARDINAL;
  out_len: INTEGER;
  item: itemtype;
  item_code: item_code_type;
  strpos: strpos_type;
  stat_cnt: jobstatus_type;
  jobstatus_record: jobstatus_rectype;
  que_inf: POINTER TO typ80;
  ringstart, current: ringptr;
  success_list: success_listtype;

BEGIN
  ringstart:= NIL;
  success_list:= success_listtype[SS$_NORMAL, JBC$_NOMOREJOB, 0];
  strpos:= strpos_type [0,10,20,30,60];
  jobstatus_record:= jobstatus_rectype [
    [QUI$M_JOB_ABORTING, 'aborting     '],
    [QUI$M_JOB_EXECUTING, 'executing    '],
    [QUI$M_JOB_HOLDING, 'holding      '],
    [QUI$M_JOB_INACCESSIBLE,  'inaccessible '],
    [QUI$M_JOB_PENDING, 'pending      '],
    [QUI$M_JOB_REFUSED, 'refused      '],
    [QUI$M_JOB_RETAINED, 'retained     '],
    [QUI$M_JOB_STARTING, 'starting     '],
    [QUI$M_JOB_SUSPENDED, 'suspended    '],
    [QUI$M_JOB_TIMED_RELEASE, 'timed release']];

  item_code:= item_code_type[
    QUI$_ENTRY_NUMBER, QUI$_USERNAME, QUI$_JOB_NAME, QUI$_SUBMISSION_TIME, QUI$_JOB_STATUS];

  FOR item := MIN (itemtype) TO MAX (itemtype) DO
    CheckError(LIB$GETQUI (QUI$_CANCEL_OPERATION, NOP, NOP, NOP, NOP, res_val, res_str, out_len));
    CheckError(LIB$GETQUI (QUI$_DISPLAY_QUEUE, QUI$_QUEUE_NAME,NOP, search_nam, NOP, res_val, res_str, out_len));

    REPEAT
      status := LIB$GETQUI(QUI$_DISPLAY_JOB, item_code [item], NOP, NOP, NOP, res_val, res_str, out_len);
      CheckSuccessList(status,success_list);
      IF status = SS$_NORMAL THEN
        IF item = MIN (itemtype) THEN
          NEW (que_inf);
          RingInsertA (ringstart, current, que_inf);
        ELSE
          NextElement (current, que_inf);
        END;
        IF item # job_status THEN
          Insert(que_inf^, strpos [item], res_str);
        ELSE
          FOR stat_cnt := MIN(jobstatus_type) TO MAX(jobstatus_type) DO
            IF CAST(BITSET,jobstatus_record[stat_cnt].val)*CAST(BITSET,res_val)#{} THEN
              Insert (que_inf^, strpos [item], jobstatus_record [stat_cnt].msg)
            END
          END
        END
      END
    UNTIL status # SS$_NORMAL
  END;
  NextElement (current, que_inf);
  REPEAT
    WriteString(que_inf^);
    WriteLn;
    NextElement(current, que_inf)
  UNTIL current = ringstart;
END QueTst.

__________________________________________________________________________________________________ 

DEFINITION MODULE Queue ;
  (*by H. Wiacker, H. Busse: 06.12.89, bu/28.06.90: Ring, bu/17.12.90 Fifo *)

FROM SYSTEM IMPORT ADDRESS;

TYPE
  lifoptr  = POINTER TO lifotype;
  lifotype = RECORD
    next: lifoptr;
    datp: ADDRESS
  END;

PROCEDURE LifoIncrease (VAR top: lifoptr; data: ADDRESS);
(* adds one element at top of queue *)

PROCEDURE LifoDecrease (VAR top: lifoptr; VAR data: ADDRESS);
(* removes one element from top of queue, 
   data = contents of removed element *)

TYPE
  fifoptr  = POINTER TO fifotype;
  fifotype = RECORD
    next: fifoptr;
    datp: ADDRESS
  END;

PROCEDURE FifoIncrease (VAR bottom, top: fifoptr; data: ADDRESS);
(* adds one element at top of queue *)

PROCEDURE FifoDecrease (VAR bottom, top: fifoptr; VAR data: ADDRESS);
(* removes one element from bottom of queue, 
   data = contents of removed elem. *)

TYPE
  ringptr  = POINTER TO ringtype;
  ringtype = RECORD
    forwptr,backptr : ringptr;
    datp : ADDRESS;
  END;

(* set start := NIL before first call *)
PROCEDURE RingInsertA (VAR start, current: ringptr; data: ADDRESS);
(* Inserts after current element, sets pointer to new element *)

PROCEDURE RingInsertB (VAR start, current: ringptr; data: ADDRESS);
(* Inserts before current element, sets pointer to new element  *)

PROCEDURE RingDelete (VAR start, current: ringptr);
(* Deletes current element, sets pointer to previous element,
   sets start := NIL, if ring is deleted ! *)

PROCEDURE NextElement (VAR current: ringptr; VAR data: ADDRESS);

PROCEDURE PrevElement (VAR current: ringptr; VAR data: ADDRESS);
(* gets next (previous) element of ring *)

END Queue.

__________________________________________________________________________________________________ 

DEFINITION MODULE LibError ;

PROCEDURE CheckError ( status:INTEGER);

PROCEDURE CheckErrorList ( status:INTEGER; errorlist: ARRAY OF INTEGER );

PROCEDURE CheckSuccessList ( status:INTEGER; successlist: ARRAY OF INTEGER );

END LibError.

__________________________________________________________________________________________________ 

%FOREIGN DEFINITION MODULE CommonInputOutputProcedures; (* excerpt only *)
...
FROM SYSTEM IMPORT ADDRESS, BYTE, SHORTWORD, QUADWORD, WORD;
...

PROCEDURE LIB$GETQUI(
                function_code:    INTEGER;
                item_code:        INTEGER;
                search_number:    INTEGER;
       %STDESCR search_name:      ARRAY OF CHAR;
                search_flags:     CARDINAL;
                out_value:        ADDRESS;
   VAR %STDESCR out_string:       ARRAY OF CHAR;
   VAR          out_len:          INTEGER (*according to VMS-documentation: SHORTWORD*)
   ): CARDINAL;
...
END CommonInputOutputProcedures.

__________________________________________________________________________________________________ 

IMPLEMENTATION MODULE Queue;

FROM SYSTEM IMPORT ADDRESS;

FROM Storage IMPORT ALLOCATE,DEALLOCATE;

PROCEDURE LifoIncrease (VAR top:lifoptr; data:ADDRESS);
VAR new:lifoptr;
BEGIN
  NEW(new);
  new^.datp:=data;
  new^.next:=top;
  top:=new;
END LifoIncrease;

PROCEDURE LifoDecrease (VAR top: lifoptr; VAR data: ADDRESS);
VAR cancel:lifoptr;
BEGIN
  cancel:=top;
  data := cancel^.datp;
  top:=top^.next;
  DISPOSE(cancel);
END LifoDecrease;

PROCEDURE FifoIncrease (VAR bottom, top: fifoptr; data: ADDRESS);
VAR new:fifoptr;
BEGIN
  IF bottom = NIL THEN
    NEW (bottom);
    top := bottom;
  ELSE
    NEW (new);
    top^.next := new;
    top := new;
  END;
  top^.datp := data;
  top^.next := NIL;
END FifoIncrease;

PROCEDURE FifoDecrease (VAR bottom, top: fifoptr; VAR data: ADDRESS);
VAR cancel: fifoptr;
BEGIN
  cancel := bottom;
  data := cancel^.datp;
  bottom := cancel^.next;
  DISPOSE (cancel);
END FifoDecrease;

PROCEDURE RingInsertA (VAR start, current: ringptr; data: ADDRESS);
VAR insert: ringptr;
BEGIN
  IF start = NIL THEN
    NEW (start);
    start^.forwptr := start;
    start^.backptr := start;
    current := start;
  ELSE
    NEW (insert);
    insert^.forwptr := current^.forwptr;
    insert^.backptr := current;
    current^.forwptr^.backptr := insert;
    current^.forwptr := insert;
    current := insert;
  END;
  current^.datp := data;
END RingInsertA;

PROCEDURE RingInsertB (VAR start, current: ringptr; data: ADDRESS);
VAR insert: ringptr;
BEGIN
  IF start = NIL THEN
    NEW (start);
    start^.forwptr := start;
    start^.backptr := start;
    current := start;
  ELSE
    NEW (insert);
    insert^.forwptr := current;
    insert^.backptr := current^.backptr;
    current^.backptr^.forwptr := insert;
    current^.backptr := insert;
    current := insert;
  END;
  current^.datp := data;
END RingInsertB;

PROCEDURE RingDelete (VAR start,current: ringptr);
VAR delete: ringptr;
BEGIN
  delete := current;
  IF delete = delete^.forwptr THEN
    start := NIL;
  ELSE
    delete^.forwptr^.backptr := delete^.backptr;
    delete^.backptr^.forwptr := delete^.forwptr;
    current := delete^.backptr;
  END;
  DISPOSE (delete);
END RingDelete;

PROCEDURE NextElement (VAR current: ringptr; VAR data: ADDRESS);
BEGIN
  current := current^.forwptr;
  data := current^.datp;
END NextElement;

PROCEDURE PrevElement (VAR current: ringptr; VAR data: ADDRESS);
BEGIN
  current := current^.backptr;
  data := current^.datp;
END PrevElement;

END Queue.

__________________________________________________________________________________________________ 

IMPLEMENTATION MODULE LibError ;

FROM ConditionHandlingProcedures IMPORT LIB$SIGNAL;

PROCEDURE CheckError ( status:INTEGER);
BEGIN
  IF NOT ODD(status) THEN
    LIB$SIGNAL(status)
  END
END CheckError;

PROCEDURE CheckErrorList ( status:INTEGER; errorlist:ARRAY OF INTEGER);
VAR i: INTEGER;
  found: BOOLEAN;
BEGIN
  i:=0;
  found:=FALSE;
  WHILE NOT ((errorlist[i]=0) OR found) DO
    IF status = errorlist[i] THEN
      LIB$SIGNAL(status);
      found:=TRUE;
    END;
    INC(i);   
  END;
END CheckErrorList;
  
  
PROCEDURE CheckSuccessList ( status:INTEGER; successlist:ARRAY OF INTEGER);
VAR i: INTEGER;
  found: BOOLEAN;
BEGIN
  i:=0;
  found:=FALSE;
  WHILE (successlist[i]#0) AND (NOT found) DO
    IF status=successlist[i] THEN
      found:=TRUE;
    END;
    INC(i);
  END;
  IF NOT found THEN
    LIB$SIGNAL(status);
  END;
END CheckSuccessList;

END LibError.

__________________________________________________________________________________________________ 

IMPRESSUM: The ModulaTor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements. Items are printed at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. Office of publication: The Editor of The ModulaTor is Guenter Dotzel; he can be reached by tel/fax: [removed due to abuse] or by mailto:[email deleted due to spam]
  ModulaWare home page   The ModulaTor download