Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPMULTI.ZIP/PRO_CON.PAS

Pascal/Delphi Source File | 1993-01-04 | 14.3 KB | 410 lines

{$R-,S-,I-,D-,F-,V-,B-,N-,L- }
{$M 16384,0,655360 }
PROGRAM ProducerConsumer;

{ Solution of the Producer-Consumer-Problem; Example: Keyboard-I/O

  What is does:
    This program reads characters from the keyboard and displays them in
    a small window on the screen. It also displays status-information about
    the current state of the ring-buffer, the tasks and the semaphores in
    the system.
    ESC : Terminate
    ^S  : The output of characters is suspended until ^Q is received.
          Incoming characters are put into the ring-buffer, however, until
          the buffer overflows.
    ^Q  : Resume character output; the currently stored characters are
          instantaneously displayed.


  Stand: 6/88
  Autor: Christian Philipps
         Düsseldorfer Str. 316
         4130 Moers 1
}

USES Crt, CpMulti;

CONST RBuffSize = 36;                            {Size of Ring-Buffer}
      CritLin   = 15;
      CritCol   = 51;
      FullLin   = 15;
      FullCol   = 34;
      EmptyLin  = 15;
      EmptyCol  = 42;
      PEndLin   = 15;
      PEndCol   = 12;
      OutLin    = 15;
      OutCol    = 24;

VAR   RBuff     : RECORD
                    Buff     : ARRAY[0..RBuffSize] OF CHAR;
                                                 {Ring-Buffer; Last element
                                                  not used, thereby easier to
                                                  handle}
                    Critical : Pointer;          {Semaphore for Access-Synchro-
                                                  nisation}
                    Full     : Pointer;          {Semaphore, used to count
                                                  used bffer-sots}
                    Empty    : Pointer;          {Semaphore, used to cont
                                                  empty buffer-slots}
                    Head     : Byte;             {Head- and Tailpointer}
                    Tail     : Byte;
                  END;
      OutputSem : Pointer;                       {Semaphore, used to control
                                                  character output}
      ProgramEnd: Pointer;                       {Semphore, used to signal
                                                  program end}
      ConsumerNo,                                {Task-IDs}
      ProducerNo: TaskNoType;

{-----------------------------------------------------------------------------}

FUNCTION NextSlot(S:Byte):Byte;

{ Calculate the next buffer position }

BEGIN {NextSlot}
  NextSlot := Succ(S) MOD RBuffSize;
END;  {NextSlot}

{-----------------------------------------------------------------------------}

PROCEDURE WriteCharXY(X,Y:Byte; C:Char);

{ Output a character at X,Y. Thereby assure that the sequence GotoXY/Write is
  always treated as an atomic action. This is done by blocking the CPU }

BEGIN {WriteCharXY}
  BindCPU;
  GotoXY(X,Y);
  Write(C);
  ReleaseCPU;
END;  {WriteCharXY}

{-----------------------------------------------------------------------------}

PROCEDURE WriteByteXY(X,Y,B:Byte);

{ Output a two-digit byte-value at X,Y. See also: WriteCharXY for further
  explanation }

BEGIN {WriteByteXY}
  BindCPU;
  GotoXY(X,Y);
  Write(B:2);
  ReleaseCPU;
END;  {WriteByteXY}

{-----------------------------------------------------------------------------}

PROCEDURE Status;

{ Display Task-Status }

BEGIN {Status}
  BindCPU;
  GotoXY(65,9);
  Write(StateText[GetTaskState(ConsumerNo)]:10);
  GotoXY(65,22);
  Write(StateText[GetTaskState(ProducerNo)]:10);
  ReleaseCPU;
END;  {Status}

{-----------------------------------------------------------------------------}

PROCEDURE SW(S:Pointer; c,l:byte);

{ Execute and visualize SemWait() }

BEGIN {SW}
  WriteByteXY(C,L,SemGetSignals(S));
  SemWait(S);
  WriteByteXY(C,L,SemGetSignals(S));
  Status;
END;  {SW}

{-----------------------------------------------------------------------------}

PROCEDURE SS(S:Pointer; c,l:byte);

{ Execute and visualize SemSignal() }

BEGIN {SS}
  SemSignal(S);
  WriteByteXY(C,L,SemGetSignals(S));
  Status;
END;  {SS}

{-----------------------------------------------------------------------------}

FUNCTION RBuffPut(C:Char):BOOLEAN;

