Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!caip!nike!ucbcad!ucbvax!AMES-NAS.ARPA!fouts
From: fouts@AMES-NAS.ARPA
Newsgroups: net.micro.atari16
Subject: OSS demo (5 of 5 strval.pas)
Message-ID: <8607270558.AA14204@ames-nas.ARPA>
Date: Sun, 27-Jul-86 01:58:01 EDT
Article-I.D.: ames-nas.8607270558.AA14204
Posted: Sun Jul 27 01:58:01 1986
Date-Received: Sun, 27-Jul-86 06:17:39 EDT
Sender: daemon@ucbvax.BERKELEY.EDU
Organization: The ARPA Internet
Lines: 311


This is the last part of my OSS Pascal demo.  It is the file
strval.pas.  I did not write it, but got it from the OSS PASCAL
buletin board.

     Place strval.pas, peekpoke.pas, and pager.pas in the same folder and
compile pager.pas, using the GEM option on the compiler.

----- CUT HERE -----

{***
 *   Floating Point Conversion routines.
 *   From Real to String and String to Real
 *
 *   By Kevin L. McGrath
 ***}

PROCEDURE Str(Value: Real; VAR St: String);

{* Notes:
 *   This routine is only accurate up to 9 digits becuase of the LongTrunc.
 *   It HAD rounding errors, but they are now fixed (with the LongTrunc)
 *
 * O.S.S. Pascals Floating Point Format:
 *   This is just a guess, but here goes...
 *   One byte of exponent biased by 128 to give a +38 to -38 range.
 *   Fourty bits of mantissa to give 11 digits of accuracy, One bit sign.
 *   Most floating points are normalized to the left, with the point between
 *   the most significant bit of the mantissa and the second most, so I think
 *   this is two.  To find out, just plug out a routine that has a pointer
 *   to a real, coerce's it into a pointer to a record structure of byte like
 *   this:
 *     Record
 *       Exponent:      Byte;
 *       MantissaOne:   Long;
 *       MantissaTwo:   Long;
 *       MantissaThree: Long;
 *     End;
 *   then you can extract the exponent and mantissa just by doing a
 *   "Ptr.Exponent" or somethin like that.  Well, I haven't had time to get
 *   that fancy with this, but I have used this routine and am sure it works.
 *   Hope you guys at O.S.S. can vert it to some kind of normal ASM function!
 *      Good Luck...   (Nice Compiler)
 *      Call me if there are any probs, dig?
 *}


Const
  Max_Digits    = 09;
  Max_Exponent  = 38;

Var
  Val:          Real;
  TempInt,
  Sig_Digits,
  Dec_Exp,
  I:            Integer;
  Digits:       String;

