Index: Include/Classes/ActiveBasic/Math/Math.ab =================================================================== --- Include/Classes/ActiveBasic/Math/Math.ab (revision 269) +++ Include/Classes/ActiveBasic/Math/Math.ab (revision 269) @@ -0,0 +1,136 @@ +'Classes/ActiveBasic/Math/Math.ab + +Namespace ActiveBasic +Namespace Math + +'xの符号だけをyのものにした値を返す。 +'引数 x 元となる絶対値 +'引数 y 元となる符号 +Function CopySign(x As Double, y As Double) As Double + SetQWord(VarPtr(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (GetQWord(VarPtr(y)) And &h8000000000000000)) +End Function + +Function CopySign(x As Single, y As Single) As Single + SetDWord(VarPtr(CopySign), (GetDWord(VarPtr(x)) And &h7fffffff) Or (GetDWord(VarPtr(y)) And &h80000000)) +End Function + +Function Log1p(x As Double) As Double + If x < -1 Or IsNaN(x) Then + Log1p = ActiveBasic.Math.Detail.GetNaN() + ElseIf x = 0 Then + x = 0 + ElseIf IsInf(x) Then + Log1p = x + Else + Log1p = ActiveBasic.Math.Detail.Log1p(x) + End If +End Function + +Function IsNaN(ByVal x As Double) As Boolean + Dim p As *DWord + p = VarPtr(x) As *DWord + IsNaN = False + If (p[1] And &H7FF00000) = &H7FF00000 Then + If (p[0] <> 0) Or ((p[1] And &HFFFFF) <> 0) Then + IsNaN = True + End If + End If +End Function + +Function IsInf(x As Double) As Boolean + Dim p As *DWord, nan As Double + p = VarPtr(x) As *DWord + p[1] And= &h7fffffff + nan = ActiveBasic.Math.Detail.GetInf(False) + IsInf = (memcmp(p As *Byte, VarPtr(nan), SizeOf (Double)) = 0) +End Function + +Function IsFinite(x As Double) As Boolean + Dim p As *DWord, nan As Double + p = VarPtr(x) As *DWord +' p[1] And= &h7ffe0000 + p[1] And= &H7FF00000 + p[0] = 0 + nan = ActiveBasic.Math.Detail.GetInf(/*x,*/ False) + IsFinite = (memcmp(p As BytePtr, VarPtr(nan), SizeOf (Double)) = 0) +End Function + +Namespace Detail + +Function SetSign(x As Double, isNegative As Long) As Double +#ifdef _WIN64 + SetQWord(AddressOf(CopySign), (GetQWord(VarPtr(x)) And &h7fffffffffffffff) Or (isNegative << 63)) +#else + SetDWord(AddressOf(CopySign), GetDWord(VarPtr(x))) + SetDWord(AddressOf(CopySign) + SizeOf (DWord), GetQWord(VarPtr(x) + SizeOf (DWord)) And &h7fffffff Or (isNegative << 31)) +#endif +End Function + +#ifdef _WIN64 + +Function GetNaN() As Double + SetQWord(VarPtr(_System_GetNaN) As *QWord, &H7FF8000000000000) +End Function + +Function GetInf(sign As Boolean) As Double + Dim s = 0 As QWord + If sign Then s = 1 << 63 + SetQWord(VarPtr(_System_GetInf) As *QWord, &h7FF0000000000000 Or s) +End Function + +#else + +Function GetNaN() As Double + Dim p As *DWord + p = VarPtr(GetNaN) As *DWord + p[0] = 0 + p[1] = &H7FF80000 +End Function + +Function GetInf(sign As Boolean) As Double + Dim s = 0 As DWord + If sign Then s = (1 As DWord) << 31 + Dim p As *DWord + p = VarPtr(GetInf) As *DWord + p[0] = 0 + p[1] = &h7FF00000 Or s +End Function + +#endif + +Function Log1p(x As Double) As Double + Dim s = 0 As Double + Dim i = 7 As Long + While i >= 1 + Dim t = (i * x) As Double + s = t / (2 + t / (2 * i + 1 + s)) + i-- + Wend + Return x / (1 + s) +End Function + +Function _Support_tan(x As Double, ByRef k As Long) As Double + Dim i As Long + Dim t As Double, x2 As Double + + If x>=0 Then + k=Fix(x/(_System_PI/2)+0.5) + Else + k=Fix(x/(_System_PI/2)-0.5) + End If + + x=(x-(CDbl(3217)/CDbl(2048))*k)+4.4544551033807686783083602485579e-6*k + + x2=x*x + t=0 + + For i=19 To 3 Step -2 + t=x2/(i-t) + Next + + _Support_tan=x/(1-t) +End Function + +End Namespace 'Detail +End Namespace 'Math +End Namespace 'ActiveBasic Index: Include/Classes/ActiveBasic/Windows/CriticalSection.ab =================================================================== --- Include/Classes/ActiveBasic/Windows/CriticalSection.ab (revision 261) +++ Include/Classes/ActiveBasic/Windows/CriticalSection.ab (revision 269) @@ -6,6 +6,10 @@ Namespace Windows +Namespace Detail + Const InterlockedExchangeAnyPointer(p, x) = InterlockedExchangePointer(VarPtr(p) As VoidPtr, x) +End Namespace + Class CriticalSection - Inherits System.IDisposable +' Inherits System.IDisposable Public Sub CriticalSection() @@ -18,5 +22,5 @@ End Sub - Override Sub Dispose() + /*Override*/ Sub Dispose() If InterlockedIncrement(disposed) = 0 Then DeleteCriticalSection(cs) @@ -24,5 +28,5 @@ End Sub - Function Enter() As CriticalSectionLock + Function Enter() As ActiveBasic.Windows.CriticalSectionLock Return New CriticalSectionLock(cs) End Function @@ -33,5 +37,5 @@ Class CriticalSectionLock - Inherits System.IDisposable +' Inherits System.IDisposable Public Sub CriticalSectionLock(ByRef cs As CRITICAL_SECTION) @@ -48,6 +52,6 @@ End Sub - Override Sub Dispose() - Dim p = InterlockedExchangePointer(ByVal VarPtr(pcs), 0) + /*Override*/ Sub Dispose() + Dim p = InterlockedExchangeAnyPointer(pcs, 0) If p <> 0 Then LeaveCriticalSection(ByVal p) Index: Include/Classes/ActiveBasic/Windows/Windows.ab =================================================================== --- Include/Classes/ActiveBasic/Windows/Windows.ab (revision 269) +++ Include/Classes/ActiveBasic/Windows/Windows.ab (revision 269) @@ -0,0 +1,31 @@ +'Classes/ActiveBasic/Windows/Windows.ab + +Namespace ActiveBasic +Namespace Windows + +Function GetPathFromIDList(pidl As LPITEMIDLIST) As String + Dim buf[ELM(MAX_PATH)] As TCHAR + If SHGetPathFromIDList(pidl, buf) Then + Return New String(buf) + Else + Return "" + End If +End Function + +Function GetFolderPath(hwnd As HWND, folder As Long) As String + Dim pidl As LPITEMIDLIST + Dim hr = SHGetSpecialFolderLocation(hwnd, folder, pidl) + If SUCCEEDED(hr) Then + GetFolderPath = GetPathFromIDList(pidl) + CoTaskMemFree(pidl) + Else + GetFolderPath = "" + End If +End Function + +Function GetFolderPath(folder As Long) As String + Return GetFolderPath(0, folder) +End Function + +End Namespace 'Widnows +End Namespace 'ActiveBasic Index: Include/Classes/ActiveBasic/Windows/index.ab =================================================================== --- Include/Classes/ActiveBasic/Windows/index.ab (revision 261) +++ Include/Classes/ActiveBasic/Windows/index.ab (revision 269) @@ -1,3 +1,4 @@ 'Classes/ActiveBasic/Windows/index.ab +#require #require