Changeset 400 for trunk/Include/Classes

Timestamp:

Jan 22, 2008, 9:19:59 PM (16 years ago)

Author:

イグトランス (egtra)

Message:

_System_CThreadCollectionでのクラスインスタンスへのポインタの使用を除去、参照変数構文へ。

Location:

trunk/Include/Classes

Files:

• ActiveBasic/CType/CType.ab (modified) (4 diffs)
• ActiveBasic/Core/TypeInfo.ab (modified) (2 diffs)
• ActiveBasic/Strings/SPrintF.ab (modified) (1 diff)
• ActiveBasic/misc.ab (modified) (1 diff)
• System/DateTime.ab (modified) (1 diff)
• System/IO/DriveInfo.ab (modified) (5 diffs)
• System/IO/FileSystemInfo.ab (modified) (2 diffs)
• System/String.ab (modified) (1 diff)
• System/Threading/Thread.ab (modified) (12 diffs)
• System/misc.ab (modified) (1 diff)

trunk/Include/Classes/ActiveBasic/CType/CType.ab

@@ -86 +86 @@
 End Function
 
+/*!
+@brief  ASCIIの表示文字かどうか
+@author Egtra
+@date   2007/11/25
+制御文字でないもの、空白も表示文字に含む
+*/
 Function IsPrint(c As WCHAR) As Boolean
     Return (c As DWord - &h20) < (&h7e - &h20)
@@ -98 +104 @@
 Function IsPunct(c As WCHAR) As Boolean
     Return c < &h7f And IsGraph(c) And (Not IsAlnum(c))
+End Function
+
+/*!
+@brief  ASCIIの空白文字かどうか
+@author Egtra
+@date   2008/01/22
+*/
+Function IsSpace(c As WCHAR) As Boolean
+    Return c As DWord - 9 < 4 Or c = &h20 ' &h41 = Asc("A")
 End Function
 
@@ -210 +225 @@
 @overload
 */
+Function IsSpace(c As CHAR) As Boolean
+    Return IsSpace(Detail.Widen(c))
+End Function
+
+/*!
+@overload
+*/
 Function IsUpper(c As CHAR) As Boolean
     Return IsUpper(Detail.Widen(c))
@@ -235 +257 @@
 End Function
 
-End Namespace
-End Namespace
+End Namespace 'CType
+End Namespace 'ActiveBasic

trunk/Include/Classes/ActiveBasic/Core/TypeInfo.ab

@@ -160 +160 @@
 
     Static Sub InitializeValueType()
-        types = New System.Collections.Generic.Dictionary<String, TypeBaseImpl>(8192)
+        types = New System.Collections.Generic.Dictionary<String, TypeBaseImpl>(8191)
 
         ' 値型の追加
@@ -222 +222 @@
         End If
 
-        If Object.ReferenceEquals( types.Item(fullName), Nothing ) Then
-            OutputDebugString( "TypeSearch Failed: " )
-            OutputDebugString( fullName )
-            OutputDebugString( Ex"\r\n" )
+        Search = types.Item(fullName)
+
+        If Object.ReferenceEquals( Search, Nothing ) Then
+            OutputDebugString("TypeSearch Failed: ")
+            If Not ActiveBasic.IsNothing(fullName) Then
+                OutputDebugStringW(StrPtr(fullName) As PWSTR)
+                OutputDebugString(Ex"\r\n")
+                OutputDebugStringA(StrPtr(fullName) As PSTR)
+            End If
+            OutputDebugString(Ex"\r\n")
         End If
-
-        Return types.Item(fullName)
     End Function
 

trunk/Include/Classes/ActiveBasic/Strings/SPrintF.ab

@@ -1072 +1072 @@
         ReadInt = True
     Else
-        Dim p As PSTR
+        Dim p As *StrChar
         ret = StrToLong(fmt, p)
         If fmt <> p Then

trunk/Include/Classes/ActiveBasic/misc.ab

@@ -2 +2 @@
 
 Namespace ActiveBasic
