[inherit ('sys$library:starlet')] program snoopy (input,output);

type
    buffer_type = packed array [1..255] of char;
    $quad       = [quad,unsafe] record
                      u0  : unsigned;
                      l1  : integer;
                  end;
    $ubyte      = [byte] 0..255;
    $uquad      = [quad,unsafe] record
                      u0  : unsigned;
                      u1  : unsigned;
                  end;
    $uword      = [word] 0..65535;

    descriptor  = record
                      count : integer;
                      addr  : [unsafe] integer;
                  end;

    dummy_rec   = record
                  end;

    obastlist   = record
                      pstbd_id  : [volatile] unsigned;
                      astarg    : [volatile] unsigned;
                      ascii_chr : [volatile] unsigned;
                  end;

    integeritem = packed record
                      len : $uword;
                      code    : $uword;
                      addr    : [unsafe] ^ [unsafe] dummy_rec;
                      retlen  : ^integer;
                  end;

    stringitem  = packed record
                      len : $uword;
                      code    : $uword;
                      addr    : [unsafe] ^ [unsafe] buffer_type;
                      retlen  : ^integer;
                  end;


const
    %include    'sys$library:passtatus.pas/nolist'
    space       = ' ';


var
    account         : [volatile] packed array [1..10] of char;
    account_len     : [volatile] integer;
    astcnt          : [volatile] integer;
    astcnt_atr	    : unsigned;
    astcnt_old      : integer;
    astlm           : [volatile] integer;
    authpriv        : [volatile] $uquad;
    avpgflts        : integer;
    avpgflts_atr    : unsigned;
    avpgflts_del    : integer;
    avpgflts_del_atr: unsigned;
    avpgflts_del_old: integer;
    avpgflts_old    : integer;
    biocnt          : [volatile] integer;
    biocnt_atr      : unsigned;
    biocnt_old      : integer;
    biolm           : [volatile] integer;
    brdcast         : [volatile,static] boolean;
    bufio           : [volatile] integer;
    bufio_atr       : unsigned;
    bufio_delta     : integer
                    := 0;
    bufio_delta_atr : unsigned;
    bufio_delta_old : integer;
    bufio_old       : integer;
    bytcnt          : [volatile] integer;
    bytcnt_atr      : unsigned;
    bytcnt_old      : integer;
    bytlm           : [volatile] integer;
    bytlm_atr       : unsigned;
    bytlm_old       : integer;
    cliname         : [volatile] packed array [1..39] of char;
    cliname_len     : [volatile] integer;
    cpulim          : [volatile] integer;
    cpulim_quad     : $quad;
    cputim          : [volatile] integer;
    cputim_atr      : unsigned;
    cputim_delt     : integer
                    := 0;
    cputim_delt_atr : unsigned;
    cputim_delt_old : integer;
    cputim_old      : integer;
    cputim_pct      : integer
                    := 0;
    cputim_pct_atr  : unsigned;
    cputim_pct_old  : integer;
    cputim_quad     : $quad;
    curpriv         : [volatile] $uquad;
    curpriv_atr     : unsigned;
    curpriv_old     : $uquad;
    curtime         : $quad;
    curtime_atr     : unsigned;
    curtime_str     : packed array [1..23] of char;
    delay_time      : $quad;
    dfwscnt         : [volatile] integer;
    diocnt          : [volatile] integer;
    diocnt_atr      : unsigned;
    diocnt_old      : integer;
    diolm           : [volatile] integer;
    dirio           : [volatile] integer;
    dirio_atr       : unsigned;
    dirio_delta     : integer
                    := 0;
    dirio_delta_atr : unsigned;
    dirio_delta_old : integer;
    dirio_old       : integer;
    dummy           : integer;
    elapstim        : $quad;
    elapstim_atr    : unsigned;
    elapstim_int    : integer;
    elapstim_old    : integer;
    elapstim_str    : packed array [1..16] of char;
    enqcnt          : [volatile] integer;
    enqcnt_atr      : unsigned;
    enqcnt_old      : integer;
    enqlm           : [volatile] integer;
    filcnt          : [volatile] integer;
    filcnt_atr      : unsigned;
    filcnt_old      : integer;
    fillm           : [volatile] integer;
    first_pass      : boolean
                    := true;
    freptecnt       : [volatile] integer;
    gpgcnt          : [volatile] integer;
    gpgcnt_atr      : unsigned;
    gpgcnt_old      : integer;
    hilite          : packed array [0..4] of char;
    imagecount      : [volatile] integer;
    imagecount_atr  : unsigned;
    imagecount_old  : integer;
    imagname        : [volatile] packed array [1..63] of char;
    imagname_atr    : unsigned;
    imagname_len    : [volatile] integer;
    imagname_old    : packed array [1..63] of char;
    imagpriv        : [volatile] $uquad;
    imagpriv_atr    : unsigned;
    imagpriv_old    : $uquad;
    input_line      : varying [63] of char;
    input_line_len  : $uword;
    interval        : integer;
    iosb            : [volatile] $uquad;
    jobprccnt       : [volatile] integer;
    jobprccnt_atr   : unsigned;
    jobprccnt_old   : integer;
    junk_int        : integer;
    keybd_id        : [volatile, static] unsigned;
    logintim_str    : packed array [1..23] of char;
    logintim        : [volatile] $uquad;
    logintim_len    : [volatile] integer;
    master_pid      : [volatile] integer;
    maxjobs         : [volatile] $uword;
    mode            : [volatile] integer;
    mode_len        : integer;
    mode_str        : packed array [1..10] of char;
    msg_block       : [volatile, static] packed array [1..255] of char;
    msg_len         : [volatile, static] integer;
    normal          : packed array [0..3] of char;
    offset          : integer;
    one_second      : $quad;
    page            : packed array [1..1920] of char;
    page_len        : $uword;
    pageflts        : [volatile] integer;
    pageflts_atr    : unsigned;
    pageflts_del    : integer
                    := 0;
    pageflts_del_atr: unsigned;
    pageflts_del_old: integer;
    pageflts_old    : integer;
    pagfilcnt       : [volatile] integer;
    pasteboard_id   : [volatile,static] unsigned;
    pgflquota       : [volatile] integer;
    pgflquota_atr   : integer;
    pgflquota_old   : integer;
    phdflags        : [volatile] unsigned;
    phdflags_atr    : unsigned;
    phdflags_old    : unsigned;
    physmem         : integer;
    physmem_atr     : unsigned;
    physmem_old     : integer;
    pid             : [volatile] unsigned;
    pidarray        : array [0..255] of unsigned;
    pidindex        : integer;
    pidroot         : [volatile] unsigned;
    ppgcnt          : [volatile] integer;
    ppgcnt_atr      : unsigned;
    ppgcnt_old      : integer;
    prccnt          : [volatile] integer;
    prccnt_atr      : unsigned;
    prccnt_old      : integer;
    prclm           : [volatile] integer;
    prcnam          : [volatile] packed array [1..15] of char;
    prcnam_atr      : unsigned;
    prcnam_len      : [volatile] integer;
    prcnam_old      : packed array [1..15] of char;
    pri             : [volatile] integer;
    pri_atr         : unsigned;
    pri_old         : integer;
    prib            : [volatile] integer;
    prib_atr        : unsigned;
    prib_old        : integer;
    prmlst          : [unsafe] array [1..2] of integer;
    proc_index      : [volatile] integer;
    proc_index_base : integer
                    := 0;
    procpriv        : [volatile] $uquad;
    quadzero        : $quad
                    := (0,0);
    refresh         : [volatile,static] boolean
                    := true;
    retstatus       : unsigned;
    runtim          : $quad;
    runtim_str      : packed array [1..15] of char;
    state           : [volatile] integer;
    state_atr       : unsigned;
    state_len       : integer;
    state_old       : integer;
    state_str       : packed array [1..6] of char;
    sts             : [volatile] unsigned;
    sts_atr         : unsigned;
    sts_old         : unsigned;
    suspended       : boolean
                    := true;
    terminal        : [volatile] packed array [1..7] of char;
    terminal_len    : [volatile] integer;
    tqcnt           : [volatile] integer;
    tqcnt_atr       : unsigned;
    tqcnt_old       : integer;
    tqlm            : [volatile] integer;
    uaf_flags       : [volatile] unsigned;
    uic             : [volatile] unsigned;
    update          : boolean;
    username        : [volatile] packed array [1..12] of char;
    username_len    : [volatile] integer;
    virtdisp_1      : [volatile,static] unsigned;
    virtdisp_2      : [volatile,static] unsigned;
    virtdisp_3      : [volatile,static] unsigned;
    virtdisp_4      : [volatile,static] unsigned;
    virtmem         : integer;
    virtmem_atr     : unsigned;
    virtmem_old     : integer;
    virtpgcnt       : [volatile] integer;
    virtpeak        : [volatile] integer;
    virtpeak_atr    : unsigned;
    virtpeak_old    : integer;
    wait_time       : $quad;
    wsextent        : [volatile] integer;
    wspeak          : [volatile] integer;
    wspeak_atr      : unsigned;
    wspeak_old      : integer;
    wsquota         : [volatile] integer;
    wssize          : [volatile] integer;
    wssize_atr      : unsigned;
    wssize_old      : integer;
    zero_atr        : unsigned;

    initlist        : packed record
                          iaccount    : stringitem;
                          ilogintim   : integeritem;
                          iimagname   : stringitem;
                          istate      : integeritem;
                          ipid        : integeritem;
                          iprcnam     : stringitem;
                          iproc_index : integeritem;
                          iuic        : integeritem;
                          iusername   : stringitem;
                          listend     : integer;
                      end;

    jpilist         : packed record
                          jaccount    : stringitem;
                          jastcnt     : integeritem;
                          jastlm      : integeritem;
                          jauthpriv   : integeritem;
                          jbiocnt     : integeritem;
                          jbiolm      : integeritem;
                          jbufio      : integeritem;
                          jbytcnt     : integeritem;
                          jbytlm      : integeritem;
                          jcliname    : stringitem;
                          jcpulim     : integeritem;
                          jcputim     : integeritem;
                          jcurpriv    : integeritem;
                          jdfwscnt    : integeritem;
                          jdiocnt     : integeritem;
                          jdiolm      : integeritem;
                          jdirio      : integeritem;
                          jenqcnt     : integeritem;
                          jenqlm      : integeritem;
                          jfilcnt     : integeritem;
                          jfillm      : integeritem;
                          jfreptecnt  : integeritem;
                          jgpgcnt     : integeritem;
                          jimagecount : integeritem;
                          jimagname   : stringitem;
                          jimagpriv   : integeritem;
                          jjobprccnt  : integeritem;
                          jlogintim   : integeritem;
                          jmaster_pid : integeritem;
                          jmaxjobs    : integeritem;
                          jmode       : integeritem;
                          jpageflts   : integeritem;
                          jpagfilcnt  : integeritem;
                          jpgflquota  : integeritem;
                          jphdflags   : integeritem;
                          jpid        : integeritem;
                          jppgcnt     : integeritem;
                          jprccnt     : integeritem;
                          jprclm      : integeritem;
                          jprcnam     : stringitem;
                          jpri        : integeritem;
                          jprib       : integeritem;
                          jproc_index : integeritem;
                          jprocpriv   : integeritem;
                          jstate      : integeritem;
                          jsts        : integeritem;
                          jterminal   : stringitem;
                          jtqcnt      : integeritem;
                          jtqlm       : integeritem;
                          juaf_flags  : integeritem;
                          juic        : integeritem;
                          jusername   : stringitem;
                          jvirtpeak   : integeritem;
                          jwsextent   : integeritem;
                          jwspeak     : integeritem;
                          jwsquota    : integeritem;
                          jwssize     : integeritem;
                          listend     : integer;
                      end;
    syilist         : packed record
                          svirtpgcnt  : integeritem;
                          listend     : integer;
                      end;

