Index: trunk/Include/Classes/ActiveBasic/CType/CType.ab =================================================================== --- trunk/Include/Classes/ActiveBasic/CType/CType.ab (revision 396) +++ trunk/Include/Classes/ActiveBasic/CType/CType.ab (revision 400) @@ -86,4 +86,10 @@ 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,4 +104,13 @@ 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,4 +225,11 @@ @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,4 +257,4 @@ End Function -End Namespace -End Namespace +End Namespace 'CType +End Namespace 'ActiveBasic Index: trunk/Include/Classes/ActiveBasic/Core/TypeInfo.ab =================================================================== --- trunk/Include/Classes/ActiveBasic/Core/TypeInfo.ab (revision 396) +++ trunk/Include/Classes/ActiveBasic/Core/TypeInfo.ab (revision 400) @@ -160,5 +160,5 @@ Static Sub InitializeValueType() - types = New System.Collections.Generic.Dictionary(8192) + types = New System.Collections.Generic.Dictionary(8191) ' 値型の追加 @@ -222,11 +222,15 @@ 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 Index: trunk/Include/Classes/ActiveBasic/Strings/SPrintF.ab =================================================================== --- trunk/Include/Classes/ActiveBasic/Strings/SPrintF.ab (revision 396) +++ trunk/Include/Classes/ActiveBasic/Strings/SPrintF.ab (revision 400) @@ -1072,5 +1072,5 @@ ReadInt = True Else - Dim p As PSTR + Dim p As *StrChar ret = StrToLong(fmt, p) If fmt <> p Then Index: trunk/Include/Classes/ActiveBasic/misc.ab =================================================================== --- trunk/Include/Classes/ActiveBasic/misc.ab (revision 396) +++ trunk/Include/Classes/ActiveBasic/misc.ab (revision 400) @@ -2,4 +2,32 @@ 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) Index: trunk/Include/Classes/System/DateTime.ab =================================================================== --- trunk/Include/Classes/System/DateTime.ab (revision 396) +++ trunk/Include/Classes/System/DateTime.ab (revision 400) @@ -296,5 +296,5 @@ 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 Index: trunk/Include/Classes/System/IO/DriveInfo.ab =================================================================== --- trunk/Include/Classes/System/IO/DriveInfo.ab (revision 396) +++ trunk/Include/Classes/System/IO/DriveInfo.ab (revision 400) @@ -21,6 +21,5 @@ debug End If - driveName.ToUpper() - m_DriveName = driveName + ":\" + m_DriveName = driveName.ToUpper() + ":\" End Sub @@ -30,9 +29,6 @@ '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,18 +36,17 @@ 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,18 +63,12 @@ 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,9 +76,8 @@ 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 Index: trunk/Include/Classes/System/IO/FileSystemInfo.ab =================================================================== --- trunk/Include/Classes/System/IO/FileSystemInfo.ab (revision 396) +++ trunk/Include/Classes/System/IO/FileSystemInfo.ab (revision 400) @@ -40,5 +40,5 @@ Sub Attributes(value As DWord) - If SetFileAttributes(FullPath, value) = FALSE Then + If SetFileAttributes(ToTCStr(FullPath), value) = FALSE Then 'Exception Debug @@ -123,5 +123,5 @@ 'Public Methods Virtual Sub Delete() - If DeleteFile(FullPath) = FALSE Then + If DeleteFile(ToTCStr(FullPath)) = FALSE Then 'Exception debug Index: trunk/Include/Classes/System/String.ab =================================================================== --- trunk/Include/Classes/System/String.ab (revision 396) +++ trunk/Include/Classes/System/String.ab (revision 400) @@ -311,5 +311,5 @@ 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 Index: trunk/Include/Classes/System/Threading/Thread.ab =================================================================== --- trunk/Include/Classes/System/Threading/Thread.ab (revision 396) +++ trunk/Include/Classes/System/Threading/Thread.ab (revision 400) @@ -1,4 +1,3 @@ -'threading.sbp - +'Thread.ab '-------------------------------------------------------------------- @@ -115,8 +114,4 @@ End Sub - - - - Sub Start() Dim ThreadId As DWord @@ -133,5 +128,5 @@ 'GCにスレッド開始を通知 - _System_pobj_AllThreads->BeginThread(VarPtr(This),_System_GetSp() As *LONG_PTR) + _System_pobj_AllThreads->BeginThread(This, _System_GetSp() As *LONG_PTR) @@ -147,5 +142,5 @@ 'GCにスレッド終了を通知 - _System_pobj_AllThreads->EndThread(VarPtr(This)) + _System_pobj_AllThreads->EndThread(This) '自身のスレッドハンドルを閉じる @@ -201,4 +196,7 @@ End Class +Dim _System_pobj_AllThreads As *Detail._System_CThreadCollection + +Namespace Detail '-------------------------------------------------------------------- @@ -206,8 +204,8 @@ '-------------------------------------------------------------------- ' TODO: このクラスをシングルトンにする + Class _System_CThreadCollection Public - ppobj_Thread As **Thread - pStackBase As **LONG_PTR + collection As *ThreadInfo ThreadNum As Long @@ -215,10 +213,6 @@ 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,73 +221,56 @@ 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,8 +280,10 @@ 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,25 +292,26 @@ 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,36 +319,43 @@ ' 自分以外のスレッドを再開 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,20 +363,28 @@ ' スレッド固有の例外処理制御 '------------------------------------------ - 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 Index: trunk/Include/Classes/System/misc.ab =================================================================== --- trunk/Include/Classes/System/misc.ab (revision 396) +++ trunk/Include/Classes/System/misc.ab (revision 400) @@ -16,5 +16,5 @@ End Interface -Interface IClonable +Interface ICloneable ' Method Function Clone() As Object