+    Namespace Detail
+        /*!
+        @brief baseがderivedの基底クラスかどうか判定する。
+        @param[in] base 基底クラス
+        @param[in] derived 派生クラス
+        @retval True baseがderivedの基底クラスである
+        @retval False 基底クラスでない
+        @exception ArgumentNullException 引数のどちらか又は双方がNoghing
+        @auther Egtra
+        @date 2008/01/21
+        */
+        Function IsBaseOf(base As System.TypeInfo, derived As System.TypeInfo) As Boolean
+            Imports System
+            If IsNothing(base) Then
+                Throw New ArgumentNullException("base")
+            ElseIf IsNothing(derived) Then
+                Throw New ArgumentNullException("derived")
+            End If
+            Do
+                IsBaseOf = derived.Equals(base)
+                If IsBaseOf Then
+                    Exit Function
+                End If
+                derived = derived.BaseType
+            Loop Until IsNothing(derived)
+        End Function
+    End Namespace
+
     Function IsNothing(o As Object) As Boolean
         Return Object.ReferenceEquals(o, Nothing)

trunk/Include/Classes/System/DateTime.ab

@@ -296 +296 @@
         Dim dateTimeFormats = GC_malloc_atomic(SizeOf (TCHAR) * (strLength)) As PTSTR
         GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats, dateFormatSize)
-        dateTimeFormats[dateFormatSize - 1] = Asc(" ")
+        dateTimeFormats[dateFormatSize - 1] = &H20 As TCHAR 'Asc(" ") As TCHAR
         GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats + dateFormatSize, timeFormatSize)
 'Debug

trunk/Include/Classes/System/IO/DriveInfo.ab

@@ -21 +21 @@
             debug
         End If
-        driveName.ToUpper()
-        m_DriveName = driveName + ":\"
+        m_DriveName = driveName.ToUpper() + ":\"
     End Sub
 
@@ -30 +29 @@
     'property
     Function AvailableFreeSpace() As QWord
-        Dim availableFreeSpace As ULARGE_INTEGER
-        If GetDiskFreeSpaceEx(m_DriveName, availableFreeSpace, ByVal 0, ByVal 0) Then
-            Return (availableFreeSpace.HighPart << 32) Or availableFreeSpace.LowPart
-        Else
-            'IOException
+        If GetDiskFreeSpaceEx(ToTCStr(m_DriveName), ByVal VarPtr(AvailableFreeSpace) As *ULARGE_INTEGER, ByVal 0, ByVal 0) = FALSE Then
+            Throw New IOException("DriveInfo.AvailableFreeSpace: Failed to GetDiskFreeSpaceEx.")
         End If
     End Function
@@ -40 +36 @@
     Function DriveFormat() As String
         Dim systemName[15] As TCHAR
-        If GetVolumeInformation(m_DriveName, NULL, 0, NULL, NULL, NULL, systemName, Len (systemName)) Then
-            Dim resultStr = New String( systemName )
-            Return resultStr
+        If GetVolumeInformation(ToTCStr(m_DriveName), NULL, 0, NULL, NULL, NULL, systemName, Len (systemName) \ SizeOf (TCHAR)) Then
+            DriveFormat = New String( systemName )
         Else
-            'IOException
+            Throw New IOException("DriveInfo.DriveFormat: Failed to GetVolumeInformation.")
         End If
     End Function
 
     Function DriveType() As Long
-        Return GetDriveType(m_DriveName)
+        Return GetDriveType(ToTCStr(m_DriveName))
     End Function
 
     Function IsReady() As Boolean
-        If GetVolumeInformation(m_DriveName, NULL, 0, NULL, NULL, NULL, NULL, 0) Then
+        If GetVolumeInformation(ToTCStr(m_DriveName), NULL, 0, NULL, NULL, NULL, NULL, 0) Then
             Return True
         Else
@@ -68 +63 @@
 
     Function TotalFreeSpace() As QWord
-        Dim totalFreeSpace As ULARGE_INTEGER
-        If GetDiskFreeSpaceEx(m_DriveName, ByVal 0, ByVal 0, totalFreeSpace) Then
-            Return (totalFreeSpace.HighPart << 32) Or totalFreeSpace.LowPart
-        Else
-            'IOException
+        If GetDiskFreeSpaceEx(ToTCStr(m_DriveName), ByVal 0, ByVal 0, ByVal VarPtr(TotalFreeSpace) As *ULARGE_INTEGER) = FALSE Then
+            Throw New IOException("DriveInfo.TotalFreeSpace: Failed to GetDiskFreeSpaceEx.")
         End If
     End Function
 
     Function TotalSize() As QWord
