Browse Source

* Allow to compile in webassembly

Michaël Van Canneyt 1 year ago
parent
commit
28de62fc16
1 changed files with 48 additions and 0 deletions
  1. 48 0
      src/base/fresnel.resources.pas

+ 48 - 0
src/base/fresnel.resources.pas

@@ -555,6 +555,54 @@ begin
   Read(DestData.Memory^, BinSize);
   Read(DestData.Memory^, BinSize);
 end;
 end;
 
 
+function ConvertLRSExtendedToDouble(p: Pointer): Double;
+type
+  Ti386ExtendedReversed = packed record
+    {$IFDEF FPC_BIG_ENDIAN}
+    ExponentAndSign: word;
+    Mantissa: qword;
+    {$ELSE}
+    Mantissa: qword;
+    ExponentAndSign: word;
+    {$ENDIF}
+  end;
+var
+  e: Ti386ExtendedReversed;
+  Exponent: word;
+  ExponentAndSign: word;
+  Mantissa: qword;
+begin
+  System.Move(p^,e,10);
+  {$IFDEF FPC_BIG_ENDIAN}
+  ReverseBytes(@e,10);
+  {$ENDIF}
+  // i386 extended
+  Exponent:=(e.ExponentAndSign and $7fff);
+  if (Exponent>$4000+$3ff) or (Exponent<$4000-$400) then begin
+    // exponent out of bounds
+    Result:=0;
+    exit;
+  end;
+  dec(Exponent,$4000-$400);
+  ExponentAndSign:=Exponent or ((e.ExponentAndSign and $8000) shr 4);
+  // i386 extended has leading 1, double has not (shl 1)
+  // i386 has 64 bit, double has 52 bit (shr 12)
+  {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
+    {$IFDEF FPC_BIG_ENDIAN}
+    // accessing Mantissa will couse trouble, copy it first
+    System.Move(e.Mantissa, Mantissa, SizeOf(Mantissa));
+    Mantissa := (Mantissa shl 1) shr 12;
+    {$ELSE FPC_BIG_ENDIAN}
+    Mantissa := (e.Mantissa shl 1) shr 12;
+    {$ENDIF FPC_BIG_ENDIAN}
+  {$ELSE FPC_REQUIRES_PROPER_ALIGNMENT}
+  Mantissa := (e.Mantissa shl 1) shr 12;
+  {$ENDIF FPC_REQUIRES_PROPER_ALIGNMENT}
+  // put together
+  QWord(Result):=Mantissa or (qword(ExponentAndSign) shl 52);
+end;
+
+
 function TLRSObjectReader.ReadFloat: Extended;
 function TLRSObjectReader.ReadFloat: Extended;
 {$ifndef FPC_HAS_TYPE_EXTENDED}
 {$ifndef FPC_HAS_TYPE_EXTENDED}
 var
 var