home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR8 / CALC_SRC.ZIP / FP_MIN.S < prev    next >
Text File  |  1993-06-22  |  9KB  |  294 lines
  1. /*
  2.     FP.S        --  Suite of convenient high-level functions for doing
  3.                     floating point calculations.
  4.     Author:  Tim Farley
  5.       Date:  25-Feb-1993
  6.     Revised: 26-Feb-1993
  7.  
  8.     Explanation:  The UCR Floating Point library, adapted to The SemWare
  9.     Editor in UCRFP.S, provides a number of convenient floating point
  10.     functions.  These are defined in this file, along with a series
  11.     of more convenient higher-level functions to access the library.
  12.  
  13.     This file is intended to be #include'd in your macros which need
  14.     to access floating point numbers.
  15.  
  16.   Release:  This source code and the associated SAL macros are released to
  17.             the public domain.  Please honor any restrictions which are
  18.             included in present or future versions of UCRLIB, but beyond
  19.             that I do not restrict use.  I would appreciate it if you
  20.             mention my name in the docs of any derivative macros you
  21.             distribute.
  22.  
  23.               ***** Wednesday, 9 June 1993 [L.A.V.] *****
  24.           ***** Removed unused code and renamed fp_min.s *****
  25. */
  26.  
  27. /*
  28.     LOW LEVEL INTERFACE is defined here.
  29. */
  30. binary "FPLOW.BIN"
  31.     /*
  32.        Floating Point Accumulator (fpa) operations.
  33.     */
  34.             proc lsfpa( string Single )                                 : 0
  35.     integer proc ssfpa( var string Single )                             : 3
  36.             proc ldfpa( string Double )                                 : 6
  37.     integer proc sdfpa( var string Double )                             : 9
  38.             proc lefpa( string Extended )                               : 12
  39.     integer proc sefpa( var string Extended )                           : 15
  40.     /*
  41.        Floating Point Operand (fpo) operations
  42.     */
  43.             proc lsfpo( string Single )                                 : 18
  44.             proc ldfpo( string Double )                                 : 21
  45.             proc lefpo( string Extended )                               : 24
  46.     /*
  47.        Integer operations
  48.  
  49.        Since SAL's integers are signed longints (32 bits), most of the other
  50.        operations are not truly useful from SAL, hence not defined.
  51.     */
  52.             proc ltof( integer SignedLong )                             : 27
  53.     integer proc ftol( var integer SignedLong )                         : 30
  54.     /*
  55.        Mathematical operations
  56.     */
  57.             proc fpadd()                                                : 33
  58.             proc fpsub()                                                : 36
  59.     integer proc fpcmp()                                                : 39
  60.             proc fpmul()                                                : 42
  61.             proc fpdiv()                                                : 45
  62.     /*
  63.        String conversions
  64.     */
  65.     integer proc ftoa( var string Target, integer Wide, integer DecP )  : 48
  66.     integer proc etoa( var string Target, integer Wide )                : 51
  67.             proc atof( string Source )                                  : 54
  68. end
  69.  
  70.  
  71. /*
  72.     SIZES OF STRINGS NEEDED
  73. */
  74. constant
  75.     IEEE_SINGLE   = 4,
  76.     IEEE_DOUBLE   = 8,
  77.     IEEE_EXTENDED = 10,
  78.     IEEE          = 10      // Convenient for declaring max-length strings
  79.  
  80. /*
  81.     COMMONLY USED CONSTANTS
  82. */
  83. string
  84.     // The number ZERO in all three formats
  85.     ZeroSingle[ IEEE_SINGLE ] = CHR(0)+CHR(0)+CHR(0)+CHR(0),
  86.     ZeroDouble[ IEEE_DOUBLE ] = CHR(0)+CHR(0)+CHR(0)+CHR(0)
  87.                                +CHR(0)+CHR(0)+CHR(0)+CHR(0),
  88.     ZeroExtended[ IEEE_EXTENDED ] = CHR(0)+CHR(0)+CHR(0)+CHR(0)+CHR(0)
  89.                                    +CHR(0)+CHR(0)+CHR(0)+CHR(0)+CHR(0)
  90.  
  91. integer
  92.     FMathError = FALSE      // Set to TRUE if overflow or error occurs
  93.  
  94. /*
  95.     FAccumulator  puts a real number into the UCR FP library's FPA, and
  96.         returns it's size.  Returns 0 if doesn't appear to be a correct
  97.         real number (based only on the size!)
  98. */
  99. integer proc FAccumulator( string RealNumber )
  100.     integer RealSize
  101.  
  102.     FMathError = FALSE
  103.     RealSize = Length( RealNumber )
  104.     case  ( RealSize )
  105.         when IEEE_SINGLE        lsfpa( RealNumber )
  106.         when IEEE_DOUBLE        ldfpa( RealNumber )
  107.         when IEEE_EXTENDED      lefpa( RealNumber )
  108.         otherwise               FMathError = TRUE  return ( 0 )
  109.     endcase
  110.  
  111.     return ( RealSize )
  112. end FAccumulator
  113.  
  114.  
  115. /*
  116.     FOperand  puts a real number into the UCR FP library's FPO, and
  117.         returns it's size.  Returns 0 if doesn't appear to be a correct
  118.         real number (based only on the size!)
  119. */
  120. integer proc FOperand( string RealNumber )
  121.     integer RealSize
  122.  
  123.     FMathError = FALSE
  124.     RealSize = Length( RealNumber )
  125.     case  ( RealSize )
  126.         when IEEE_SINGLE        lsfpo( RealNumber )
  127.         when IEEE_DOUBLE        ldfpo( RealNumber )
  128.         when IEEE_EXTENDED      lefpo( RealNumber )
  129.         otherwise               FMathError = TRUE  return ( 0 )
  130.     endcase
  131.  
  132.     return ( RealSize )
  133. end FOperand
  134.  
  135.  
  136. /*
  137.     FResult  retrieves a result in the specified size from the FPA
  138. */
  139. string proc FResult( integer IEEESize )
  140.     string Answer[ IEEE ] = ""
  141.  
  142.     FMathError = FALSE
  143.     case  ( IEEESize )
  144.         when IEEE_SINGLE
  145.             FMathError = NOT ssfpa( Answer )
  146.             if  FMathError
  147.                 return ( ZeroSingle )
  148.             endif
  149.         when IEEE_DOUBLE
  150.             FMathError = NOT sdfpa( Answer )
  151.             if  FMathError
  152.                 return ( ZeroDouble )
  153.             endif
  154.         when IEEE_EXTENDED
  155.             FMathError = NOT sefpa( Answer )
  156.             if  FMathError
  157.                 return ( ZeroExtended )
  158.             endif
  159.     endcase
  160.  
  161.     return ( Answer )
  162. end FResult
  163.  
  164.  
  165. /*
  166.     Perform a binary math operation
  167. */
  168. constant
  169.     OP_ADD = 1,
  170.     OP_SUB = 2,
  171.     OP_MUL = 3,
  172.     OP_DIV = 4
  173.  
  174. string proc FOperation( integer Operator, string LeftOp, string RightOp )
  175.     integer AnswerSize = 0
  176.     integer OperandSize
  177.  
  178.     // Left operand into the Floating Point Accumulator (FPA)
  179.     // Default answer to same size
  180.     AnswerSize = FAccumulator( LeftOp )
  181.     if  FMathError  return ( ZeroSingle ) endif
  182.  
  183.     // Right operand into the Floating Point Operand (FPO)
  184.     OperandSize = FOperand( RightOp )
  185.     if  FMathError  return ( ZeroSingle ) endif
  186.  
  187.     // Promote answer to largest size passed
  188.     if  OperandSize > AnswerSize
  189.         AnswerSize = OperandSize
  190.     endif
  191.  
  192.     // Perform the appropriate math operation
  193.     case ( Operator )
  194.         when OP_ADD  fpadd()
  195.         when OP_SUB  fpsub()
  196.         when OP_MUL  fpmul()
  197.         when OP_DIV  fpdiv()
  198.         otherwise    FMathError = TRUE  return( ZeroSingle )
  199.     endcase
  200.  
  201.     return ( FResult( AnswerSize ) )   // Return answer to the caller
  202. end FOperation
  203.  
  204.  
  205. /*
  206.     Add two numbers
  207. */
  208. string proc FAdd( string LeftOp, string RightOp )
  209.     return ( FOperation( OP_ADD, LeftOp, RightOp ) )
  210. end FAdd
  211.  
  212. /*
  213.     Subtract two numbers
  214. */
  215. string proc FSub( string LeftOp, string RightOp )
  216.     return ( FOperation( OP_SUB, LeftOp, RightOp ) )
  217. end FSub
  218.  
  219. /*
  220.     Multiply two numbers
  221. */
  222. string proc FMul( string LeftOp, string RightOp )
  223.     return ( FOperation( OP_MUL, LeftOp, RightOp ) )
  224. end FMul
  225.  
  226. /*
  227.     Divide two numbers
  228. */
  229. string proc FDiv( string LeftOp, string RightOp )
  230.     return ( FOperation( OP_DIV, LeftOp, RightOp ) )
  231. end FDiv
  232.  
  233.  
  234.  
  235. /*
  236.     FVal does for real numbers what Val() does for INTEGERS.
  237.     That is, it converts a STRING representation of a number into a real
  238.     number.
  239.  
  240.     NOTE:  Does not support bases other than 10.
  241. */
  242. string proc FVal( string Ascii )
  243.     // Convert the string to a number in the FPA
  244.     atof( Ascii )
  245.  
  246.     // Retrieve answer from FPA in full precision.
  247.     // If overflow, return zero.  Else return actual answer.
  248.     return ( FResult( IEEE_EXTENDED ) )
  249. end FVal
  250.  
  251.  
  252. /*
  253.     FStr does for real numbers what Str() does for INTEGERS
  254.     That is, it converts a real number to its STRING representation.
  255.  
  256.     NOTE:  Does not support bases other than 10.
  257. */
  258. constant
  259.     MAX_WIDTH = 254
  260.  
  261. string proc FStr( string RealNumber, integer Width, integer Decimals )
  262.     // NOTE: this string must have room for a NUL terminator at end of string
  263.     string Answer[ MAX_WIDTH + 1 ] = ""
  264.  
  265.     // Operand into the Floating Point Accumulator (FPA)
  266.     FAccumulator( RealNumber )
  267.  
  268.     // Make sure we're not trying to do something stupid
  269.     if  Width > MAX_WIDTH
  270.         FMathError = TRUE
  271.     endif
  272.  
  273.     // Get out of dodge if something is wrong.  Note that FMathError could
  274.     // have been set by either or both of the operations above.
  275.     if  FMathError
  276.         return ( "Error!" )
  277.     endif
  278.  
  279.     // Convert accumulator to a string with specified width & decimal places
  280.     // Use floating point form only if Decimals is positive
  281.     if  Decimals >= 0
  282.         ftoa( Answer, Width, Decimals )
  283.     endif
  284.  
  285.     // If Decimals is negative, or ftoa() could not fit it in field,
  286.     // convert it in "exponential" form
  287.     if  ( Decimals < 0 ) OR ( Answer[ 1 ] == "#" )
  288.         etoa( Answer, Width )
  289.     endif
  290.  
  291.     return ( Answer )
  292. end FStr
  293.  
  294. /* eof: fp.s */