freepascal.compiler/compiler/ctask.pas

{
    This unit implements basic task handling for unit and package handling

    Copyright (c) 2005 by Florian Klaempfl

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 ****************************************************************************
}
unit ctask;

{$i fpcdefs.inc}

  interface

    uses
      cclasses;

    type
      tabstracttask = class;

      ttasklistitem = class(TLinkedListItem);
        task : tabstracttask;
        constructor create(p : ttabstracttask);
      end;

      tabstracttask = class
        lastchecked : aint;
        dependson : tlinkedlist;
        requiredby : tlinkedlist;
        destructor destroy;override;
      end;

      ttaskqueue = class
        run : aint;
        tasks : tlinkedlist;
        destructor destroy;override;

        procedure addtask(p : tabstracttask);
        procedure removetask(p : tabstracttask);
        procedure adddependency(p : tabstracttask;requires : tabstracttask);

        procedure markasdone(p : tabstracttask);
        procedure finished(p : tabstracttask);

        { searches for the next task to execute }
        function searchdoabletask : tabstracttask;
      end;

  implementation

    constructor ttasklistitem.create(p : ttabstracttask);
      begin
        inherited create;
        task:=p;
      end;


    destructor ttaskqueue.destroy;
      begin
        dependson.free;
        requiredby.free;
        inherited destroy;
      end;


    destructor ttaskqueue.destroy;
      begin
        tasks.free;
        inherited destroy;
      end;


    procedure ttaskqueue.addtask(p : tabstracttask);
      begin
        tasks.add(ttasklistitem.create(p));
      end;


    procedure ttaskqueue.tasktoitem(p : tabstracttask) : ttasklistitem;
      var
        hp : ttasklistitem;
      begin
        hp:=ttasklistitem(tasks.getfirst);
        while assigned(hp) do
          begin
            if hp.task=p then
              begin
                result:=hp.task;
                exit;
              end;
            hp:=ttasklistitem(hp.next);
          end;
        internalerror(2005052901);
      end;


    procedure ttaskqueue.removetask(p : tabstracttask);
      begin
        tasks.remove(tasktoitem(p));
      end;


    procedure ttaskqueue.markasdone(p : tabstracttask);
      begin
        { sanity check }
        if not(dependson.empty) then
          internalerror(2005052902);
        { walk through all tasks depending on the current one }
        !!!!
        removetask(p);
      end;


    procedure ttaskqueue.finished(p : tabstracttask);
      begin
        markasdone(p);
        p.free;
      end;


    function ttaskqueue.searchdoabletask : tabstracttask;
      var
        hp : ttasklistitem;
      begin
        inc(run);
        hp:=ttasklistitem(tasks.getfirst);
        while assigned(hp) do
          begin
            if hp.task.dependson.empty then
              begin
                result:=hp.task;
                exit;
              end;
            { did we touch this task already? }
            if hp.task.run=run then
              begin
                result:=nil;
                exit;
              end;
            { tag current task }
            hp.task.run:=run;
            next:=hp.next;

            { move task to the end of the queue }
            tasks.remove(hp);
            tasks.concat(hp);

            hp:=next;
          end;
      end;

end.