[external,asynchronous] function lib$addx
       (    a         : $quad;
            b         : $quad;
        var result    : $quad;
            len       : integer := 2) : unsigned; extern;

[external,asynchronous] function lib$ediv
      (    divisor    : integer;
           dividend   : $quad;
       var quotient   : integer;
       var remainder  : integer) : unsigned; extern;


[external,asynchronous] function lib$emul
      (    multiplier     : integer;
           multiplicand   : integer;
           addend         : integer;
       var product        : $quad) : unsigned; extern;


[external,asynchronous] function lib$get_foreign
      (var getstr     : varying [$get1] of char;
           prompt     : varying [$get2] of char := %immed 0;
       var outlen     : $uword) : integer; external;


[external,asynchronous] function lib$signal
      (    cond_val   : [immediate] unsigned) : integer; external;


[external,asynchronous] function lib$subx
      (    a          : $quad;
           b          : $quad;
       var result     : $quad;
           len        : integer := 2) : unsigned; extern;


[external,asynchronous] function smg$begin_display_update
      (    display_id : [volatile] unsigned) : unsigned; external;


[external,asynchronous] function smg$create_pasteboard
      (var newpbid    : [volatile] unsigned;
           outdev     : [class_s] packed array [$cp1..$cp2:integer]
                          of char := %immed 0;
       var pbrows     : integer := %immed 0;
       var pbcols     : integer := %immed 0;
           scrnflg    : integer := %immed 0) : unsigned; external;


