home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / vol_300 / 344_02 / vmks.c < prev    next >
Text File  |  1990-05-20  |  2KB  |  84 lines

  1. /*
  2. HEADER:         ;
  3. TITLE:          BASIC mks() function in C
  4. VERSION:        1.0;
  5.  
  6. DESCRIPTION:    performs BASIC mks() function, packing a value into
  7.                 a string of 4 chars
  8.  
  9. KEYWORDS:       packed, single precision, BASIC, mks;
  10. SYSTEM:         Xenix 3.4b, MSDOS;
  11. FILENAME:       vmks.c
  12. WARNINGS:       compile with -dNO_PROTOTYPE if your system does not
  13.                 support prototyping, with -dFOR_MSDOS if you are compiling
  14.                 for MSDOS with an ANSI standard compiler.
  15.                 Defaults assume compiling with prototypes for
  16.                 Xenix 3.4b on Altos 2086 computer.
  17.  
  18. SEE-ALSO:       ;
  19. AUTHORS:        Vern Martin, 449 W. Harrison, Alliance, Ohio 44601;
  20. COMPILERS:      ECOSOFT ECO-C88, XENIX 3.4B STANDARD COMPILER;
  21. */
  22.  
  23.  
  24.  
  25.  
  26. #include "vernmath.h"
  27.  
  28. #define WIDTH 4
  29.  
  30. char *vmks(amt)
  31. double amt;
  32. {
  33. /* local int */
  34.     int e;      /* exponent */
  35.     double mantissa = frexp(amt,&e);
  36.  
  37.     int i,sign = 1;
  38.  
  39.     static unsigned char c[WIDTH];
  40.     static double k[ WIDTH - 1 ] = {
  41.         1.1920928955078125e-07,
  42.         3.0517578125000000e-05,
  43.         7.8125000000000000e-03,
  44.     };
  45.  
  46. /* make mantissa a positive number if necessary */
  47.     if (mantissa < 0.0) {
  48.         sign = -1;
  49.         mantissa *= (double) sign;
  50.     }
  51.  
  52. /* adjust result by multiplying mantissa by 2 until mantissa is greater than 1,
  53.     each time you multiply the mantissa by 2, subtract 1 from
  54.     the power you raise two by, in this way we duplicate the values
  55.     returned by BASIC's mkd() which returns 1.x * 2^e, where as
  56.     frexp() returns .x * 2^e */
  57.  
  58.     while(mantissa < 1.0) {
  59.         mantissa *= 2.0;
  60.         e--;
  61.     }
  62.  
  63.     c[ WIDTH - 1 ] = (unsigned char) (e + 129);
  64.  
  65. /* total first 3 chars multiplied by there respective factors */
  66.     for ( i = WIDTH - 2; i >= 0;i-- ) {
  67.         if (mantissa < k[ i ]) c[ i ] = (unsigned char) 0;
  68.         else {
  69.             c[ i ] = (unsigned char) (mantissa/k[ i ]);
  70.             mantissa -= c[ i ] * k[ i ];
  71.         }
  72.     }
  73.  
  74. /* unless the number is negative, reverse next to last char */
  75.     if (sign != -1) {
  76.         c[ WIDTH - 2 ] -= (unsigned char) 128;
  77.     }
  78.  
  79.     if (amt == 0.0) c[ WIDTH - 1 ] = (unsigned char) 0;
  80.  
  81.  
  82.     return((char *)c);
  83. }
  84.