home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / UTILITY / SYSTEM / GETTIME.ZIP / QUEUES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-01  |  1.8 KB  |  99 lines
  1. unit queues;
  2. interface
  3. const Qmax=32*1024;
  4. type
  5.  Qpos = 0..Qmax;
  6.  Qarray=array[Qpos] of char;
  7.  queue = record
  8.    Qsize: Qpos;
  9.    in_point: Qpos;
  10.    out_point: Qpos;
  11.    a: ^Qarray;
  12.  end;
  13. function NumInQ(Q: queue): Qpos;
  14. function NumAvail (Q: queue): Qpos;
  15. function empty(Q: queue) : boolean;
  16. function full(Q: queue) :boolean;
  17. procedure insertQ(ch: char; var Q: queue);
  18. procedure remove(var ch: char; var Q: queue);
  19. procedure initQ (var Q: queue; maxsize: Qpos);
  20. procedure doneQ (var Q: queue);
  21. implementation
  22.  
  23. function NumInQ;
  24. begin
  25.   with Q do begin
  26.     if in_point < out_point then
  27.       NumInQ := (in_point + Qsize + 1) - out_point
  28.     else
  29.       NumInQ := in_point - out_point;
  30.   end;
  31. end;
  32.  
  33. function NumAvail;
  34. begin
  35.   with Q do begin
  36.     NumAvail := Qsize - NumInQ (Q);
  37.   end;
  38. end;
  39.  
  40. function empty;
  41. begin
  42.     with Q do empty := in_point = out_point;
  43. end;
  44.  
  45. function full;
  46. begin
  47.   with Q do full := (in_point = out_point - 1) or ((in_point = Qsize) and
  48.    (out_point = 0));
  49. end;
  50.  
  51. procedure insertQ;
  52. begin
  53.    with Q do begin
  54.       if full(Q) then begin
  55.          writeln('QUEUE FULL ERROR');
  56.          halt;
  57.       end;
  58.       if in_point =  Qsize then
  59.          in_point := 0
  60.       else
  61.          inc (in_point);
  62.       a^[in_point] :=ch;
  63.    end;
  64. end;
  65. procedure remove;
  66. begin
  67.    if empty(Q) then begin
  68.       writeln('QUEUE EMPTY ERROR');
  69.       halt;
  70.    end;
  71.    with Q do begin
  72.       if out_point = Qsize then out_point := 0
  73.       else inc(out_point);
  74.       ch := a^[out_point];
  75.    end;
  76. end;
  77.  
  78. procedure initQ;
  79. begin
  80.    with Q do begin
  81.      Qsize := maxsize;
  82.      in_point := 0;
  83.      out_point := 0;
  84.      getmem (a, maxsize + 1);
  85.    end;
  86. end;
  87.  
  88. procedure doneQ;
  89. begin
  90.   with Q do begin
  91.     freemem (a, Qsize + 1);
  92.     Qsize := 0;
  93.     in_point := 0;
  94.     out_point := 0;
  95.     a := nil;
  96.   end;
  97. end;
  98.  
  99. end.