home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / enterprs / cpm / utils / a / byteturb.arc / STRUCT.LIB < prev    next >
Encoding:
Text File  |  1989-09-27  |  3.1 KB  |  107 lines
  1.  
  2.  
  3. {
  4.                  procedure and functions in this library
  5.  
  6.   ASwap              swaps any two data structures w/the same size
  7.   Identical          checks if two data structures are identical
  8.   Any                gets next element out of a set (if any)
  9.  
  10. }
  11.  
  12. procedure aswap(var a1addr,a2addr; size : integer);
  13. {
  14.        purpose       swaps A <-> B; see p. 130 of TURBO Reference Manual
  15.        last update   23 Jun 85
  16. }
  17. type
  18.   dummyarray         = array[1..maxint] of byte;
  19. var
  20.   a1                 : dummyarray absolute a1addr;
  21.   a2                 : dummyarray absolute a2addr;
  22.   temp               : byte;
  23.   indx               : integer;
  24. begin
  25.   for indx := 1 to size do begin
  26.     temp     := a1[indx];
  27.     a1[indx] := a2[indx];
  28.     a2[indx] := temp
  29.   end
  30. end; { of proc ASwap }
  31.  
  32. function identical(var a1addr,a2addr; size : integer) : boolean;
  33. {
  34.        purpose       check for identical data structures
  35.        last update   23 Jun 85
  36. }
  37. type
  38.   dummyarray         = array[1..maxint] of byte;
  39. var
  40.   a1                 : dummyarray absolute a1addr;
  41.   a2                 : dummyarray absolute a2addr;
  42.   indx               : integer;
  43. begin
  44.   identical := false;
  45.   for indx := 1 to size do
  46.     if a1[indx] <> a2[indx]
  47.       then exit;
  48.   identical := true
  49. end; { of func Identical }
  50.  
  51. function any(var setaddr,vaddr; size : integer) : boolean;
  52. {
  53.        purpose       remove lowest element in SetAddr
  54.  
  55.        note:         for any scalar type, you can pass this
  56.                      function a set of that type, a variable
  57.                      of that type, and the size of the set.
  58.                      If the set is empty, then Any returns False;
  59.                      otherwise, it returns True, places the lowest
  60.                      (ordinal) element into VAdrr, and removes that
  61.                      same element from SetAddr.  In other words, given
  62.                      the declarations
  63.                          var
  64.                            Scale       : <scalar type>;
  65.                            ScaleSet    : set of <scalar type>;
  66.                      then the loop
  67.                          while Any(ScaleSet,Scale,SizeOf(ScaleSet)) do begin
  68.                            ...
  69.                          end;
  70.                      will execute once for each element in ScaleSet, setting
  71.                      Scale to that element.
  72.  
  73.        last update   23 Jun 85
  74. }
  75. {$R-} { make sure range checking is off }
  76. type
  77.   dummyset           = array[1..32] of byte;
  78. var
  79.   theset             : dummyset absolute setaddr;
  80.   sval               : byte absolute vaddr;
  81.   indx,tval          : integer;
  82.   ival,mask          : byte;
  83. begin
  84.   tval := 0;
  85.   indx := 1;
  86.   while (theset[indx] = 0) and (indx <= size) do begin
  87.     indx := indx + 1;
  88.     tval := tval + 8
  89.   end;
  90.   if indx > size then begin
  91.     any := false;
  92.     sval := 0
  93.   end
  94.   else begin
  95.     any := true;
  96.     ival := theset[indx];
  97.     mask := $01;
  98.     while (mask > 0) and (ival and mask = 0) do begin
  99.       tval := tval + 1;
  100.       mask := mask shl 1
  101.     end;
  102.     theset[indx] := ival xor mask;
  103.     sval := tval
  104.   end
  105. end; { of func Any }
  106. l + 1;
  107.