-        Dim totalSize As ULARGE_INTEGER
-        If GetDiskFreeSpaceEx(m_DriveName, ByVal 0, totalSize, ByVal 0) Then
-            Return (totalSize.HighPart << 32) Or totalSize.LowPart
-        Else
-            'IOException
+        If GetDiskFreeSpaceEx(ToTCStr(m_DriveName), ByVal 0, ByVal VarPtr(TotalSize) As *ULARGE_INTEGER, ByVal 0) = FALSE Then
+            Throw New IOException("DriveInfo.TotalSize: Failed to GetDiskFreeSpaceEx.")
         End If
     End Function
@@ -87 +76 @@
     Function VolumeLabel() As String
         Dim volumeName[63] As TCHAR
-        If GetVolumeInformation(m_DriveName, volumeName, 64, NULL, NULL, NULL, NULL, 0) Then
-            Dim resultStr = New String( volumeName )
-            Return resultStr
+        If GetVolumeInformation(ToTCStr(m_DriveName), volumeName, Len (volumeName) \ SizeOf (TCHAR), NULL, NULL, NULL, NULL, 0) Then
+            VolumeLabel = New String( volumeName )
         Else
-            'IOException
+            Throw New IOException("DriveInfo.VolumeLabel: Failed to GetVolumeInformation.")
         End If
     End Function

trunk/Include/Classes/System/IO/FileSystemInfo.ab

@@ -40 +40 @@
 
     Sub Attributes(value As DWord)
-        If SetFileAttributes(FullPath, value) = FALSE Then
+        If SetFileAttributes(ToTCStr(FullPath), value) = FALSE Then
             'Exception
             Debug
@@ -123 +123 @@
     'Public Methods
     Virtual Sub Delete()
-        If DeleteFile(FullPath) = FALSE Then
+        If DeleteFile(ToTCStr(FullPath)) = FALSE Then
             'Exception
             debug

trunk/Include/Classes/System/String.ab

@@ -311 +311 @@
                 Concat = New String
                 .AllocStringBuffer(m_Length + lenW)
-                ActiveBasic.Strings.ChrCopy(.Chars, This.Chars, m_Length)
+                ActiveBasic.Strings.ChrCopy(.Chars, This.Chars, m_Length As SIZE_T)
                 MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, VarPtr(.Chars[m_Length]), lenW)
                 .Chars[m_Length + lenW] = 0

trunk/Include/Classes/System/Threading/Thread.ab

@@ -1 @@
-'threading.sbp
-
+'Thread.ab
 
 '--------------------------------------------------------------------
@@ -115 +114 @@
     End Sub
 
-
-
-
-
     Sub Start()
         Dim ThreadId As DWord
@@ -133 +128 @@
 
         'GCにスレッド開始を通知
-        _System_pobj_AllThreads->BeginThread(VarPtr(This),_System_GetSp() As *LONG_PTR)
+        _System_pobj_AllThreads->BeginThread(This, _System_GetSp() As *LONG_PTR)
 
 
@@ -147 +142 @@
 
         'GCにスレッド終了を通知
-        _System_pobj_AllThreads->EndThread(VarPtr(This))
+        _System_pobj_AllThreads->EndThread(This)
 
         '自身のスレッドハンドルを閉じる
@@ -201 +196 @@
 End Class
 
+Dim _System_pobj_AllThreads As *Detail._System_CThreadCollection
+
+Namespace Detail
 
 '--------------------------------------------------------------------
@@ -206 +204 @@
 '--------------------------------------------------------------------
 ' TODO: このクラスをシングルトンにする
+
 Class _System_CThreadCollection
 Public
-    ppobj_Thread As **Thread
-    pStackBase As **LONG_PTR
+    collection As *ThreadInfo
     ThreadNum As Long
 
@@ -215 +213 @@
 
     Sub _System_CThreadCollection()
-        ppobj_Thread=GC_malloc(1)
-        pStackBase=HeapAlloc(_System_hProcessHeap,0,1)
-        ppException=HeapAlloc(_System_hProcessHeap,0,1)
-        ThreadNum=0
-
-        'クリティカルセッションを生成
+        collection = GC_malloc(1)
+        ThreadNum = 0
         InitializeCriticalSection(CriticalSection)
     End Sub
@@ -227 +221 @@
         Dim i As Long
         For i=0 To ELM(ThreadNum)
