Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM I/MPM I SOURCE/07/sched.plm

$title('MP/M 1.1 Scheduler Process')
sched:
do;

$include (copyrt.lit)
/*
  Revised:
    26 Jan 80  by Thomas Rolander
*/

$include (proces.lit)
$include (queue.lit)
$include (xdos.lit)

/*
    Common Literals
*/

  declare true literally '0FFFFH';
  declare false literally '0';
  declare forever literally 'while true';
  declare boolean literally 'byte';

  declare restarts literally
    '0C7C7H,0C7C7H,0C7C7H,0C7C7H,
     0C7C7H,0C7C7H,0C7C7H,0C7C7H,
     0C7C7H,0C7C7H,0C7C7H,0C7C7H,
     0C7C7H,0C7C7H,0C7C7H,0C7C7H,
     0C7C7H,0C7C7H,0C7C7H';

  mon1:
    procedure (func,info) external;
      declare func byte;
      declare info address;
    end mon1;

  mon2:
    procedure (func,info) byte external;
      declare func byte;
      declare info address;
    end mon2;

  mon2a:
    procedure (func,info) address external;
      declare func byte;
      declare info address;
    end mon2a;

  declare xdos literally 'mon2';
  declare xdosa literally 'mon2a';

/*
  Sched Process Data Segment
*/
  declare os address public
    data (0);

  declare sched$pd process$descriptor public
    data (0,rtr$status,100,.sched$stk+38,
             'Sched   ',0,0ffh,0,0,0);
  declare sched$stk (20) address
    initial (restarts,.sched);

  declare sched$lqcb
    structure (lqueue,
               buf (71) byte)
    initial (0,'Sched   ',69,1);
  declare sched$uqcb userqcbhead
    initial (.sched$lqcb,.new$entry);

  declare cli$uqcb userqcb
    initial (0,0,'CliQ    ');

  declare ret address;

  declare (char,index,tindx) byte;

  declare scheduling boolean;

  declare temp address;

  declare tod structure (
    date address,
    hrs byte,
    min byte,
    sec byte );

  declare sched$item literally 'structure (
    date address,
    hrs byte,
    min byte,
    cli$command (65) byte )';

  declare new$entry sched$item;

  declare sched$table (4) sched$item;

  room$in$table:
    procedure boolean;

      do tindx = 0 to 3;
        if sched$table(tindx).date = 0
          then return true;
      end;
      return false;
    end room$in$table;

  fill$entry:
    procedure;

      if room$in$table then
      do;
        call move (69,.new$entry,.sched$table(tindx));
        scheduling = true;
      end;
    end fill$entry;


  declare last$dseg$byte byte
    initial (0);

/*
  sched:
*/

  sched:
    procedure;
  
      ret = xdos (make$queue,.sched$lqcb);
      ret = xdos (open$queue,.cli$uqcb);
      do tindx = 0 to 3;
        sched$table(tindx).date = 0;
      end;
  
      do forever;
        ret = xdos (read$queue,.sched$uqcb);
        scheduling = false;
        call fill$entry;
        do while scheduling;
          ret = xdos (get$tod,.tod);
          scheduling = false;
          do tindx = 0 to 3;
            if sched$table(tindx).date <> 0 then
            do;
              if (tod.date > sched$table(tindx).date) or
                 ((tod.date = sched$table(tindx).date) and
                  ((tod.hrs > sched$table(tindx).hrs) or
                   ((tod.hrs = sched$table(tindx).hrs) and
                     (tod.min >= sched$table(tindx).min)))) then
              do;
                cli$uqcb.msgadr = .sched$table(tindx).cli$command;
                ret = xdos (write$queue,.cli$uqcb);
                sched$table(tindx).date = 0;
              end;
              else
              do;
                scheduling = true;
              end;
            end;
          end;
          if scheduling then
          do;
            ret = xdos (flag$wait,3);
          end;
          if xdos (cond$read$queue,.sched$uqcb) = 0
            then call fill$entry;
        end;
      end;
    end sched;
end sched;