{ Insert a character into the ring-buffer. The function returns TRUE if
  successful, otherwise FALSE. If FALSE is returned a buffer-overflow has
  been detected.
  The behavior of the output task is influenced by the input-control task
  (^Q and ^S).
  Therefore the input-control task must never become blocked for more than
  a moment during the insertion of a character into the ring-buffer. If
  we would simply wait for a slot to become empty, this would block the input
  task which in turn prevented it from detecting a ^Q if output is currently
  suspended. Thus the output task will be forever waiting for a ^S to be
  signalled by the input-task whilst the input-task would be waiting for
  the output-task to empty a slot in the ring-buffer.
  Please note the position of the SemWait-Calls referring to the semaphore
  "Critical"!! It is very important to keep the ring-buffer bound to our-
  selves until the buffer-slot is actually filled! If we first had a look
  at the signal-count of Empty to find out, whether an empty slot exists,
  without having locked the buffer before, anoter task could theoretically
  have taken away the last slot available between our SemGetSignals and our
  SemWait. - Again the deadlock described above were the consequence. }

BEGIN {RBuffPut}
  WITH RBuff DO
  BEGIN
    SW(Critical,CritCol,CritLin);                {gain exclusive access}
    IF SemGetSignals(Empty) = 0                  {Buffer full}
       THEN RBuffPut := False                    {prevent deadlock}
       ELSE BEGIN
              RBuffPut := True;
              SW(Empty,EmptyCol,EmptyLin);       {claim a slot}
              Buff[Tail] := c;                   {insert character}
              WriteCharXY(21+Tail,19,' ');
              IF C = #13
                 THEN WriteCharXY(21+Tail,21,#188)
                 ELSE WriteCharXY(21+Tail,21,c);
              Tail := NextSlot(Tail);            {advance headpointer}
              WriteCharXY(21+Tail,19,#25);
              SS(Full,FullCol,FullLin);          {count new character}
            END;
    SS(Critical,CritCol,CritLin);                {release buffer}
  END;
END;  {RBuffPut}

{-----------------------------------------------------------------------------}

FUNCTION RBuffGet:Char;

{ Take the first Character out of the buffer and pass it to the application.
  If the buffer is currently empty, wait. }

BEGIN {RBuffGet}
  WITH RBuff DO
  BEGIN
    SW(Full,FullCol,FullLin);                    {ask for character}
    SW(Critical,CritCol,CritLin);                {gain exclusive access}
    RBuffGet := Buff[Head];                      {take character}
    WriteCharXY(21+Head,23,' ');
    Head := NextSlot(Head);                      {advance headpointer}
    WriteCharXY(21+Head,23,#24);
    SS(Critical,CritCol,CritLin);                {release buffer}
    SS(Empty,EmptyCol,EmptyLin);                 {count emptied slot}
  END;
END;  {RBuffGet}

{-----------------------------------------------------------------------------}

PROCEDURE Producer;

{ Input-Control Task: Read characters from the keyboard and store them
  in the ring-buffer.
  Whenever a ^S is received, the output of characters to the screen is
  suspended until a ^Q is received }

VAR   C       : Char;
      Display : Boolean;
      Col     : Byte;

BEGIN {Producer}
  Display := True;                               {output active}
  Col := 1;
  REPEAT                                         {endless loop}
    WHILE Keypressed DO
    BEGIN
      C := ReadKey;
      CASE C OF
        ^S: IF Display                           {if not already done}
               THEN BEGIN
                      SW(OutputSem,OutCol,OutLin); {inhibit output}
                      Display := False;          {store state}
                    END;
        ^Q: IF NOT Display                       {if output suspended}
               THEN BEGIN
                      SS(OutputSem,OutCol,OutLin); {reenable output}
                      Display := True;           {store state}
                    END;
       ELSE                                      {no special character}
         BEGIN
           IF NOT RBuffPut(C)
              THEN BEGIN                         {Overflow}
                     BindCPU;                    {atomic action}
                     GotoXY(34,18);
                     TextBackground(White);
                     TextColor(Black);
                     Write(' Overflow ');
                     TextColor(White);
                     TextBackground(Black);
                     ReleaseCPU;                 {End atomic action}
                   END;
         END;
      END; {Case}
    END;
    Sched;                                       {All characters used up;
                                                  give up time-slice}
  UNTIL False;
END;  {Producer}


{-----------------------------------------------------------------------------}

PROCEDURE Consumer;

{ This task takes characters out of the ring-buffer and displays them to the
  screen.
  Whenever a ^S is received by the input-control-task, the "OutputSem" is
  marked busy which leads to a block of the Output-Task.
  "OutputSem" is released when a ^Q is received.
  If an ESC is encountered, this task sets the semaphore "ProgramEnd" to
  signal program termination.
  The Consumer-Task is executed with highest priority, because it spends
  most of its time waiting for input. If, however, characters are avail-
  able, these are processed as quickly as possible. }

CONST  MaxCols = 50;

VAR  C   : Char;
     Col : Byte;

BEGIN {Consumer}
  Col := 1;
  REPEAT                                         {endless loop}
    C := RBuffGet;                               {get character}
    GotoXY(34,18);                               {clear overflow-message}
    Write('          ');
    IF C = #27
       THEN SS(ProgramEnd,PendCol,PendLin)       {end of program}
       ELSE BEGIN
              SW(OutPutSem,OutCol,OutLin);       {wait for output permission}
              IF (Col >= MaxCols) OR (C=#13)     {display overflow / Return}
                 THEN BEGIN
                        BindCPU;                 {critical section}
                        GotoXY(7,8);
                        FOR Col := 1 TO MaxCols DO
                          Write(' ');
                        ReleaseCPU;              {end of critical section}
                        Col := 1;
                      END;
              IF C <> #13                        {output character}
                 THEN BEGIN
                        WriteCharXY(6+Col,8,C);
                        Inc(Col);
                      END;
              SS(OutPutSem,OutCol,OutLin);       {increment signal-count}
            END;
  UNTIL False;
END;  {Consumer}

{-----------------------------------------------------------------------------}

PROCEDURE DrawScreen;

BEGIN {DrawScreen}
  ClrScr;
  BindCPU;
  GotoXY(15,1);
  Write('P R O C E S S  -  S Y N C H R O N I S A T I O N');
  GotoXY(18,3);
  Write('A Solution Of The Producer-Consumer Problem');
  GotoXY(24,4);
  Write('Autor: Christian Philipps 6/88');
  GotoXY(5,7);
  Write('┌───────────────────────────────────────────────────┐');
  GotoXY(5,8);
  Write('│                                                   │ Consumer-Task');
  GotoXY(5,9);
  Write('└───────────────────────────────────────────────────┘');
  GotoXY(6,12);
  Write('┌────────────┬───────────┬──────┬───────┬──────────┐');
  GotoXY(6,13);
  Write('│ ProgramEnd │ OutputSem │ Full │ Empty │ Critical │ Semaphores for');
  GotoXY(6,14);
  Write('├────────────┼───────────┼──────┼───────┼──────────┤ Prozess- and Access-');
  GotoXY(6,15);
  Write('│            │           │      │       │          │ synchronisation');
  GotoXY(6,16);
  Write('└────────────┴───────────┴──────┴───────┴──────────┘');
  GotoXY(5,19);
  Write('Head-Pointer');
  GotoXY(20,20);
  Write('┌────────────────────────────────────┐');
  GotoXY(5,21);
  Write('Ringpuffer ->  │                                    │ Producer─Task');
  GotoXY(20,22);
  Write('└────────────────────────────────────┘');
  GotoXY(5,23);
  Write('Tail-Pointer');
  TextColor(Black);
  TextBackground(White);
  GotoXY(1,25);
  Write('  Ctrl-S  Suspend Output  /  Ctrl-Q  Resume Output  /  ESC  End Program        ');
  TextColor(White);
  TextBackground(Black);
  ReleaseCPU;
  WriteCharXY(25,11,#30);
  WriteCharXY(35,11,#30);
  WriteCharXY(42,11,#30);
  WriteCharXY(51,11,#30);
  WriteCharXY(25,17,#30);
  WriteCharXY(35,17,#30);
  WriteCharXY(42,17,#30);
  WriteCharXY(51,17,#30);
  WriteCharXY(21,19,#25);
  WriteCharXY(21,23,#24);
END;  {DrawScreen}

{-----------------------------------------------------------------------------}

FUNCTION InitConPro:BOOLEAN;

BEGIN {InitConPro}
  InitConPro := False;
  WITH RBuff DO
  BEGIN
    FillChar(Buff,RBuffSize,' ');                {Clear buffer}
    Head := 0;
    Tail := 0;
    IF CreateSem(Critical) <> Sem_OK             {Create semaphores}
       THEN Exit;
    IF CreateSem(Full) <> Sem_OK
       THEN Exit;
    IF CreateSem(Empty) <> Sem_OK
       THEN Exit;
    SemSet(Empty,RBuffSize);                     {All slots are empty...}
    SemClear(Full);                              {no one is full}
  END;
  IF CreateSem(ProgramEnd) <> Sem_Ok             {Create program-end flag}
     THEN Exit;
  SemClear(ProgramEnd);                          {clear signal-count}
  IF CreateSem(OutputSem) <> Sem_Ok              {Create semaphore}
     THEN Exit;

  ConsumerNo := CreateTask(@Consumer,Pri_Kernel,500); {Create tasks}
  ProducerNo := CreateTask(@Producer,Pri_User,500);
  IF (ConsumerNo < 0) OR                         {Error?}
     (ProducerNo < 0)
     THEN Exit;
  DrawScreen;
  InitConPro := True;
END;  {InitConPro}

{-----------------------------------------------------------------------------}

BEGIN {Main}
  IF NOT InitConPro
     THEN BEGIN
            Writeln('Error during Initialisation!');
            Halt;
          END;
  SW(ProgramEnd,PendCol,PendLin);
END.  {Main}