[external,asynchronous] function smg$create_virtual_display
      (    numrows    : integer;
           numcols    : integer;
       var newid      : [volatile] unsigned;
           displ_attr : unsigned := %immed 0;
           video_attr : unsigned := %immed 0;
           char_set   : unsigned := %immed 0) : unsigned; external;


[external,asynchronous] function smg$create_virtual_keyboard
      (var kbd_id     : [volatile] unsigned;
           filespec   : [class_s] packed array [$cvk1..$cvk2:integer]
                          of char := %immed 0;
           defilspec  : [class_s] packed array [$cvk3..$cvk4:integer]
                          of char := %immed 0;
           resfilspec : [class_s] packed array [$cvk5..$cvk6:integer]
                          of char := %immed 0) : unsigned; external;


[external,asynchronous] function smg$delete_pasteboard
      (    pstbd_id   : [volatile] unsigned;
           clrscr_flg : unsigned := %immed 0) : unsigned; external;


[external,asynchronous] function smg$enable_unsolicited_input
      (    pstbd_id   : [volatile] unsigned;
           %immed [unbound, asynchronous] procedure astadr;
           astarg     : unsigned := %immed 0) : unsigned; external;


[external,asynchronous] function smg$end_display_update
      (    display_id : [volatile] unsigned) : unsigned; external;


[external,asynchronous] function smg$erase_display
      (    display_id : [volatile] unsigned;
           start_row  : [volatile] unsigned := %immed 0;
           start_col  : [volatile] unsigned := %immed 0;
           end_row    : [volatile] unsigned := %immed 0;
           end_col    : [volatile] unsigned := %immed 0) : unsigned; external;


[external,asynchronous] function smg$erase_pasteboard
      (    pstbd_id   : [volatile] unsigned) : unsigned; external;


[external,asynchronous] function smg$get_broadcast_message
      (    pstbd_id   : [volatile] unsigned;
       var message    : [volatile] packed array [$gb1..$gb2:integer]
                          of char := %immed 0;
       var messag_len : [volatile] integer) : unsigned; external;


[external,asynchronous] function smg$pop_virtual_display
      (    displ_id   : [volatile] unsigned;
           pstbd_id   : [volatile] unsigned) : unsigned; external;


[external,asynchronous] function smg$paste_virtual_display
      (    displ_id   : [volatile] unsigned;
           pstbd_id   : [volatile] unsigned;
           pstbd_row  : integer := 1;
           pstbd_col  : integer := 1) : unsigned; external;


[external,asynchronous] function smg$put_chars
      (   displ_id    : [volatile] unsigned;
          text        : [unsafe, class_s] packed array [$pch1..$pch2:integer]
                          of char;
          line_no     : integer := 1;
          col_no      : integer := 1;
          erase_flg   : unsigned := 0;
          rend_set    : unsigned := %immed 0;
          rend_compl  : unsigned := %immed 0;
          char_set    : unsigned := %immed 0) : unsigned; external;


[external,asynchronous] function smg$read_keystroke
      (    kybd_id    : [volatile] unsigned;
       var term_code  : unsigned) : unsigned; external;


[external,asynchronous] function smg$set_broadcast_trapping
      (    pstbd_id   : [volatile] unsigned;
           %immed [unbound, asynchronous] procedure astadr := %immed 0;
           astarg     : unsigned := %immed 0) : unsigned; external;


[external,asynchronous] function smg$set_out_of_band_asts
      (    pstbd_id   : [volatile] unsigned;
           char_mask  : unsigned;
           %immed [unbound, asynchronous] procedure astadr;
           astarg     : unsigned := %immed 0) : unsigned; external;


[external, asynchronous] function smg$ring_bell
      (    display_id : [volatile] unsigned;
           num_times  : [volatile] integer := %immed 0) : unsigned; external;


[external,asynchronous] function str$find_first_substring
      (    str1       : varying [$fnd1] of char;
       var index      : integer;
       var subindex   : integer;
       str2           : [class_s] packed array [$fnd2..$fnd3:integer]
                          of char) : boolean; external;

[asynchronous,unbound] procedure out_of_band_ast
      (var datalist   : obastlist);

begin
    case int (uand (datalist.ascii_chr, %x'ff')) of
        3,26    : begin
		      smg$end_display_update (virtdisp_1);
		      smg$erase_pasteboard (pasteboard_id);
                      smg$delete_pasteboard (pasteboard_id);
                      $exit (ss$_normal);
                  end;
        18,23   : refresh := true;
        otherwise;
    end;
end;


[asynchronous,unbound] procedure trap_broadcast
    (var disp_id    : [volatile] unsigned);

begin
    smg$get_broadcast_message (pasteboard_id, msg_block, msg_len);
    smg$put_chars (disp_id, '******  MESSAGE  *****');
    smg$ring_bell (disp_id, 2);
end;


[asynchronous,unbound] procedure read_unsolicited
    (var astarg     : [volatile] unsigned);

var
    term_code   : unsigned;

begin
    smg$read_keystroke (keybd_id, term_code);
    case int (uand (term_code, %x'ff')) of
        013 :   begin
                    if brdcast then
                    begin
                        brdcast := false;
                        smg$pop_virtual_display (virtdisp_3, pasteboard_id);
                    end
                    else
                    begin
                        brdcast := true;
                        smg$erase_display (virtdisp_2);
                        smg$create_virtual_display (6, 80, virtdisp_3);
                        smg$put_chars (virtdisp_3, msg_block, 1, 1);
                        smg$paste_virtual_display (virtdisp_3, pasteboard_id,
                            1, 1);
                        smg$set_broadcast_trapping (pasteboard_id,
                        %immed trap_broadcast, virtdisp_2);
                    end;
                end;
        otherwise;
    end;
end;


procedure display
    (     line    : integer;
          col     : integer;
          str1    : [class_s] packed array [$l1..$u1:integer]
                    of char;
          str2    : [class_s] packed array [$l2..$u2:integer]
                    of char;
          update  : boolean;
      var attrib  : unsigned);

var
    text        : packed array [1..80] of char;
    text_descr  : descriptor;
    text_len    : $uword;
    rend_set    : unsigned;


