Программная реализация простого бесприоритетного планировщика потоков

Program Potok2;
 
  type                             // Еденица потока
    descriptor = record
       id : integer;               // Идентефикатор
   status : integer;  {0 - runs, 1 - wait,  2 - blok}  //Состояние
    end;
 
const MAX = 20;                    // Максимальное место в очереди
const astat : array [0..2] of string = ('runs', 'wait', 'blok');  //Служебный данные
 
 
var
        que : array [0..MAX-1]of descriptor;
        i, qnext, qindex, qlength : integer;  //Служебные данные для очереди
        Thead:descriptor;                     //Еденица потока
        func : integer;                       //Пользовательский ответ
        id : integer;
                point : integer;                      //Поток в котором управление
                temp : integer;
                ch : integer;
 
    Procedure IqueInit;                            //Служебная процедура для установки
     begin                                             //переменных по дефолту
      qnext := 0; qindex := qnext;
      qlength:=0;
     end;
 
  function queadd(eque : descriptor):boolean; {Добавление в очередь}
  begin
    queadd := true;
    if qnext < MAX then
      begin
       que[qnext] := eque;
       inc(qnext);
      end
    else queadd := false;
  end;
 
  function quedel(eque : integer):boolean;   {Удаление из очереди}
  begin
    if  qnext = 0 then quedel := false
         else    begin
                for i := eque to qlength-2 do
                   que[i] := que[i+1];
                   dec(qnext);
           dec(qlength);
                   quedel := true;
             end;
  end;
 
begin
    IqueInit;       // Установка по дефолту служебных переменных
    point := 0;     // Указатель показывающий какой поток в данный момент взял управление на себя
        ch := 0;        // Служебная переменная для нумерования(id) потока
 
 
    repeat
    for i := 0 to qlength-1 do         //Вывод состояния очереди
        begin
        write('PoTok [', que[i].id, ']   CTaTyC[', astat[que[i].status],']');
        if point = i then write(' <---- '); writeln;
        end;
 
      writeln('Bb|bePuTE DeuCTBuE');
      writeln('1 - Co3DaHue Potoka |  2 - 3aBePIIIeHuE PoToKa | 3 - 3akoH4uT KBaHT | ');
      writeln('4 - bLoKuPoBaTb | 5 - Pa3bLoKuPoBaTb | 6 - Exit');
      readln(func);
 
 
        //Действие пользователя
    {-----------------------------------------------------------------------------------}
 
           // Создание потока
           case func of
        1 : begin
                 Thead.id := ch;     // id потоку
                 Thead.status := 1;  // поток создается по умолчанию со статусом ожидание
                 if not queadd(Thead) then writeln('-----------> HeT MeCT<----------')
                 else
                   begin
                      inc(qlength); inc(ch);  //Учитываем размер очереди и id потока
                      if qlength = 1 then  que[point].status := 0;
                   end;
              if ch=MAX then ch := 0;
              end;
    {---------------------------------------------------------------------------------}
 
    {---------------------------------------------------------------------------------}
         // Завершение потока
      2 : begin temp := que[point].id;
                if not quedel(point) then writeln('----------> o4ePeDb PYcTa <---------')
                else
                   begin
                       writeln('-----> PoToK c id =', temp,' 3aBeP|||eH <-------');
                       if que[point].status <> 3 then que[point].status := 0;
                   end;
          end;
 
   {---------------------------------------------------------------------------------}
 
   {---------------------------------------------------------------------------------}
         // Закончить квант
      3 : begin
              if qlength > 0 then
               begin
                 if que[point].status <> 2 then que[point].status := 1;
                 inc(point); if point = qlength then point := 0;
                 if que[point].status <> 2 then que[point].status := 0
               end else writeln('--------> o4ePeDb PYcTa<-------');
          end;
 
   {---------------------------------------------------------------------------------}
 
   {---------------------------------------------------------------------------------}
        //Блокирование потока
 
      4 : begin
              if qlength <> 0 then
                    que[point] .status := 2
                    else writeln('------------> o4ePeDb PYcTa <---------')
          end;
 
   {---------------------------------------------------------------------------------}
 
   {---------------------------------------------------------------------------------}
         //Разблокирование потока
      5 : begin
                 if qlength <> 0 then
                  begin   if que[point].status = 2 then
                                          que[point].status := 1;
                  end
                 else writeln('-----------> o4ePeDb PYcTa <----------')
          end;
   {---------------------------------------------------------------------------------}
 
    end;
 
 
  until func = 6;
 
end.

uses Crt;
const status:array[0..4]of string=('memory runs','memory wait','load from disk','save to disk','save to disk locked');
type
  pDiscript=^tDiscript;
  tDiscript=record
    id:integer;
    st:integer;
    next:pDiscript;
    end;
var
  head,temp:pDiscript;
  kvant,i:integer;
  menu:char;
begin
  head:=nil;
  for i:=1 to 10 do
    begin
      new(temp);
      temp^.next:=head;
      temp^.id:=random(1000);
      temp^.st:=3;
      head:=temp;
    end;
  kvant:=50;
  repeat
    clrscr;
    writeln('a-add; c-close; k-kvant; l-lock; u-unlock; e-exit.');
    i:=0;
    temp:=head;
    while i<3 do
      begin
        if temp^.st<>4 then
          begin
            temp^.st:=i;
            inc(i);
          end;
        temp:=temp^.next;
      end;
    temp:=head;
    while temp<>nil do
      begin
        writeln('ID:=',temp^.id:4,'  status:=',status[temp^.st]);
        temp:=temp^.next;
      end;
    menu:=' ';
    i:=50;
    if KeyPressed then menu:=ReadKey;
    if menu in ['a','c','k','l','u']then
      case menu of
        'a':begin
              i:=kvant;
              new(temp);
              temp^.st:=3;
              temp^.id:=random(1000);
              temp^.next:=head;
              head:=temp;
              kvant:=1;
            end;
        'c':begin
              temp:=head;
              head:=head^.next;
              dispose(temp);
              kvant:=i;
            end;
        'k':begin
              kvant:=1;
            end;
        'l','u':begin
              write('enter id:=');
              readln(i);
              temp:=head;
              while(temp^.next<>nil)and(temp^.id<>i)do
                temp:=temp^.next;
              if temp^.id=i then
                if temp^.st=4 then temp^.st:=3
                  else temp^.st:=4;
              i:=50;
            end;
        end;
    dec(kvant);
    if kvant=0 then
      begin
        repeat
          temp:=head;
          if head^.st<>4 then head^.st:=3;
          while temp^.next<>nil do
            temp:=temp^.next;
          temp^.next:=head;
          head:=head^.next;
          temp^.next^.next:=nil;
        until head^.st<>4;
        kvant:=i;
      end;
    delay(100);
  until menu='e';
  while head^.next=nil do
    begin
      temp:=head;
      head:=head^.next;
      dispose(temp);
    end;
  dispose(head);
end.