home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / microcrn / issue_33.arc / PASCAL.FIG < prev    next >
Encoding:
Text File  |  1986-11-20  |  2.9 KB  |  117 lines
  1.  
  2. Program LIFOdemo;
  3. const
  4.   qsize = 20;
  5.  
  6. var
  7.   queue : array [0..qsize] of char; { must be global vars since can be }
  8.   qptr : 0..qsize;                  { asynchronously updated }
  9.   ch2, ch3 : char;
  10.  
  11.  
  12. function PutOnQ (ch:char):boolean;
  13. begin
  14.   if succ(qptr) > qsize then   { queue full? }
  15.     PutOnQ := false            { yes, signal failure }
  16.   else begin
  17.     qptr := succ(qptr);        { not full, update pointer & add data }
  18.     queue[qptr] := ch;
  19.     PutOnQ := true;
  20.   end;
  21. end;
  22.  
  23. function GetFromQ (var ch:char):boolean;
  24. begin
  25.   if qptr = 0 then              { queue empty? }
  26.     GetFromQ := false           { yes, signal failure }
  27.   else begin
  28.     ch :=queue[qptr];           { else get data & update pointer }
  29.     qptr := pred(qptr);
  30.     GetFromQ := true;
  31.   end;
  32. end;
  33.  
  34. procedure ProcessInput (ch:char); { not really much processing here! }
  35. begin
  36.   write(ch);
  37. end;
  38.  
  39.  
  40. begin
  41.   qptr := 0;
  42.   ch2 := '@';          { pred('A') }
  43.  
  44.   repeat
  45.     ch2 := succ(ch2);
  46.  
  47. { the following statement is to demonstrate the effects of async removal }
  48. {   if random(10) > 3 then
  49.       if GetFromQ(ch3) then ProcessInput(ch3);  }
  50.  
  51.   until not(PutOnQ(ch2));
  52.  
  53.   while GetFromQ(ch2) do
  54.     ProcessInput(ch2);
  55. end.
  56.  
  57. {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  58.  
  59. Program FIFOdemo;
  60.  
  61. const
  62.   qsize = 20;
  63.  
  64. var
  65.   queue : array [0..qsize] of char; { must be global vars }
  66.   q_top_ptr, q_bot_ptr : 0..qsize;
  67.   ch2, ch3 : char;
  68.  
  69.  
  70. function PutOnQ (ch:char):boolean;
  71. begin
  72.   if succ(q_bot_ptr) mod (qsize + 1) = q_top_ptr then  { queue full? }
  73.     PutOnQ := false                          { if yes, can't add }
  74.   else begin
  75.     q_bot_ptr := succ(q_bot_ptr) mod (qsize + 1);  { update bottom pointer }
  76.     queue[q_bot_ptr] := ch;                  { store the data }
  77.     PutOnQ := true;                          { signal success }
  78.   end;
  79. end;
  80.  
  81. function GetFromQ (var ch:char):boolean;
  82. begin
  83.   if q_top_ptr = q_bot_ptr then         { queue empty? }
  84.     GetFromQ := false                   { if yes, then nothing to get }
  85.   else begin
  86.     q_top_ptr := succ(q_top_ptr) mod (qsize + 1);   { update top pointer }
  87.     ch := queue[q_top_ptr];                         { get the data }
  88.     GetFromQ := true;                               { signal success }
  89.   end;
  90. end;
  91.  
  92. procedure ProcessInput (ch:char);  { not a lot of processing here! }
  93. begin
  94.   write(ch);
  95. end;
  96.  
  97.  
  98. begin  { Program  FIFO }
  99.   q_top_ptr := 0;       { initialize pointers }
  100.   q_bot_ptr := 0;
  101.   ch2 := '@';           { pred ('A') for demo }
  102.  
  103.   repeat
  104.     ch2 := succ(ch2);   { bump input data }
  105.  
  106. { the following statement is to show asynchronous removal  }
  107. {   if random(10) > 3 then              
  108.       if GetFromQ(ch3) then ProcessInput(ch3);  }
  109.  
  110.   until not(PutOnQ(ch2));
  111.  
  112.   while GetFromQ(ch2) do
  113.     ProcessInput(ch2);
  114. end.
  115.  
  116.  
  117.