home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BYTELIB.ZIP / STRUCT.LIB < prev    next >
Encoding:
Text File  |  1985-12-13  |  3.1 KB  |  104 lines
  1. {
  2.                  procedure and functions in this library
  3.  
  4.   ASwap              swaps any two data structures w/the same size
  5.   Identical          checks if two data structures are identical
  6.   Any                gets next element out of a set (if any)
  7.  
  8. }
  9.  
  10. procedure ASwap(var A1Addr,A2Addr; Size : Integer);
  11. {
  12.        purpose       swaps A <-> B; see p. 130 of TURBO Reference Manual
  13.        last update   23 Jun 85
  14. }
  15. type
  16.   DummyArray         = array[1..MaxInt] of Byte;
  17. var
  18.   A1                 : DummyArray absolute A1Addr;
  19.   A2                 : DummyArray absolute A2Addr;
  20.   Temp               : Byte;
  21.   Indx               : Integer;
  22. begin
  23.   for Indx := 1 to Size do begin
  24.     Temp     := A1[Indx];
  25.     A1[Indx] := A2[Indx];
  26.     A2[Indx] := Temp
  27.   end
  28. end; { of proc ASwap }
  29.  
  30. function Identical(var A1Addr,A2Addr; Size : Integer) : Boolean;
  31. {
  32.        purpose       check for identical data structures
  33.        last update   23 Jun 85
  34. }
  35. type
  36.   DummyArray         = array[1..MaxInt] of Byte;
  37. var
  38.   A1                 : DummyArray absolute A1Addr;
  39.   A2                 : DummyArray absolute A2Addr;
  40.   Indx               : Integer;
  41. begin
  42.   Identical := False;
  43.   for Indx := 1 to Size do
  44.     if A1[Indx] <> A2[Indx]
  45.       then Exit;
  46.   Identical := True
  47. end; { of func Identical }
  48.  
  49. function Any(var SetAddr,VAddr; Size : Integer) : Boolean;
  50. {
  51.        purpose       remove lowest element in SetAddr
  52.  
  53.        note:         for any scalar type, you can pass this
  54.                      function a set of that type, a variable
  55.                      of that type, and the size of the set.
  56.                      If the set is empty, then Any returns False;
  57.                      otherwise, it returns True, places the lowest
  58.                      (ordinal) element into VAdrr, and removes that
  59.                      same element from SetAddr.  In other words, given
  60.                      the declarations
  61.                          var
  62.                            Scale       : <scalar type>;
  63.                            ScaleSet    : set of <scalar type>;
  64.                      then the loop
  65.                          while Any(ScaleSet,Scale,SizeOf(ScaleSet)) do begin
  66.                            ...
  67.                          end;
  68.                      will execute once for each element in ScaleSet, setting
  69.                      Scale to that element.
  70.  
  71.        last update   23 Jun 85
  72. }
  73. {$R-} { make sure range checking is off }
  74. type
  75.   DummySet           = array[1..32] of Byte;
  76. var
  77.   theSet             : DummySet absolute SetAddr;
  78.   SVal               : Byte absolute VAddr;
  79.   Indx,TVal          : Integer;
  80.   IVal,Mask          : Byte;
  81. begin
  82.   TVal := 0;
  83.   Indx := 1;
  84.   while (theSet[Indx] = 0) and (Indx <= Size) do begin
  85.     Indx := Indx + 1;
  86.     TVal := TVal + 8
  87.   end;
  88.   if Indx > Size then begin
  89.     Any := False;
  90.     SVal := 0
  91.   end
  92.   else begin
  93.     Any := True;
  94.     IVal := theSet[Indx];
  95.     Mask := $01;
  96.     while (Mask > 0) and (IVal and Mask = 0) do begin
  97.       TVal := TVal + 1;
  98.       Mask := Mask shl 1
  99.     end;
  100.     theSet[Indx] := IVal xor Mask;
  101.     SVal := TVal
  102.   end
  103. end; { of func Any }
  104.