begin
    if update then attrib := smg$m_bold;
    if refresh then
    begin
        smg$put_chars (virtdisp_1, str1, line, col,, smg$m_bold, smg$m_bold);
        $faol (str2, text_len, text, prmlst);
        text_descr.count := text_len;
        text_descr.addr := iaddress (text);
        smg$put_chars (virtdisp_1, %ref text_descr, line, col + length (str1),
                       rend_set := attrib);
    end
    else
    begin
        if (attrib <> 0) then
        begin
            if not update then attrib := 0;
            $faol (str2, text_len, text, prmlst);
            text_descr.count := text_len;
            text_descr.addr := iaddress (text);
            smg$put_chars (virtdisp_1, %ref text_descr, line, col + length (str1),
                           rend_set := attrib);
        end;
    end;
end;

begin       { Main Procedure }
    with initlist do
    begin
        iaccount.len        := 10;
        iaccount.code       := jpi$_account;
        iaccount.addr       := address (account);
        iaccount.retlen     := nil;
        iimagname.len       := 63;
        iimagname.code      := jpi$_imagname;
        iimagname.addr      := address (imagname);
        iimagname.retlen    := address (imagname_len);
        ilogintim.len       := 08;
        ilogintim.code      := jpi$_logintim;
        ilogintim.addr      := address (logintim);
        ilogintim.retlen    := nil;
        istate.len          := 08;
        istate.code         := jpi$_state;
        istate.addr         := address (state);
        istate.retlen       := nil;
        ipid.len            := 04;
        ipid.code           := jpi$_pid;
        ipid.addr           := address(pid);
        ipid.retlen         := nil;
        iprcnam.len         := 15;
        iprcnam.code        := jpi$_prcnam;
        iprcnam.addr        := address (prcnam);
        iprcnam.retlen      := address (prcnam_len);
        iproc_index.len     := 04;
        iproc_index.code    := jpi$_proc_index;
        iproc_index.addr    := address (proc_index);
        iproc_index.retlen  := nil;
        iuic.len            := 04;
        iuic.code           := jpi$_uic;
        iuic.addr           := address (uic);
        iuic.retlen         := nil;
        iusername.len       := 12;
        iusername.code      := jpi$_username;
        iusername.addr      := address (username);
        iusername.retlen    := address (username_len);
        listend             := 0;
    end;

    with jpilist do
    begin
        jaccount.len        := 10;
        jaccount.code       := jpi$_account;
        jaccount.addr       := address (account);
        jaccount.retlen     := address(account_len);
        jastcnt.len         := 04;
        jastcnt.code        := jpi$_astcnt;
        jastcnt.addr        := address(astcnt);
        jastcnt.retlen      := nil;
        jastlm.len          := 04;
        jastlm.code         := jpi$_astlm;
        jastlm.addr         := address(astlm);
        jastlm.retlen       := nil;
        jauthpriv.len       := 08;
        jauthpriv.code      := jpi$_authpriv;
        jauthpriv.addr      := address(authpriv);
        jauthpriv.retlen    := nil;
        jbiocnt.len         := 04;
        jbiocnt.code        := jpi$_biocnt;
        jbiocnt.addr        := address(biocnt);
        jbiocnt.retlen      := nil;
        jbiolm.len          := 04;
        jbiolm.code         := jpi$_biolm;
        jbiolm.addr         := address(biolm);
        jbiolm.retlen       := nil;
        jbufio.len          := 04;
        jbufio.code         := jpi$_bufio;
        jbufio.addr         := address(bufio);
        jbufio.retlen       := nil;
        jbytcnt.len         := 04;
        jbytcnt.code        := jpi$_bytcnt;
        jbytcnt.addr        := address(bytcnt);
        jbytcnt.retlen      := nil;
        jbytlm.len          := 04;
        jbytlm.code         := jpi$_bytlm;
        jbytlm.addr         := address(bytlm);
        jbytlm.retlen       := nil;
        jcliname.len        := 39;
        jcliname.code       := jpi$_cliname;
        jcliname.addr       := address(cliname);
        jcliname.retlen     := address(cliname_len);
        jcpulim.len         := 04;
        jcpulim.code        := jpi$_cpulim;
        jcpulim.addr        := address(cpulim);
        jcpulim.retlen      := nil;
        jcputim.len         := 04;
        jcputim.code        := jpi$_cputim;
        jcputim.addr        := address(cputim);
        jcputim.retlen      := nil;
        jcurpriv.len        := 08;
        jcurpriv.code       := jpi$_curpriv;
        jcurpriv.addr       := address(curpriv);
        jcurpriv.retlen     := nil;
        jdfwscnt.len        := 04;
        jdfwscnt.code       := jpi$_dfwscnt;
        jdfwscnt.addr       := address(dfwscnt);
        jdfwscnt.retlen     := nil;
        jdiocnt.len         := 04;
        jdiocnt.code        := jpi$_diocnt;
        jdiocnt.addr        := address(diocnt);
        jdiocnt.retlen      := nil;
        jdiolm.len          := 04;
        jdiolm.code         := jpi$_diolm;
        jdiolm.addr         := address(diolm);
        jdiolm.retlen       := nil;
        jdirio.len          := 04;
        jdirio.code         := jpi$_dirio;
        jdirio.addr         := address(dirio);
        jdirio.retlen       := nil;
        jenqcnt.len         := 04;
        jenqcnt.code        := jpi$_enqcnt;
        jenqcnt.addr        := address(enqcnt);
        jenqcnt.retlen      := nil;
        jenqlm.len          := 04;
        jenqlm.code         := jpi$_enqlm;
        jenqlm.addr         := address(enqlm);
        jenqlm.retlen       := nil;
        jfilcnt.len         := 04;
        jfilcnt.code        := jpi$_filcnt;
        jfilcnt.addr        := address(filcnt);
        jfilcnt.retlen      := nil;
        jfillm.len          := 04;
        jfillm.code         := jpi$_fillm;
        jfillm.addr         := address(fillm);
        jfillm.retlen       := nil;
        jfreptecnt.len      := 04;
        jfreptecnt.code     := jpi$_freptecnt;
        jfreptecnt.addr     := address (freptecnt);
        jfreptecnt.retlen   := nil;
        jgpgcnt.len         := 04;
        jgpgcnt.code        := jpi$_gpgcnt;
        jgpgcnt.addr        := address(gpgcnt);
        jgpgcnt.retlen      := nil;
        jimagecount.len     := 04;
        jimagecount.code    := jpi$_imagecount;
        jimagecount.addr    := address(imagecount);
        jimagecount.retlen  := nil;
        jimagname.len       := 63;
        jimagname.code      := jpi$_imagname;
        jimagname.addr      := address(imagname);
        jimagname.retlen    := address(imagname_len);
        jimagpriv.len       := 08;
        jimagpriv.code      := jpi$_imagpriv;
        jimagpriv.addr      := address(imagpriv);
        jimagpriv.retlen    := nil;
        jjobprccnt.len      := 04;
        jjobprccnt.code     := jpi$_jobprccnt;
        jjobprccnt.addr     := address(jobprccnt);
        jjobprccnt.retlen   := nil;
        jlogintim.len       := 08;
        jlogintim.code      := jpi$_logintim;
        jlogintim.addr      := address(logintim);
        jlogintim.retlen    := nil;
        jmaster_pid.len     := 04;
        jmaster_pid.code    := jpi$_master_pid;
        jmaster_pid.addr    := address(master_pid);
        jmaster_pid.retlen  := nil;
        jmaxjobs.len        := 02;
        jmaxjobs.code       := jpi$_maxjobs;
        jmaxjobs.addr       := address(maxjobs);
        jmaxjobs.retlen     := nil;
        jmode.len           := 04;
        jmode.code          := jpi$_mode;
        jmode.addr          := address(mode);
        jmode.retlen        := nil;
        jpageflts.len       := 04;
        jpageflts.code      := jpi$_pageflts;
        jpageflts.addr      := address(pageflts);
        jpageflts.retlen    := nil;
        jpagfilcnt.len      := 04;
        jpagfilcnt.code     := jpi$_pagfilcnt;
        jpagfilcnt.addr     := address(pagfilcnt);
        jpagfilcnt.retlen   := nil;
        jpgflquota.len      := 04;
        jpgflquota.code     := jpi$_pgflquota;
        jpgflquota.addr     := address(pgflquota);
        jpgflquota.retlen   := nil;
        jphdflags.len       := 04;
        jphdflags.code      := jpi$_phdflags;
        jphdflags.addr      := address(phdflags);
        jphdflags.retlen    := nil;
        jpid.len            := 04;
        jpid.code           := jpi$_pid;
        jpid.addr           := address(pid);
        jpid.retlen         := nil;
        jppgcnt.len         := 04;
        jppgcnt.code        := jpi$_ppgcnt;
        jppgcnt.addr        := address(ppgcnt);
        jppgcnt.retlen      := nil;
        jprccnt.len         := 04;
        jprccnt.code        := jpi$_prccnt;
        jprccnt.addr        := address(prccnt);
        jprccnt.retlen      := nil;
        jprclm.len          := 04;
        jprclm.code         := jpi$_prclm;
        jprclm.addr         := address(prclm);
        jprclm.retlen       := nil;
        jprcnam.len         := 15;
        jprcnam.code        := jpi$_prcnam;
        jprcnam.addr        := address(prcnam);
        jprcnam.retlen      := address(prcnam_len);
        jpri.len            := 04;
        jpri.code           := jpi$_pri;
        jpri.addr           := address(pri);
        jpri.retlen         := nil;
        jprib.len           := 04;
        jprib.code          := jpi$_prib;
        jprib.addr          := address(prib);
        jprib.retlen        := nil;
        jproc_index.len     := 04;
        jproc_index.code    := jpi$_proc_index;
        jproc_index.addr    := address (proc_index);
        jproc_index.retlen  := nil;
        jprocpriv.len       := 08;
        jprocpriv.code      := jpi$_procpriv;
        jprocpriv.addr      := address(procpriv);
        jprocpriv.retlen    := nil;
        jstate.len          := 04;
        jstate.code         := jpi$_state;
        jstate.addr         := address(state);
        jstate.retlen       := nil;
        jsts.len            := 04;
        jsts.code           := jpi$_sts;
        jsts.addr           := address(sts);
        jsts.retlen         := nil;
        jterminal.len       := 07;
        jterminal.code      := jpi$_terminal;
        jterminal.addr      := address(terminal);
        jterminal.retlen    := address(terminal_len);
        jtqcnt.len          := 04;
        jtqcnt.code         := jpi$_tqcnt;
        jtqcnt.addr         := address(tqcnt);
        jtqcnt.retlen       := nil;
        jtqlm.len           := 04;
        jtqlm.code          := jpi$_tqlm;
        jtqlm.addr          := address(tqlm);
        jtqlm.retlen        := nil;
        juaf_flags.len      := 04;
        juaf_flags.code     := jpi$_uaf_flags;
        juaf_flags.addr     := address(uaf_flags);
        juaf_flags.retlen   := nil;
        juic.len            := 04;
        juic.code           := jpi$_uic;
        juic.addr           := address(uic);
        juic.retlen         := nil;
        jusername.len       := 12;
        jusername.code      := jpi$_username;
        jusername.addr      := address (username);
        jusername.retlen    := address (username_len);
        jvirtpeak.len       := 04;
        jvirtpeak.code      := jpi$_virtpeak;
        jvirtpeak.addr      := address(virtpeak);
        jvirtpeak.retlen    := nil;
        jwsextent.len       := 04;
        jwsextent.code      := jpi$_wsextent;
        jwsextent.addr      := address(wsextent);
        jwsextent.retlen    := nil;
        jwspeak.len         := 04;
        jwspeak.code        := jpi$_wspeak;
        jwspeak.addr        := address(wspeak);
        jwspeak.retlen      := nil;
        jwsquota.len        := 04;
        jwsquota.code       := jpi$_wsquota;
        jwsquota.addr       := address(wsquota);
        jwsquota.retlen     := nil;
        jwssize.len         := 04;
        jwssize.code        := jpi$_wssize;
        jwssize.addr        := address(wssize);
        jwssize.retlen      := nil;
        listend             := 0;
    end;

    with syilist do
    begin
        svirtpgcnt.len      := 04;
        svirtpgcnt.code     := syi$_virtualpagecnt;
        svirtpgcnt.addr     := address (virtpgcnt);
        svirtpgcnt.retlen   := nil;
        listend             := 0;
        end;

    for pidindex := 0 to 255 do pidarray[pidindex] := 0;
    retstatus := $getsyi (itmlst := syilist, iosb := iosb);
    retstatus := lib$get_foreign (getstr := input_line,
                                  outlen := input_line_len);
    pidroot := -1;
    iosb := 0;
    writeln ('Idx Process name    Owner              Login time  State   Image');
    while $getjpiw (pidadr := pidroot, itmlst := initlist, iosb := iosb) <>
            ss$_nomoreproc do
    begin

        { Save the PID for future reference}

        if uic = 0 then proc_index_base := proc_index;
        proc_index := proc_index_base - proc_index;
        pidarray[proc_index] := pid;

        { The following fixes a $GETJPI problem with string padding }

        if index (account, chr(0)) <> 0 then
            account_len := index (account, chr(0)) - 1;
        if index (prcnam, chr(0)) <> 0 then
            prcnam_len := index (prcnam, chr(0)) - 1;
        if index (username, chr(0)) <> 0 then
            username_len := index (username, chr(0)) - 1;

        account := pad (substr (account, 1, account_len), ' ', 8);
        $asctim (timbuf := logintim_str, timadr := logintim);
        offset := index (imagname,'.]') + 2;
        if offset = 2 then offset := index (imagname,':') + 1;
        if offset > 0 then
            imagname := substr (imagname, offset, length(imagname) - offset);
        offset := index (imagname,']') + 1;
        imagname := substr (imagname, offset, length(imagname) - offset);
        case state of
            01 : state_str := 'COLPG';
            02 : state_str := 'MWAIT';
            03 : state_str := 'CEF  ';
            04 : state_str := 'PFW  ';
            05 : state_str := 'LEF  ';
            06 : state_str := 'LEFO ';
            07 : state_str := 'HIB  ';
            08 : state_str := 'HIBO ';
            09 : state_str := 'SUSP ';
            10 : state_str := 'SUSPO';
            11 : state_str := 'FPGW ';
            12 : state_str := 'COM  ';
            13 : state_str := 'COMO ';
            14 : state_str := 'CUR  ';
        otherwise state_str := '???  ';
        end;

        uic := uic div 65356;
        if (iosb.u0 <> ss$_nomoreproc) and not
            ((username = 'SYSTEM') or (username = 'DECNET')
                or (username_len = 0)) then
        begin
	    if (state in [02,06,08,10,13]) or (iosb.u0 = ss$_suspended) then
	    begin
	    	logintim_str := '--Not available--';
	    	imagname := '--Not available--';
	    end;
            if (logintim.u0 = 0) and (logintim.u1 = 0)
            then writeln (hex(proc_index,3,3), space,
                pad (substr (prcnam, 1, prcnam_len), space, 15))
            else writeln (hex(proc_index,3,3), space,
                pad (substr (prcnam, 1, prcnam_len), space, 15),
                space,
                pad (substr (username, 1, username_len), space, 12),
                space,
                logintim_str:17,
                space,
                space,
                state_str:5,
                space,
                pad(substr(imagname,1,min(21,imagname_len)),space,21));
            end;
        end;

    { ask for index - takes hex entry }

    write ('Index: ');
    read (pidindex:hex, error := continue);
    if (status (input) = pas$k_getafteof) then $exit (ss$_normal);
    if (status (input) <> 0) then $exit (ss$_badparam);
    if (pidindex > 255) or (pidindex < 0) or (pidarray[pidindex] = 0) then
        begin
        $exit (ss$_nonexpr);
        end;
    readln;

    { ask for interval (in seconds) }

    write ('Interval in seconds: ');
    read (interval, error := continue);
    if (status (input) = pas$k_getafteof) then $exit (ss$_normal);
    if (status (input) <> 0) then $exit (ss$_badparam);
    readln;
    retstatus := lib$emul (10000000, interval, 0, delay_time);

    { set up paste board and virtual displays }

    retstatus := smg$create_pasteboard (pasteboard_id);

    retstatus := smg$create_virtual_display (24, 80, virtdisp_1);
    retstatus := smg$paste_virtual_display (virtdisp_1, pasteboard_id, 1, 1);

    retstatus := smg$create_virtual_display (1, 22, virtdisp_2);
    retstatus := smg$paste_virtual_display (virtdisp_2, pasteboard_id, 24, 24);

    retstatus := smg$create_virtual_display (1, 22, virtdisp_4);
    retstatus := smg$paste_virtual_display (virtdisp_4, pasteboard_id, 24, 54);

    retstatus := smg$create_virtual_keyboard (keybd_id, 'sys$input');

    retstatus := smg$enable_unsolicited_input (pasteboard_id,
                %immed read_unsolicited, keybd_id);
    retstatus := smg$set_out_of_band_asts (pasteboard_id, %x'04940008',
                %immed out_of_band_ast, keybd_id);  {^C,^R,^T,^W,^Z}
    retstatus := smg$set_broadcast_trapping (pasteboard_id,
                %immed trap_broadcast, virtdisp_2);

    { Now run the main loop }

    while true do
    begin

        retstatus := $gettim (timadr := curtime);
        lib$addx (curtime, delay_time, wait_time);

        retstatus := $getjpiw
            (pidadr := pidarray[pidindex], itmlst := jpilist, iosb := iosb);
        if (retstatus = ss$_suspended) then
        begin
            smg$put_chars (virtdisp_4, '*** PROCESS SUSPENDED ***');
            smg$ring_bell (virtdisp_4, 2);
            suspended := true;
        end
        else
        begin
            if suspended then
            begin
                smg$erase_display (virtdisp_4);
                suspended := false;
            end;
            if not (odd (retstatus)) or not (odd(iosb.u0)) then
            begin
                smg$delete_pasteboard (pasteboard_id);
                if not (odd (retstatus)) then $exit (retstatus);
                if not (odd (iosb.u0)) then $exit (iosb.u0);
            end;
        end;

        lib$subx (logintim, curtime, elapstim);
        lib$ediv (100000, elapstim, elapstim_int, junk_int);
        lib$emul (cputim, 100000, 0, cputim_quad);
        lib$subx (quadzero, cputim_quad, cputim_quad);
        lib$emul (cpulim, 100000, 10, cpulim_quad);
        lib$subx (quadzero, cpulim_quad, cpulim_quad);

        virtmem := virtpgcnt - freptecnt;
        physmem := ppgcnt + gpgcnt;

        if imagname_len = 0 then
        begin
            imagname := pad (' ', ' ', 63);
            imagname_len := 63;
        end;

        case mode of
            0 : mode_str := 'OTHER';
            1 : mode_str := 'NETWORK';
            2 : mode_str := 'BATCH';
            3 : mode_str := 'INTERACT';
        otherwise mode_str := 'OTHER';
        end;
        mode_len := length (mode_str);

        case state of
            01 : state_str := 'COLPG';
            02 : state_str := 'MWAIT';
            03 : state_str := 'CEF';
            04 : state_str := 'PFW';
            05 : state_str := 'LEF';
            06 : state_str := 'LEFO';
            07 : state_str := 'HIB';
            08 : state_str := 'HIBO';
            09 : state_str := 'SUSP';
            10 : state_str := 'SUSPO';
            11 : state_str := 'FPG';
            12 : state_str := 'COM';
            13 : state_str := 'COMO';
            14 : state_str := 'CUR';
        otherwise state_str := 'UNKN';
        end;
        state_len := length (state_str);

        if first_pass then
        begin
            first_pass := false;
        end
        else
        begin
            interval := (elapstim_old - elapstim_int) div 100;
            elapstim_old := elapstim_int;
	    avpgflts :=  (100 * pageflts) div cputim;
	    avpgflts_del := (100 * pageflts) div (0 - elapstim_int);
            bufio_delta := (bufio - bufio_old) div interval;
            cputim_delt := (cputim - cputim_old) div interval;
            cputim_pct  := (100 * cputim) div (0 - elapstim_int);
            dirio_delta := (dirio - dirio_old) div interval;
            pageflts_del := (pageflts - pageflts_old) div interval;
        end;

        if refresh then
        begin
            smg$erase_display (virtdisp_2);
            smg$erase_pasteboard (pasteboard_id);
            smg$set_broadcast_trapping (pasteboard_id,
                %immed trap_broadcast, virtdisp_2);
        end;

        smg$begin_display_update (virtdisp_1);

        prmlst[1] := username_len;
        prmlst[2] := iaddress (username);
        display (01, 02, 'Username  >> ', '!23AD', false, zero_atr);

        update := (prcnam <> prcnam_old);
        prcnam_old := prcnam;
        prmlst[1] := prcnam_len;
        prmlst[2] := iaddress (prcnam);
        display (01, 40,'Proc Name >> ','!23AD', update, prcnam_atr);

        prmlst[1] := iaddress (logintim);
        display (02, 02, 'Created   >> ', '!23%D', false, zero_atr);

	elapstim_atr := smg$m_bold;
        prmlst[1] := iaddress (elapstim);
        display (02, 40, 'Elap Time >> ', '!%D', false, elapstim_atr);

	curtime_atr := smg$m_bold;
        prmlst[1] := iaddress (curtime);
        display (03, 02, 'Curr Time >> ', '!23%D', false, curtime_atr);

        update := (cputim <> cputim_old);
        cputim_old := cputim;
        prmlst[1] := iaddress (cputim_quad);
        display (03, 40, 'CPU Time  >> ', '!%D', update, cputim_atr);

        prmlst[1] := cliname_len;
        prmlst[2] := iaddress (cliname);
        display (04, 02, 'CLI Name  >> ', '!23AD', false, zero_atr);

        prmlst[1] := iaddress (cpulim_quad);
        display (04, 40, 'CPU Limit >> ', '!%D', false, zero_atr);

        update := (imagname <> imagname_old);
        imagname_old := imagname;
        prmlst[1] := imagname_len;
        prmlst[2] := iaddress (imagname);
        display (06, 02, 'Image Name>> ', '!AD', update, imagname_atr);

        prmlst[1] := terminal_len;
        prmlst[2] := iaddress (terminal);
        display (08, 02, 'Term >> ', '!10AD', false, zero_atr);

        prmlst[1] := int (pid);
        display (08, 26, 'Proc Id >> ', '!8XL', false, zero_atr);

        update := (sts <> sts_old);
        sts_old := sts;
        prmlst[1] := int (sts);
        display (08, 53, 'Proc Stat >> ', '!8XL', update, sts_atr);

        prmlst[1] := int (uic);
        display (09, 02, 'UIC  >> ', '!10%U', false, zero_atr);

        prmlst[1] := master_pid;
        display (09, 26, 'Own PID >> ', '!8XL', false, zero_atr);

        update := (state <> state_old);
        state_old := state;
        prmlst[1] := state_len;
        prmlst[2] := iaddress (state_str);
        display (09, 53, 'State     >> ', '!AD', update, state_atr);

        prmlst[1] := mode_len;
        prmlst[2] := iaddress (mode_str);
        display (10, 02, 'Mode >> ', '!10AD', false, zero_atr);

        prmlst[1] := account_len;
        prmlst[2] := iaddress (account);
        display (10, 26, 'Account >> ', '!8AD', false, zero_atr);

        update := (pri <> pri_old);
        pri_old := pri;
        prmlst[1] := pri;
        display (10, 53, 'Priority  >> ', '!2SL', update, pri_atr);

        update := (prib <> prib_old);
        prib_old := prib;
        prmlst[1] := prib;
        display (10, 68, '/', '!2SL', update, prib_atr);

        prmlst[1] := pidindex;
        display (11, 02, 'Indx >> ', '!2XL', false, zero_atr);

        prmlst[1] := int (uaf_flags);
        display (11, 26, 'UAF Flg >> ', '!8XL', false, zero_atr);

        update := (imagecount <> imagecount_old);
        imagecount_old := imagecount;
        prmlst[1] := imagecount;
        display (11, 53, 'Image Cnt >> ', '!4SL', update, imagecount_atr);

        prmlst[1] := dfwscnt;
        display (13, 02, 'WS Def   >> ', '!5SL', false, zero_atr);

        update := (ppgcnt <> ppgcnt_old);
        ppgcnt_old := ppgcnt;
        prmlst[1] := ppgcnt;
        display (13, 23, 'Proc Page Cnt >> ', '!7SL', update, ppgcnt_atr);

        update := (dirio <> dirio_old);
        dirio_old := dirio;
        prmlst[1] := dirio;
        display (13, 51, 'Dir IO Count >> ', '!7SL', update, dirio_atr);

        update := (dirio_delta <> dirio_delta_old);
	dirio_delta_old := dirio_delta;
        prmlst[1] := dirio_delta;
        display (13, 74, '/', '!4SL', update, dirio_delta_atr);

        prmlst[1] := wsquota;
        display (14, 02, 'WS Quota >> ', '!5SL', false, zero_atr);

        update := (gpgcnt <> gpgcnt_old);
        gpgcnt_old := gpgcnt;
        prmlst[1] := gpgcnt;
        display (14, 23, 'Gbl Page Cnt  >> ', '!7SL', update, gpgcnt_atr);

        update := (bufio <> bufio_old);
        bufio_old := bufio;
        prmlst[1] := bufio;
        display (14, 51, 'Buf IO Count >> ', '!7SL', update, bufio_atr);

        update := (bufio_delta <> bufio_delta_old);
	bufio_delta_old := bufio_delta;
        prmlst[1] := bufio_delta;
        display (14, 74, '/', '!4SL', update, bufio_delta_atr);

        prmlst[1] := wsextent;
        display (15, 02, 'WS Ext   >> ', '!5SL', false, zero_atr);

        update := (physmem <> physmem_old);
        physmem_old := physmem;
        prmlst[1] := physmem;
        display (15, 23, 'Phys Page Cnt >> ', '!7SL', update, physmem_atr);

        update := (pageflts <> pageflts_old);
        pageflts_old := pageflts;
        prmlst[1] := pageflts;
        display (15, 51, 'Cur Page Flts>> ', '!7SL', update, pageflts_atr);

        update := (pageflts_del <> pageflts_del_old);
	pageflts_del_old := pageflts_del;
        prmlst[1] :=  pageflts_del;
        display (15, 74, '/', '!4SL', update,  pageflts_del_atr);

        update := (wssize <> wssize_old);
        wssize_old := wssize;
        prmlst[1] := wssize;
        display (16, 02, 'WS Size  >> ', '!5SL', update, wssize_atr);

        update := (virtmem <> virtmem_old);
        virtmem_old := virtmem;
        prmlst[1] := virtmem;
        display (16, 23, 'Curr Vrtl Mem >> ', '!7SL', update, virtmem_atr);

        update := (avpgflts <> avpgflts_old);
        avpgflts_old := avpgflts;
        prmlst[1] := avpgflts;
        display (16, 51, 'Ave Page Flts>> ', '!7SL', update, avpgflts_atr);

        update := (avpgflts_del <> avpgflts_del_old);
	avpgflts_del_old := avpgflts_del;
        prmlst[1] :=  avpgflts_del;
        display (16, 74, '/', '!4SL', update,  avpgflts_del_atr);

        update := (wspeak <> wspeak_old);
        wspeak_old := wspeak;
        prmlst[1] := wspeak;
        display (17, 02, 'Peak WS  >> ', '!5SL', update, wspeak_atr);

        update := (virtpeak <> virtpeak_old);
        virtpeak_old := virtpeak;
        prmlst[1] := virtpeak;
        display (17, 23, 'Peak Vrtl Addr>> ', '!7SL', update, virtpeak_atr);

        update := (cputim_pct <> cputim_pct_old);
	cputim_pct_old := cputim_pct;
        prmlst[1] := cputim_pct;
        display (17, 51, 'CPU Percents >> ', '!7SL', update, cputim_pct_atr);

        update := (cputim_delt <> cputim_delt_old);
        cputim_delt_old := cputim_delt;
        prmlst[1] := cputim_delt;
        display (17, 74, '/', '!4SL', update, cputim_delt_atr);

        display (19, 06, 'Process Quotas (Limit/Used)', ' ', false, zero_atr);

        display (19, 58, 'Privilege Masks', ' ', false, zero_atr);

        prmlst[1] := maxjobs;
        display (20, 02, 'Job  >> ', '!3SL', false, zero_atr);

        update := (jobprccnt <> jobprccnt_old);
        jobprccnt_old := jobprccnt;
        prmlst[1] := jobprccnt;
        display (20, 13, '/', '!3SL', update, jobprccnt_atr);

        prmlst[1] := astlm;
        display (20, 24, 'AST   >> ', '!5SL', false, zero_atr);

        update := (astcnt <> astcnt_old);
        astcnt_old := astcnt;
        prmlst[1] := astlm - astcnt;
        display (20, 38, '/', '!5SL', update, astcnt_atr);

	update := (curpriv.u0 <> curpriv_old.u0) or (curpriv.u1 <> curpriv_old.u1);
        curpriv_old.u0 := curpriv.u0;
        curpriv_old.u1 := curpriv.u1;
        prmlst[1] := int (curpriv.u0);
        prmlst[2] := int (curpriv.u1);
        display (20, 54, 'Curr  >> ', '!8XL!8XL', update, curpriv_atr);

        prmlst[1] := prclm;
        display (21, 02, 'Proc >> ', '!3SL', false, zero_atr);

        update := (prccnt <> prccnt_old);
        prccnt_old := prccnt;
        prmlst[1] := prccnt;
        display (21, 13, '/', '!3SL', update, prccnt_atr);

        prmlst[1] := enqlm;
        display (21, 24, 'ENQ   >> ', '!5SL', false, zero_atr);

        update := (enqcnt <> enqcnt_old);
        enqcnt_old := enqcnt;
        prmlst[1] := enqlm - enqcnt;
        display (21, 38, '/', '!5SL', update, enqcnt_atr);

        prmlst[1] := int (authpriv.u0);
        prmlst[2] := int (authpriv.u1);
        display (21, 54, 'Auth  >> ', '!8XL!8XL', false, zero_atr);

        prmlst[1] := biolm;
        display (22, 02, 'BIO  >> ', '!3SL', false, zero_atr);

        update := (biocnt <> biocnt_old);
        biocnt_old := biocnt;
        prmlst[1] := biolm - biocnt;
        display (22, 13, '/', '!3SL', update, biocnt_atr);

        prmlst[1] := tqlm;
        display (22, 24, 'Timer >> ', '!5SL', false, zero_atr);

        update := (tqcnt <> tqcnt_old);
        tqcnt_old := tqcnt;
        prmlst[1] := tqlm - tqcnt;
        display (22, 38, '/', '!5SL', update, tqcnt_atr);

        prmlst[1] := int (procpriv.u0);
        prmlst[2] := int (procpriv.u1);
        display (22, 54, 'Proc  >> ', '!8XL!8XL', false, zero_atr);

        prmlst[1] := diolm;
        display (23, 02, 'DIO  >> ', '!3SL', false, zero_atr);

        update := (diocnt <> diocnt_old);
        diocnt_old := diocnt;
        prmlst[1] := diolm - diocnt;
        display (23, 13, '/', '!3SL', update, diocnt_atr);

	update := (bytlm <> bytlm_old);
	bytlm_old := bytlm;
        prmlst[1] := bytlm;
        display (23, 24, 'Byte  >> ', '!5SL', update, bytlm_atr);

        update := (bytcnt <> bytcnt_old);
        bytcnt_old := bytcnt;
        prmlst[1] := bytlm - bytcnt;
        display (23, 38, '/', '!5SL', update, bytcnt_atr);

        update := (imagpriv.u0 <> imagpriv_old.u0) or (imagpriv.u1 <> imagpriv_old.u1);
        imagpriv_old.u0 := imagpriv.u0;
        imagpriv_old.u1 := imagpriv.u1;
        prmlst[1] := int (imagpriv.u0);
        prmlst[2] := int (imagpriv.u1);
        display (23, 54, 'Image >> ', '!8XL!8XL', update, imagpriv_atr);

        prmlst[1] := fillm;
        display (24, 02, 'File >> ', '!3SL', false, zero_atr);

        update := (filcnt <> filcnt_old);
        filcnt_old := filcnt;
        prmlst[1] := fillm - filcnt;
        display (24, 13, '/', '!3SL', update, filcnt_atr);

	smg$put_chars (virtdisp_1, ' ', 24, 80);
	smg$end_display_update (virtdisp_1);
        refresh := false;

        retstatus := $schdwk ( daytim := wait_time);
        if retstatus <> ss$_normal then lib$signal (retstatus);

        retstatus := $hiber;
        if retstatus <> ss$_normal then lib$signal (retstatus);

    end;

end.
