Article View: net.micro.atari16
Article #1319OSS demo (5 of 5 strval.pas)
From: fouts
Date: Sun, 27 Jul 1986 05:58
Date: Sun, 27 Jul 1986 05:58
311 lines
7549 bytes
7549 bytes
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;
Technical Details
Message-ID:
<8607270558.AA14204@ames-nas.ARPA>Path:
arc1-ca.pugleaf.net!utzoo!mnetor!seismo!caip!nike!ucbcad!ucbvax!AMES-NAS.ARPA!foutsShow Full Headers
Complete Article Headers
Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: arc1-ca.pugleaf.net!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