-            If ppobj_Thread[i] Then
-                If i = 0 Then
-                    Delete ppobj_Thread[i]
-                End If
-                ppobj_Thread[i]=0
-                pStackBase[i]=0
-                Delete ppException[i]
-                ppException[i]=0
-                Exit For
+            With collection[i]
+                If .thread Then
+                    .thread = Nothing
+                    .stackBase = 0
+                    .exception = Nothing
+                End If
+            End With
+        Next
+        collection = 0
+        DeleteCriticalSection(CriticalSection)
+    End Sub
+
+    'スレッドを生成
+    Sub BeginThread(thread As Thread, NowSp As *LONG_PTR)
+        EnterCriticalSection(CriticalSection)
+        Dim i = FindFreeIndex
+        With collection[i]
+            .thread = thread
+            .stackBase = NowSp
+            .exception = New ExceptionService '例外処理管理用オブジェクトを生成
+        End With
+        LeaveCriticalSection(CriticalSection)
+    End Sub
+Private
+    'クリティカルセション内で呼ぶこと
+    Function FindFreeIndex() As Long
+        Dim i As Long
+        For i = 0 To ELM(ThreadNum)
+            If ActiveBasic.IsNothing(collection[i].thread) Then
+                FindFreeIndex = i
+                Exit Function
             End If
         Next
-
-        HeapFree(_System_hProcessHeap,0,pStackBase)
-        pStackBase=0
-
-        HeapFree(_System_hProcessHeap,0,ppException)
-        ppException = 0
-
-        ThreadNum=0
-
-        'クリティカルセッションを破棄
-        DeleteCriticalSection(CriticalSection)
-    End Sub
-
-    'スレッドを生成
-    Sub BeginThread(pThread As *Thread,NowSp As *LONG_PTR)
-        EnterCriticalSection(CriticalSection)
-
-            '例外処理管理用オブジェクトを生成
-            Dim pException As *ExceptionService
-            pException = New ExceptionService
-
-            Dim i As Long
-            For i=0 To ELM(ThreadNum)
-                If ppobj_Thread[i] = 0 Then
-                    ppobj_Thread[i] = pThread
-                    pStackBase[i] = NowSp
-                    ppException[i] = pException
-                    Exit For
-                End If
-            Next
-
-            If i = ThreadNum Then
-                ppobj_Thread=realloc(ppobj_Thread,(ThreadNum+1)*SizeOf(*Thread))
-                ppobj_Thread[ThreadNum]=pThread
-                pStackBase=HeapReAlloc(_System_hProcessHeap,0,pStackBase,(ThreadNum+1)*SizeOf(LONG_PTR))
-                pStackBase[ThreadNum]=NowSp
-                ppException=HeapReAlloc(_System_hProcessHeap,0,ppException,(ThreadNum+1)*SizeOf(*ExceptionService))
-                ppException[ThreadNum]=pException
-                ThreadNum++
-            End If
-        LeaveCriticalSection(CriticalSection)
-    End Sub
+        ThreadNum++
+        collection = realloc(collection, ThreadNum * SizeOf(ThreadInfo))
+        FindFreeIndex = i
+    End Function
+Public
 
     'スレッドを終了
-    Sub EndThread(pThread As *Thread)
+    Sub EndThread(thread As Thread)
         EnterCriticalSection(CriticalSection)
             Dim i As Long
-            For i=0 To ELM(ThreadNum)
-                If ppobj_Thread[i] = pThread Then
-                    If i = 0 Then
-                        Delete pThread
+            For i = 0 To ELM(ThreadNum)
+                With collection[i]
+                    If thread.Equals(.thread) Then
+                        .thread = Nothing
+                        .stackBase = 0
+                        .exception = Nothing
+                        Exit For
                     End If
-                    ppobj_Thread[i]=0
-                    pStackBase[i]=0
-                    Delete ppException[i]
-                    ppException[i]=0
-                    Exit For
-                End If
+                End With
             Next
         LeaveCriticalSection(CriticalSection)
@@ -303 +280 @@
     Sub SuspendAllThread()
         Dim i As Long
-        For i=0 To ELM(ThreadNum)
-            If ppobj_Thread[i] Then
-                ppobj_Thread[i]->Suspend()
-            End If
+        For i = 0 To ELM(ThreadNum)
+            With collection[i]
+                If Not ActiveBasic.IsNothing(.thread) Then
+                    .thread.Suspend()
+                End If
+            End With
         Next
     End Sub
@@ -313 +292 @@
     Sub ResumeAllThread()
         Dim i As Long