Begin
  Val := Abs(Value);
  Dec_Exp := 0;

  {* Get the exponent without Natural Log (Ln doesn't seem to work fer me) *}

  If (Val < 1) And (Val > 0) Then
  Begin
    For I := 0 To (Max_Exponent-1) Do
      If (Val < (1/PwrOfTen(I))) And (Val >= (1/PwrOfTen(I+1))) Then
        Dec_Exp := -(I+1);
    Val := Val * PwrOfTen(Abs(Dec_Exp)-1);
  End
  Else
  Begin
    For I := 0 To (Max_Exponent-1) Do
      If (Val >= PwrOfTen(I)) And (Val < PwrOfTen(I+1)) Then
        Dec_Exp := I;
    Val := Val / PwrOfTen(Dec_Exp+1);
  End;

{ Get decimal digits by stripping }

  Digits := '';
  St := '';

  For I := Max_Digits DownTo 1 Do
  Begin
    { Take care of rounding problems }

    Val := Long_Trunc(Val*PwrOfTen(I)+0.5)/PwrOfTen(I);

    Val := Val*10.0;
    Digits := ConCat(Digits,Chr(48+Trunc(Val)));
    Val := Val-Trunc(Val);

    { Take care of rounding problems }

    Val := Long_Trunc(Val*PwrOfTen(I)+0.5)/PwrOfTen(I);

  End;

{ Format and put result in St }
{ Put sign }

  If Value < 0 Then St := '-';

{ Compute significant digits }

  Sig_Digits := Max_Digits;
  I := Max_Digits - 1;
  While ((Digits[I]='0') And (I>0)) Do
  Begin
    Sig_Digits := Sig_Digits - 1;
    I := I - 1;
  End;
  Sig_Digits := Sig_Digits - 1;

{ Put in exponential or non-exonential }

  If ((Sig_Digits-Max_Digits)<=Dec_Exp) And (Dec_Exp<=Max_Digits) Then
  Begin
    { Non-exponental form }
    { Put decimal point and leading zeros for numbers with negative exponents }

    If Dec_Exp < 0 Then
    Begin
      St := ConCat(St,'.');
      For I := 1 To -Dec_Exp-1 Do
        St := ConCat(St,'0');
    End;

    { Put significant digits }

    St := ConCat(St,Digits[1]);
    For I := 1 To Sig_Digits-1 Do
    Begin
      If Dec_Exp = 0 Then
        St := ConCat(St,'.');
      St := ConCat(St,Digits[I+1]);
      Dec_Exp := Dec_Exp - 1;
    End;

    { Put trailing zeros }

    While Dec_Exp > 0 Do
    Begin
      St := ConCat(St,'0');
      Dec_Exp := Dec_Exp - 1;
    End;
  End
  Else
  Begin
    { Exponental form }
    { Put first digit }

    St := ConCat(St,Digits[1]);

    { Put decimal point }

    If Sig_Digits > 1 Then
      St := ConCat(St,'.');

    { Put remaining significant digits }

    For I := 1 To (Sig_Digits - 1) Do
      St := ConCat(St,Digits[I+1]);

    { Put the 'E' for the exponent }

    St := ConCat(St,'E');

    { Put exponents sign }

    If Dec_Exp >= 0 Then
      St := ConCat(St,'+')
    Else
    Begin
      St := ConCat(St,'-');
      Dec_Exp := Abs(Dec_Exp);
    End;

    { Put the exponent }

    If Dec_Exp >= 10 Then
    Begin
      St := ConCat(St,Chr(48+(Dec_Exp Div 10)));
      St := ConCat(St,Chr(48+Dec_Exp-((Dec_Exp Div 10) * 10)));
    End
    Else
    Begin
      St := ConCat(St,'0');
      St := ConCat(St,Chr(48+Dec_Exp));
    End;
  End;
End;


FUNCTION Val( St: String): Real;

Const
  Max_Digits    = 09;

Var
  Dec_Exp,
  Exp_Value,
  Count,
  Position:     Integer;
  Chr:          Char;
  Result:       Real;
  Dec_Sign,
  Exp_Sign:     Boolean;

  PROCEDURE Add_Digit;

  Begin
    Result := (Result * 10) + (Ord(Chr) & $0F);
  End;

  PROCEDURE Read_Chr;

  Begin
    Position := Position + 1;
    If Position > Length(St) Then
      Chr := 'X'
    Else
      Chr := St[Position];
  End;

Begin
  Position := 0;
  Read_Chr;
  Result := 0.0;

{ Get sign }

  Dec_Sign := False;
  If Chr = '+' Then Read_Chr;
  If Chr = '-' Then
  Begin
    Read_Chr;
    Dec_Sign := True;
  End;

{ Get digits to left of decimal point }

  Dec_Exp := 0;
  Count := Max_Digits;
  While ('0' <= Chr) And (Chr <= '9') Do
  Begin
    If Count > 0 Then
    Begin
      Add_Digit;
      Count := Count - 1;
    End
    Else
      Dec_Exp := Dec_Exp + 1;
    Read_Chr;
  End;

{ Get digits to the right of decimal point }

  If Chr = '.' Then
  Begin
    Read_Chr;
    While ('0' <= Chr) And (Chr <= '9') Do
    Begin
      If Count > 0 Then
      Begin
        Add_Digit;
        Dec_Exp := Dec_Exp - 1;
        Count := Count - 1;
      End;
      Read_Chr;
    End;
  End;

{ Get exponent part }

  If (Chr = 'E') Or (Chr = 'e') Then
  Begin
    Read_Chr;
    Exp_Sign := False;
    If Chr = '+' Then Read_Chr;
    If Chr = '-' Then
    Begin
      Read_Chr;
      Exp_Sign := True;
    End;
    Exp_Value := 0;
    If ('0'<=Chr) And (Chr<='9') Then Exp_Value := (Ord(Chr) & $0F)*10;
    Read_Chr;
    If ('0'<=Chr) And (Chr<='9') Then Exp_Value := Exp_Value+(Ord(Chr) & $0F);
    If (Chr = 'X') And (Exp_Value >= 10) Then Exp_Value := Exp_Value Div 10;
    If Exp_Sign Then
      Dec_Exp := Dec_Exp - Exp_Value
    Else
      Dec_Exp := Dec_Exp + Exp_Value;
  End;

{ Multiply or divide Result by power of 10 specified by Dec_Exp }

  If Dec_Exp > 0 Then
    Result := Result * PwrOfTen(Dec_Exp)
  Else
    Result := Result / PwrOfTen(Abs(Dec_Exp));

  If Dec_Sign Then Result := -Result;

  Val := Result;

End;