$CONTROL MAP,CODE,USLINIT                                               00010000
<<memtimer>>                                                            00015000
<< hp32002c mpe source c.00.00 >>                                       00020000
$copyright     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$control main=memtimer,segment=memtimer                                 00055000
$control privileged                                                     00060000
$control uncallable                                                     00065000
$title "- ERROR CORRECTING MEMORY LOGGING INTERVAL UTILITY"             00070000
$thirty                                                                 00075000
begin                                                                   00080000
                                                                        00085000
<<------------------------------------------------------------          00090000
*                                                            *          00095000
*     error correcting memory logging interval utility       *          00100000
*                                                            *          00105000
------------------------------------------------------------>>          00110000
                                                                        00115000
define                                                         <<01.01>>00120000
ptitle=(" MEMTIMER C.00.00 (C) HEWLETT-PACKARD CO., 1976")#;   <<04931>>00125000
                                                               <<01.01>>00130000
$include inclvuf                                               <<04931>>00135000
$include incltrl                                               <<07433>>00140000
                                                                        00145000
integer parm = q-4;                                                     00150000
                                                                        00155000
integer i,dst,pcbx;                                                     00160000
                                                               <<01168>>00165000
double capd;      << capabilities from who intrinsic >>        <<01168>>00170000
logical cap=capd;                                              <<01168>>00175000
define sysmgr = cap.(0:1)#;                                    <<01168>>00180000
define                                                         <<01168>>00185000
sysmgr'msg = (" ** PROGRAM REQUIRES SYS. MGR. CAPABILITY **")#;<<01168>>00190000
                                                                        00195000
logical found:=false,                                          <<07433>>00200000
        mpev := false,                                         <<07433>>00205000
        mournwait ;                                            <<07433>>00210000
                                                                        00215000
<<integer pointer trl = 10;>>  <<timer request list>>          <<07433>>00220000
logical pointer pcbptr = 3;  << pcb table        >>            <<07433>>00225000
                                                                        00230000
integer array dbarray(*) = db+0;                                        00235000
                                                                        00240000
array msg(0:36);                                               <<01.01>>00245000
byte array bmsg(*)=msg;  << needed for vuf >>                  <<04931>>00250000
                                                                        00255000
equate                                                                  00260000
     sysdb      = 512,                                                  00265000
     memlogpinx = sysdb+%154;  <<memlogp pcb index>>                    00270000
                                                                        00275000
define                                                         <<00.01>>00280000
      penable = assemble(pseb)#,                               <<00.01>>00285000
      pdisable= assemble(psdb)#;                               <<00.01>>00290000
                                                               <<00.01>>00295000
procedure  unimpede(pcbpt);                                    <<00.01>>00300000
value  pcbpt;                                                  <<00.01>>00305000
integer  pcbpt;                                                <<00.01>>00310000
option external;                                               <<00.01>>00315000
                                                               <<00.01>>00320000
integer procedure exchangedb(dst);                                      00325000
value dst; integer dst;                                                 00330000
option external;                                                        00335000
                                                                        00340000
intrinsic print,terminate,who;                                 <<01168>>00345000
                                                                        00350000
subroutine setdelay;                                                    00355000
begin                                                                   00360000
     if parm <= 0 then                                                  00365000
     begin                                                              00370000
          move msg:="** INVALID PARM (DELAY) VALUE **";                 00375000
          print(msg,-32,0);                                             00380000
          terminate;                                                    00385000
     end;                                                               00390000
     pcbx:=absolute(memlogpinx);                               <<00.01>>00395000
     if mpev then                                              <<07433>>00400000
        mournwait := pcbptr(pcbx+4).(0:1)  <<mourning>>        <<07433>>00405000
     else mournwait := absolute(pcbx+absolute(3)+4).(0:1);     <<07433>>00410000
     if mournwait then                                         <<07433>>00415000
     begin                                                              00420000
          move msg:="** MEMORY LOGGING PROCESS NOT ACTIVE **";          00425000
          print(msg,-39,0);                                             00430000
          terminate;                                                    00435000
     end;                                                               00440000
     if mpev then dst:=pcbptr(pcbx+3).(2:14)                   <<07433>>00445000
     else dst := absolute(pcbx+absolute(3)+3).(1:10);          <<07433>>00450000
     exchangedb(dst);                                                   00455000
     dbarray(dbarray):=parm;  <<set delay at stack db+0>>               00460000
     exchangedb(0);                                                     00465000
end  <<setdelay>>;                                                      00470000
                                                                        00475000
subroutine fixtimerequest;                                              00480000
begin                                                                   00485000
     pdisable;  <<pseudo-disable>>                             <<00.01>>00490000
     if mpev then                                              <<07433>>00495000
     begin                                                     <<07433>>00500000
       for i:=%14 step trlentrysize until                      <<07433>>00505000
           trlnumentries * trlentrysize do                     <<07433>>00510000
       if logical(trl(i).(0:1)) then <<active>>                <<07433>>00515000
       if trl(i+1) = pcbx then  <<memlogp delay entry>>        <<07433>>00520000
       begin                                                   <<07433>>00525000
            found:=true;                                       <<07433>>00530000
            unimpede(pcbx);                                    <<07433>>00535000
            i:=trlnumentries * trlentrysize;  <<stop loop>>    <<07433>>00540000
       end;                                                    <<07433>>00545000
     end                                                       <<07433>>00550000
     else                                                      <<07433>>00555000
     begin                                                     <<07433>>00560000
       for i:=%14 step 4 until (trl(1) & lsr(6)) do            <<07433>>00565000
<< mpe iv operating system >>                                  <<07433>>00570000
     if logical(trl(i).(0:1)) then <<active>>                           00575000
     if trl(i+1) = pcbx then  <<memlogp delay entry>>                   00580000
     begin                                                              00585000
          found:=true;                                                  00590000
          unimpede(pcbx);                                      <<00.01>>00595000
            i:=(trl(1) & lsr(6));  <<stop loop>>               <<07433>>00600000
       end;                                                    <<07433>>00605000
     end;                                                      <<07433>>00610000
     penable;   <<pseudo-enable >>                             <<00.01>>00615000
     if not found then                                                  00620000
     begin                                                              00625000
          move msg:="** MEMLOGP TIMER ENTRY NOT FOUND **";              00630000
          print(msg,-35,0);                                             00635000
     end;                                                               00640000
end <<fixtimerequest>>;                                                 00645000
                                                                        00650000
<<                 o-u-t-e-r   b-l-o-c-k                  >>            00655000
                                                                        00660000
   if pcbptr(1) > 16 then mpev := true;                        <<07433>>00665000
   move msg := ptitle,2;                                       <<01.01>>00670000
   i := tos-@msg;                                              <<01.01>>00675000
   move bmsg(10) := official'vuuff;                            <<04931>>00680000
   print(msg,i,0);                                             <<01.01>>00685000
                                                               <<01168>>00690000
   who(,capd);                                                 <<01168>>00695000
   if not sysmgr then                                          <<01168>>00700000
     begin                                                     <<01168>>00705000
     move msg := sysmgr'msg,2;                                 <<01168>>00710000
     i := tos - @msg;                                          <<01168>>00715000
     print(msg,i,0);                                           <<01168>>00720000
     terminate;                                                <<01168>>00725000
     end;                                                      <<01168>>00730000
                          setdelay;                                     00735000
                       fixtimerequest;                                  00740000
                            end.                                        00745000