-        For i=0 To ELM(ThreadNum)
-            If ppobj_Thread[i] Then
-                ppobj_Thread[i]->Resume()
-            End If
-        Next
-    End Sub
-
+        For i = 0 To ELM(ThreadNum)
+            With collection[i]
+                If Not ActiveBasic.IsNothing(.thread) Then
+                    .thread.Resume()
+                End If
+            End With
+        Next
+    End Sub
+/*
     ' 自分以外のスレッドを中断
     Sub SuspendAnotherThread()
-        Dim currentThread = Thread.CurrentThread()
+        Dim currentThread = CurrentThread()
 
         Dim i As Long
         For i=0 To ELM(ThreadNum)
-
-            If currentThread.Equals( ppobj_Thread[i] As Object ) Then
-                Continue
-            End If
-
-            If ppobj_Thread[i] Then
-                ppobj_Thread[i]->Suspend()
-            End If
+            With collection[i]
+                If currentThread.Equals(.thread) Then
+                    Continue
+                ElseIf Not ActiveBasic.IsNothing(.thread) Then
+                    .thread.Suspend()
+                End If
+            End With
         Next
     End Sub
@@ -339 +319 @@
     ' 自分以外のスレッドを再開
     Sub ResumeAnotherThread()
-        Dim currentThread = Thread.CurrentThread()
+        Dim currentThread = CurrentThread()
 
         Dim i As Long
         For i=0 To ELM(ThreadNum)
-
-            If currentThread.Equals( ppobj_Thread[i] As Object ) Then
-                Continue
-            End If
-
-            If ppobj_Thread[i] Then
-                ppobj_Thread[i]->Resume()
-            End If
-        Next
-    End Sub
-
+            With collection[i]
+                If currentThread.Equals(.thread) Then
+                    Continue
+                ElseIf Not ActiveBasic.IsNothing(.thread) Then
+                    .thread.Resume()
+                End If
+            End With
+        Next
+    End Sub
+*/
     'カレントスレッドを取得
     Function CurrentThread() As Thread
-        Dim dwNowThreadId As DWord
-        dwNowThreadId=GetCurrentThreadId()
-
-        Dim i As Long
-        For i=0 To ELM(ThreadNum)
-            If ppobj_Thread[i]->ThreadId=dwNowThreadId Then
-                Return ByVal ppobj_Thread[i]
+        Dim p = CurrentThreadInfo()
+        If p = 0 Then
+            ' TODO: エラー処理
+            OutputDebugString( Ex"カレントスレッドの取得に失敗\r\n" )
+            debug
+            Exit Function
+        End If
+        CurrentThread = p->thread
+    End Function
+
+    Function CurrentThreadInfo() As *ThreadInfo
+        CurrentThreadInfo = FindThreadInfo(GetCurrentThreadId())
+    End Function
+
+    Function FindThreadInfo(threadID As DWord) As *ThreadInfo
+        Dim i As Long
+        For i = 0 To ELM(ThreadNum)
+            If collection[i].thread.ThreadId = threadID Then
+                FindThreadInfo = VarPtr(collection[i])
+                Exit Function
             End If
         Next
-
-        ' TODO: エラー処理
-        OutputDebugString( "カレントスレッドの取得に失敗" )
-        debug
-    End Function
-
+    End Function
 
 Private
@@ -376 +363 @@
     ' スレッド固有の例外処理制御
     '------------------------------------------
-    ppException As **ExceptionService
-
-Public
-    Function GetCurrentException() As *ExceptionService
-        Dim dwNowThreadId As DWord
-        dwNowThreadId=GetCurrentThreadId()
+
+Public
+    Function GetCurrentException() As ExceptionService
+        Dim dwNowThreadId = GetCurrentThreadId()
 
         Dim i As Long
         For i=0 To ELM(ThreadNum)
-            If ppobj_Thread[i]->ThreadId=dwNowThreadId Then
-                Return ppException[i]
-            End If
-        Next
-
-        Return NULL
+            With collection[i]
+                If .thread.ThreadId = dwNowThreadId Then
+                    Return .exception
+                End If
+            End With
+        Next
+
+        OutputDebugString( Ex"カレントスレッドの取得に失敗\r\n" )
+        Return Nothing
     End Function
 End Class
-Dim _System_pobj_AllThreads As *_System_CThreadCollection
+
+Type ThreadInfo
+    thread As Thread
+    stackBase As *LONG_PTR
+    exception As ExceptionService
+End Type
+
+End Namespace 'Detail

trunk/Include/Classes/System/misc.ab

@@ -16 +16 @@
 End Interface
 
-Interface IClonable
+Interface ICloneable
     ' Method
     Function Clone() As Object