home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ALLSWAP.ZIP / ALLSWAP.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-03-16  |  3.9 KB  |  134 lines
  1. Uses Crt;
  2.  
  3.  
  4. Type
  5.    VarBuffer   =  Array[0..255] of Byte;
  6.    VarType     =  (SInt,Int,LInt,RealType,StringType,WordType,Charac,
  7.                     Bool,Bite,SingleP,DoubleP,CompType,ExtendP,Enum,Other);
  8.  
  9. (*═══════════════════════════════════════════════════════════════════════════*)
  10. Procedure AllSwap(Var X,Y; FormalType:VarType);
  11.  
  12. (* Copyright 1988
  13.    By MorganSoft
  14.    All rights reserved.
  15.  
  16.    Last Modified 3-15-88
  17.  
  18.    This program is NOT released to the public domain, and you may use
  19.    it (for now) with the sole proviso that you do not remove the comments
  20.    or this notification.
  21.  
  22.    Purpose:
  23.       To use one procedure to swap two variables of almost any type
  24.       (pointers and compound types excluded) without running afoul
  25.       of type checking by the compiler.
  26.  
  27.    Requirements:
  28.       Two Global Types
  29.  
  30.       Type
  31.          VarBuffer   =  Array[0..255] of Byte;
  32.          VarType     =  (SInt,Int,LInt,RealType,StringType,WordType,Charac,
  33.                         Bool,Bite,SingleP,DoubleP,CompType,ExtendP,Enum,Other);
  34.  
  35.    Sample Call:
  36.       AllSwap(X,Y,RealType);
  37.  
  38.    NOTES:
  39.       All user defined enumerated types can be switched as well as
  40.       the standard Turbo Pascal types available.
  41.  
  42.       Since I do not have a 8087 coprocessor, I have been unable to test
  43.       run some of the types--they may or may not work though I suspect that
  44.       they will.  The basic logic of the program is such that I strongly
  45.       doubt that a problem would occurr.  But I still have NOT checked those
  46.       types.
  47.  
  48. *)
  49.  
  50. Var
  51.    P1             :  VarBuffer Absolute X;  (* Get access to untyped var X *)
  52.    P2             :  VarBuffer Absolute Y;  (* Get access to untyped var Y *)
  53.    B              :  VarBuffer;             (* This is our holding variable *)
  54.    J, K, I        :  Integer;
  55.  
  56. Begin
  57.  
  58. (*    The case statement allows us to input the various byte lengths taken
  59.       up by each supported type   *)
  60.  
  61.    Case FormalType of
  62.       Bite,Charac,
  63.          Bool, SInt,Enum   :  I := 1;
  64.       Int, WordType        :  I := 2;
  65.       LInt, SingleP        :  I := 4;
  66.       RealType             :  I := 6;
  67.       DoubleP, CompType    :  I := 8;
  68.       ExtendP              :  I := 10;
  69.  
  70. (*    Type String already contains the length of the actual variable;
  71.       we just need to access it and adjust for the index length.      *)
  72.  
  73.       StringType           :  Begin
  74.                                  I := P1[0] + 1;
  75.                                  J := P2[0] + 1;
  76.                                  If (I < J) then
  77.                                     I := J   (*  must use the longer
  78.                                                  of the two           *)
  79.                               End;
  80.      Other                 :  Exit
  81.    End;                    (*  End Case       *)
  82.  
  83. (*    This as you will no doubt recognize, it the usual swap routine,
  84.       done byte by byte         *)
  85.  
  86.    For K := 0 To I-1 do
  87.       Begin
  88.          B[K]  := P1[K];
  89.          P1[K] := P2[K];
  90.          P2[K] := B[K]
  91.       End                  (*  End For Loop   *)
  92. End;                       (*  End AllSwap    *)
  93. (*═══════════════════════════════════════════════════════════════════════════*)
  94.  
  95. Var
  96.    X,Y:String;
  97.    J,K:Integer;
  98.    L,M:Real;
  99. Begin
  100.    Clrscr;
  101.    X := 'This is the variable x, initially.';
  102.    Y := 'And this, Y.';
  103.    J := 255;
  104.    K := 9;
  105.    L := 1.004;
  106.    M := 2.678E+6;
  107.    Writeln('X = ',X);
  108.    Writeln('Y = ', Y);
  109.    AllSwap(X,Y,StringType);
  110.    Writeln('X = ',X);
  111.    Writeln('Y = ', Y);
  112.    Writeln;
  113.  
  114.    Writeln('J = ',J);
  115.    Writeln('K = ',K);
  116.    AllSwap(J,K,Int);
  117.    Writeln('J = ',J);
  118.    Writeln('K = ',K);
  119.    Writeln;
  120.  
  121.    Writeln('L = ',L);
  122.    Writeln('M = ', M);
  123.    AllSwap(L,M,RealType);
  124.    Writeln('L = ',L);
  125.    Writeln('M = ', M);
  126.  
  127.    Writeln;
  128.    Writeln('The above three swap examples (String swap, Integer swap,');
  129.    Writeln('and Real swap, were all perfomred by the same procedure.')
  130. End.
  131.  
  132.  
  133.  
  134.