home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / pcmagazi / 1988 / 15 / convertr.pas next >
Pascal/Delphi Source File  |  1988-07-25  |  4KB  |  134 lines
  1. {$R+}
  2. PROGRAM convertr;
  3.   {Demonstrates conversion of Turbo and Turbo-87 real numbers
  4.   or vice versa using rfrom6 and rfrom8}
  5.  
  6. TYPE
  7.   buff6 = ARRAY[0..5] OF Byte;
  8.   buff8 = ARRAY[0..7] OF Byte;
  9.   str80 = STRING[80];
  10. VAR
  11.   sourcelength, destlength,
  12.   i, ActualRead        : Integer;
  13.   sourcename, destname : str80;
  14.   print                : Char;
  15.   r                    : Real;
  16.   fi, fo               : FILE;
  17.   is87                 : Boolean;
  18.   buffer6              : ARRAY[1..1000] OF buff6;
  19.   buffer8              : ARRAY[1..1000] OF buff8;
  20.  
  21.   PROCEDURE rfrom6(bufferin : buff6; VAR bufferout : buff8);
  22.   VAR
  23.     i, ex : Integer;
  24.   BEGIN
  25.     FillChar(bufferout, 8, 0);
  26.  
  27.     {if number=0 then exit}
  28.     IF bufferin[0] = 0 THEN Exit;
  29.  
  30.     {change to 8087 offset (-129+1023) and reposition for 8087}
  31.     ex := (bufferin[0]+894) SHL 4;
  32.     {move the sign bit and hi part of exponent}
  33.     bufferout[7] := Lo((bufferin[5] AND 128) OR Hi(ex));
  34.  
  35.     {move the lo part of exponent and part of mantissa}
  36.     bufferout[6] := Lo(Lo(ex) OR (bufferin[5] SHR 3 AND 15));
  37.  
  38.     FOR i := 5 DOWNTO 2 DO
  39.       bufferout[i] := Lo((bufferin[i] SHL 5) OR (bufferin[i-1] SHR 3));
  40.  
  41.     bufferout[1] := Lo((bufferin[1] SHL 5) {or 8} );
  42.   END;
  43.  
  44.   PROCEDURE rfrom8(bufferin : buff8; VAR bufferout : buff6);
  45.   VAR
  46.     i, ex : Integer;
  47.   BEGIN
  48.     FillChar(bufferout, 6, 0);
  49.  
  50.     ex := ((bufferin[7] AND 127) SHL 4) OR (bufferin[6] SHR 4);
  51.     {if exponent is 0, number is 0}
  52.     IF ex = 0 THEN Exit;
  53.  
  54.     {change to turbo offset (-1023+129), deal with out of range numbers}
  55.     ex := ex-894;
  56.     IF ex < 1 THEN Exit;
  57.     IF ex >= 255 THEN
  58.       BEGIN
  59.         r := 1e37;
  60.         Exit;
  61.       END;
  62.     bufferout[0] := Lo(ex);
  63.  
  64.     {move the sign bit and part of mantissa}
  65.     bufferout[5] := Lo((bufferin[7] AND 128) OR (bufferin[6] AND 15 SHL 3)
  66.     OR (bufferin[5] SHR 5));
  67.  
  68.     FOR i := 4 DOWNTO 1 DO
  69.       bufferout[i] := Lo((bufferin[i+1] SHL 3) OR (bufferin[i] SHR 5));
  70.   END;
  71.  
  72.   PROCEDURE CheckVersion;
  73.   BEGIN
  74.     CASE SizeOf(Real) OF
  75.       6 : Is87 := False;
  76.       8 : Is87 := True;
  77.       10 : BEGIN
  78.              WriteLn('You cannot use this procedure with TURBOBCD');
  79.              Halt;
  80.            END;
  81.     END;
  82.   END;
  83.  
  84. BEGIN
  85.   ClrScr;
  86.   CheckVersion;
  87.   WriteLn('CONVERTR creates files with 8 byte real numbers from files with');
  88.   WriteLn('6 byte real numbers, or vice versa.');
  89.   WriteLn;
  90.   IF Is87 THEN WriteLn('You are running TURBO-87,COM')
  91.   ELSE WriteLn('You are running plain TURBO.COM');
  92.   WriteLn;
  93.   REPEAT
  94.     Write('Does the source file have 6 or 8 byte real numbers? ');
  95.     ReadLn(sourcelength);
  96.   UNTIL sourceLength IN [6, 8];
  97.   IF sourcelength = 6 THEN destlength := 8 ELSE destlength := 6;
  98.  
  99.   Write('Source file name? '); ReadLn(sourcename);
  100.   Write('Destination file name? '); ReadLn(destname);
  101.  
  102.   Write('Display all real numbers on screen (y/n)? ');
  103.   ReadLn(print);
  104.   print := UpCase(print);
  105.  
  106.   Assign(fi, sourcename); Reset(fi, sourcelength);
  107.   Assign(fo, destname); Rewrite(fo, destlength);
  108.  
  109.   REPEAT
  110.     IF sourcelength = 6 THEN
  111.       BEGIN
  112.         BlockRead(fi, buffer6, 1000, ActualRead);
  113.         FOR i := 1 TO ActualRead DO rfrom6(buffer6[i], buffer8[i]);
  114.         BlockWrite(fo, buffer8, ActualRead);
  115.       END
  116.     ELSE
  117.       BEGIN
  118.         BlockRead(fi, buffer8, 1000, ActualRead);
  119.         FOR i := 1 TO ActualRead DO rfrom8(buffer8[i], buffer6[i]);
  120.         BlockWrite(fo, buffer6, ActualRead);
  121.       END;
  122.     IF print = 'Y' THEN
  123.       FOR i := 1 TO ActualRead DO
  124.         BEGIN
  125.           IF Is87 THEN Move(buffer8[i], r, 8)
  126.           ELSE Move(buffer6[i], r, 6);
  127.           WriteLn(r);
  128.         END;
  129.   UNTIL ActualRead = 0;
  130.   Close(fi);
  131.   Close(fo);
  132. END.
  133.  
  134.