Changeset 400
- Timestamp:
- Jan 22, 2008, 9:19:59 PM (17 years ago)
- Location:
- trunk/Include
- Files:
-
- 14 edited
-
Classes/ActiveBasic/CType/CType.ab (modified) (4 diffs)
-
Classes/ActiveBasic/Core/TypeInfo.ab (modified) (2 diffs)
-
Classes/ActiveBasic/Strings/SPrintF.ab (modified) (1 diff)
-
Classes/ActiveBasic/misc.ab (modified) (1 diff)
-
Classes/System/DateTime.ab (modified) (1 diff)
-
Classes/System/IO/DriveInfo.ab (modified) (5 diffs)
-
Classes/System/IO/FileSystemInfo.ab (modified) (2 diffs)
-
Classes/System/String.ab (modified) (1 diff)
-
Classes/System/Threading/Thread.ab (modified) (12 diffs)
-
Classes/System/misc.ab (modified) (1 diff)
-
basic.sbp (modified) (2 diffs)
-
basic/function.sbp (modified) (7 diffs)
-
crt.sbp (modified) (2 diffs)
-
system/gc.sbp (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/Include/Classes/ActiveBasic/CType/CType.ab
r388 r400 86 86 End Function 87 87 88 /*! 89 @brief ASCIIの表示文字かどうか 90 @author Egtra 91 @date 2007/11/25 92 制御文字でないもの、空白も表示文字に含む 93 */ 88 94 Function IsPrint(c As WCHAR) As Boolean 89 95 Return (c As DWord - &h20) < (&h7e - &h20) … … 98 104 Function IsPunct(c As WCHAR) As Boolean 99 105 Return c < &h7f And IsGraph(c) And (Not IsAlnum(c)) 106 End Function 107 108 /*! 109 @brief ASCIIの空白文字かどうか 110 @author Egtra 111 @date 2008/01/22 112 */ 113 Function IsSpace(c As WCHAR) As Boolean 114 Return c As DWord - 9 < 4 Or c = &h20 ' &h41 = Asc("A") 100 115 End Function 101 116 … … 210 225 @overload 211 226 */ 227 Function IsSpace(c As CHAR) As Boolean 228 Return IsSpace(Detail.Widen(c)) 229 End Function 230 231 /*! 232 @overload 233 */ 212 234 Function IsUpper(c As CHAR) As Boolean 213 235 Return IsUpper(Detail.Widen(c)) … … 235 257 End Function 236 258 237 End Namespace 238 End Namespace 259 End Namespace 'CType 260 End Namespace 'ActiveBasic -
trunk/Include/Classes/ActiveBasic/Core/TypeInfo.ab
r367 r400 160 160 161 161 Static Sub InitializeValueType() 162 types = New System.Collections.Generic.Dictionary<String, TypeBaseImpl>(819 2)162 types = New System.Collections.Generic.Dictionary<String, TypeBaseImpl>(8191) 163 163 164 164 ' 値型の追加 … … 222 222 End If 223 223 224 If Object.ReferenceEquals( types.Item(fullName), Nothing ) Then 225 OutputDebugString( "TypeSearch Failed: " ) 226 OutputDebugString( fullName ) 227 OutputDebugString( Ex"\r\n" ) 224 Search = types.Item(fullName) 225 226 If Object.ReferenceEquals( Search, Nothing ) Then 227 OutputDebugString("TypeSearch Failed: ") 228 If Not ActiveBasic.IsNothing(fullName) Then 229 OutputDebugStringW(StrPtr(fullName) As PWSTR) 230 OutputDebugString(Ex"\r\n") 231 OutputDebugStringA(StrPtr(fullName) As PSTR) 232 End If 233 OutputDebugString(Ex"\r\n") 228 234 End If 229 230 Return types.Item(fullName)231 235 End Function 232 236 -
trunk/Include/Classes/ActiveBasic/Strings/SPrintF.ab
r391 r400 1072 1072 ReadInt = True 1073 1073 Else 1074 Dim p As PSTR1074 Dim p As *StrChar 1075 1075 ret = StrToLong(fmt, p) 1076 1076 If fmt <> p Then -
trunk/Include/Classes/ActiveBasic/misc.ab
r385 r400 2 2 3 3 Namespace ActiveBasic 4 Namespace Detail 5 /*! 6 @brief baseがderivedの基底クラスかどうか判定する。 7 @param[in] base 基底クラス 8 @param[in] derived 派生クラス 9 @retval True baseがderivedの基底クラスである 10 @retval False 基底クラスでない 11 @exception ArgumentNullException 引数のどちらか又は双方がNoghing 12 @auther Egtra 13 @date 2008/01/21 14 */ 15 Function IsBaseOf(base As System.TypeInfo, derived As System.TypeInfo) As Boolean 16 Imports System 17 If IsNothing(base) Then 18 Throw New ArgumentNullException("base") 19 ElseIf IsNothing(derived) Then 20 Throw New ArgumentNullException("derived") 21 End If 22 Do 23 IsBaseOf = derived.Equals(base) 24 If IsBaseOf Then 25 Exit Function 26 End If 27 derived = derived.BaseType 28 Loop Until IsNothing(derived) 29 End Function 30 End Namespace 31 4 32 Function IsNothing(o As Object) As Boolean 5 33 Return Object.ReferenceEquals(o, Nothing) -
trunk/Include/Classes/System/DateTime.ab
r370 r400 296 296 Dim dateTimeFormats = GC_malloc_atomic(SizeOf (TCHAR) * (strLength)) As PTSTR 297 297 GetDateFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats, dateFormatSize) 298 dateTimeFormats[dateFormatSize - 1] = Asc(" ")298 dateTimeFormats[dateFormatSize - 1] = &H20 As TCHAR 'Asc(" ") As TCHAR 299 299 GetTimeFormat(LOCALE_USER_DEFAULT, 0, time, NULL, dateTimeFormats + dateFormatSize, timeFormatSize) 300 300 'Debug -
trunk/Include/Classes/System/IO/DriveInfo.ab
r288 r400 21 21 debug 22 22 End If 23 driveName.ToUpper() 24 m_DriveName = driveName + ":\" 23 m_DriveName = driveName.ToUpper() + ":\" 25 24 End Sub 26 25 … … 30 29 'property 31 30 Function AvailableFreeSpace() As QWord 32 Dim availableFreeSpace As ULARGE_INTEGER 33 If GetDiskFreeSpaceEx(m_DriveName, availableFreeSpace, ByVal 0, ByVal 0) Then 34 Return (availableFreeSpace.HighPart << 32) Or availableFreeSpace.LowPart 35 Else 36 'IOException 31 If GetDiskFreeSpaceEx(ToTCStr(m_DriveName), ByVal VarPtr(AvailableFreeSpace) As *ULARGE_INTEGER, ByVal 0, ByVal 0) = FALSE Then 32 Throw New IOException("DriveInfo.AvailableFreeSpace: Failed to GetDiskFreeSpaceEx.") 37 33 End If 38 34 End Function … … 40 36 Function DriveFormat() As String 41 37 Dim systemName[15] As TCHAR 42 If GetVolumeInformation(m_DriveName, NULL, 0, NULL, NULL, NULL, systemName, Len (systemName)) Then 43 Dim resultStr = New String( systemName ) 44 Return resultStr 38 If GetVolumeInformation(ToTCStr(m_DriveName), NULL, 0, NULL, NULL, NULL, systemName, Len (systemName) \ SizeOf (TCHAR)) Then 39 DriveFormat = New String( systemName ) 45 40 Else 46 'IOException41 Throw New IOException("DriveInfo.DriveFormat: Failed to GetVolumeInformation.") 47 42 End If 48 43 End Function 49 44 50 45 Function DriveType() As Long 51 Return GetDriveType( m_DriveName)46 Return GetDriveType(ToTCStr(m_DriveName)) 52 47 End Function 53 48 54 49 Function IsReady() As Boolean 55 If GetVolumeInformation( m_DriveName, NULL, 0, NULL, NULL, NULL, NULL, 0) Then50 If GetVolumeInformation(ToTCStr(m_DriveName), NULL, 0, NULL, NULL, NULL, NULL, 0) Then 56 51 Return True 57 52 Else … … 68 63 69 64 Function TotalFreeSpace() As QWord 70 Dim totalFreeSpace As ULARGE_INTEGER 71 If GetDiskFreeSpaceEx(m_DriveName, ByVal 0, ByVal 0, totalFreeSpace) Then 72 Return (totalFreeSpace.HighPart << 32) Or totalFreeSpace.LowPart 73 Else 74 'IOException 65 If GetDiskFreeSpaceEx(ToTCStr(m_DriveName), ByVal 0, ByVal 0, ByVal VarPtr(TotalFreeSpace) As *ULARGE_INTEGER) = FALSE Then 66 Throw New IOException("DriveInfo.TotalFreeSpace: Failed to GetDiskFreeSpaceEx.") 75 67 End If 76 68 End Function 77 69 78 70 Function TotalSize() As QWord 79 Dim totalSize As ULARGE_INTEGER 80 If GetDiskFreeSpaceEx(m_DriveName, ByVal 0, totalSize, ByVal 0) Then 81 Return (totalSize.HighPart << 32) Or totalSize.LowPart 82 Else 83 'IOException 71 If GetDiskFreeSpaceEx(ToTCStr(m_DriveName), ByVal 0, ByVal VarPtr(TotalSize) As *ULARGE_INTEGER, ByVal 0) = FALSE Then 72 Throw New IOException("DriveInfo.TotalSize: Failed to GetDiskFreeSpaceEx.") 84 73 End If 85 74 End Function … … 87 76 Function VolumeLabel() As String 88 77 Dim volumeName[63] As TCHAR 89 If GetVolumeInformation(m_DriveName, volumeName, 64, NULL, NULL, NULL, NULL, 0) Then 90 Dim resultStr = New String( volumeName ) 91 Return resultStr 78 If GetVolumeInformation(ToTCStr(m_DriveName), volumeName, Len (volumeName) \ SizeOf (TCHAR), NULL, NULL, NULL, NULL, 0) Then 79 VolumeLabel = New String( volumeName ) 92 80 Else 93 'IOException81 Throw New IOException("DriveInfo.VolumeLabel: Failed to GetVolumeInformation.") 94 82 End If 95 83 End Function -
trunk/Include/Classes/System/IO/FileSystemInfo.ab
r346 r400 40 40 41 41 Sub Attributes(value As DWord) 42 If SetFileAttributes( FullPath, value) = FALSE Then42 If SetFileAttributes(ToTCStr(FullPath), value) = FALSE Then 43 43 'Exception 44 44 Debug … … 123 123 'Public Methods 124 124 Virtual Sub Delete() 125 If DeleteFile( FullPath) = FALSE Then125 If DeleteFile(ToTCStr(FullPath)) = FALSE Then 126 126 'Exception 127 127 debug -
trunk/Include/Classes/System/String.ab
r391 r400 311 311 Concat = New String 312 312 .AllocStringBuffer(m_Length + lenW) 313 ActiveBasic.Strings.ChrCopy(.Chars, This.Chars, m_Length )313 ActiveBasic.Strings.ChrCopy(.Chars, This.Chars, m_Length As SIZE_T) 314 314 MultiByteToWideChar(CP_THREAD_ACP, 0, text, len, VarPtr(.Chars[m_Length]), lenW) 315 315 .Chars[m_Length + lenW] = 0 -
trunk/Include/Classes/System/Threading/Thread.ab
r374 r400 1 'threading.sbp 2 1 'Thread.ab 3 2 4 3 '-------------------------------------------------------------------- … … 115 114 End Sub 116 115 117 118 119 120 121 116 Sub Start() 122 117 Dim ThreadId As DWord … … 133 128 134 129 'GCにスレッド開始を通知 135 _System_pobj_AllThreads->BeginThread( VarPtr(This),_System_GetSp() As *LONG_PTR)130 _System_pobj_AllThreads->BeginThread(This, _System_GetSp() As *LONG_PTR) 136 131 137 132 … … 147 142 148 143 'GCにスレッド終了を通知 149 _System_pobj_AllThreads->EndThread( VarPtr(This))144 _System_pobj_AllThreads->EndThread(This) 150 145 151 146 '自身のスレッドハンドルを閉じる … … 201 196 End Class 202 197 198 Dim _System_pobj_AllThreads As *Detail._System_CThreadCollection 199 200 Namespace Detail 203 201 204 202 '-------------------------------------------------------------------- … … 206 204 '-------------------------------------------------------------------- 207 205 ' TODO: このクラスをシングルトンにする 206 208 207 Class _System_CThreadCollection 209 208 Public 210 ppobj_Thread As **Thread 211 pStackBase As **LONG_PTR 209 collection As *ThreadInfo 212 210 ThreadNum As Long 213 211 … … 215 213 216 214 Sub _System_CThreadCollection() 217 ppobj_Thread=GC_malloc(1) 218 pStackBase=HeapAlloc(_System_hProcessHeap,0,1) 219 ppException=HeapAlloc(_System_hProcessHeap,0,1) 220 ThreadNum=0 221 222 'クリティカルセッションを生成 215 collection = GC_malloc(1) 216 ThreadNum = 0 223 217 InitializeCriticalSection(CriticalSection) 224 218 End Sub … … 227 221 Dim i As Long 228 222 For i=0 To ELM(ThreadNum) 229 If ppobj_Thread[i] Then 230 If i = 0 Then 231 Delete ppobj_Thread[i] 232 End If 233 ppobj_Thread[i]=0 234 pStackBase[i]=0 235 Delete ppException[i] 236 ppException[i]=0 237 Exit For 223 With collection[i] 224 If .thread Then 225 .thread = Nothing 226 .stackBase = 0 227 .exception = Nothing 228 End If 229 End With 230 Next 231 collection = 0 232 DeleteCriticalSection(CriticalSection) 233 End Sub 234 235 'スレッドを生成 236 Sub BeginThread(thread As Thread, NowSp As *LONG_PTR) 237 EnterCriticalSection(CriticalSection) 238 Dim i = FindFreeIndex 239 With collection[i] 240 .thread = thread 241 .stackBase = NowSp 242 .exception = New ExceptionService '例外処理管理用オブジェクトを生成 243 End With 244 LeaveCriticalSection(CriticalSection) 245 End Sub 246 Private 247 'クリティカルセション内で呼ぶこと 248 Function FindFreeIndex() As Long 249 Dim i As Long 250 For i = 0 To ELM(ThreadNum) 251 If ActiveBasic.IsNothing(collection[i].thread) Then 252 FindFreeIndex = i 253 Exit Function 238 254 End If 239 255 Next 240 241 HeapFree(_System_hProcessHeap,0,pStackBase) 242 pStackBase=0 243 244 HeapFree(_System_hProcessHeap,0,ppException) 245 ppException = 0 246 247 ThreadNum=0 248 249 'クリティカルセッションを破棄 250 DeleteCriticalSection(CriticalSection) 251 End Sub 252 253 'スレッドを生成 254 Sub BeginThread(pThread As *Thread,NowSp As *LONG_PTR) 255 EnterCriticalSection(CriticalSection) 256 257 '例外処理管理用オブジェクトを生成 258 Dim pException As *ExceptionService 259 pException = New ExceptionService 260 261 Dim i As Long 262 For i=0 To ELM(ThreadNum) 263 If ppobj_Thread[i] = 0 Then 264 ppobj_Thread[i] = pThread 265 pStackBase[i] = NowSp 266 ppException[i] = pException 267 Exit For 268 End If 269 Next 270 271 If i = ThreadNum Then 272 ppobj_Thread=realloc(ppobj_Thread,(ThreadNum+1)*SizeOf(*Thread)) 273 ppobj_Thread[ThreadNum]=pThread 274 pStackBase=HeapReAlloc(_System_hProcessHeap,0,pStackBase,(ThreadNum+1)*SizeOf(LONG_PTR)) 275 pStackBase[ThreadNum]=NowSp 276 ppException=HeapReAlloc(_System_hProcessHeap,0,ppException,(ThreadNum+1)*SizeOf(*ExceptionService)) 277 ppException[ThreadNum]=pException 278 ThreadNum++ 279 End If 280 LeaveCriticalSection(CriticalSection) 281 End Sub 256 ThreadNum++ 257 collection = realloc(collection, ThreadNum * SizeOf(ThreadInfo)) 258 FindFreeIndex = i 259 End Function 260 Public 282 261 283 262 'スレッドを終了 284 Sub EndThread( pThread As *Thread)263 Sub EndThread(thread As Thread) 285 264 EnterCriticalSection(CriticalSection) 286 265 Dim i As Long 287 For i=0 To ELM(ThreadNum) 288 If ppobj_Thread[i] = pThread Then 289 If i = 0 Then 290 Delete pThread 266 For i = 0 To ELM(ThreadNum) 267 With collection[i] 268 If thread.Equals(.thread) Then 269 .thread = Nothing 270 .stackBase = 0 271 .exception = Nothing 272 Exit For 291 273 End If 292 ppobj_Thread[i]=0 293 pStackBase[i]=0 294 Delete ppException[i] 295 ppException[i]=0 296 Exit For 297 End If 274 End With 298 275 Next 299 276 LeaveCriticalSection(CriticalSection) … … 303 280 Sub SuspendAllThread() 304 281 Dim i As Long 305 For i=0 To ELM(ThreadNum) 306 If ppobj_Thread[i] Then 307 ppobj_Thread[i]->Suspend() 308 End If 282 For i = 0 To ELM(ThreadNum) 283 With collection[i] 284 If Not ActiveBasic.IsNothing(.thread) Then 285 .thread.Suspend() 286 End If 287 End With 309 288 Next 310 289 End Sub … … 313 292 Sub ResumeAllThread() 314 293 Dim i As Long 315 For i=0 To ELM(ThreadNum) 316 If ppobj_Thread[i] Then 317 ppobj_Thread[i]->Resume() 318 End If 319 Next 320 End Sub 321 294 For i = 0 To ELM(ThreadNum) 295 With collection[i] 296 If Not ActiveBasic.IsNothing(.thread) Then 297 .thread.Resume() 298 End If 299 End With 300 Next 301 End Sub 302 /* 322 303 ' 自分以外のスレッドを中断 323 304 Sub SuspendAnotherThread() 324 Dim currentThread = Thread.CurrentThread()305 Dim currentThread = CurrentThread() 325 306 326 307 Dim i As Long 327 308 For i=0 To ELM(ThreadNum) 328 329 If currentThread.Equals( ppobj_Thread[i] As Object ) Then 330 Continue 331 End If 332 333 If ppobj_Thread[i] Then 334 ppobj_Thread[i]->Suspend() 335 End If 309 With collection[i] 310 If currentThread.Equals(.thread) Then 311 Continue 312 ElseIf Not ActiveBasic.IsNothing(.thread) Then 313 .thread.Suspend() 314 End If 315 End With 336 316 Next 337 317 End Sub … … 339 319 ' 自分以外のスレッドを再開 340 320 Sub ResumeAnotherThread() 341 Dim currentThread = Thread.CurrentThread()321 Dim currentThread = CurrentThread() 342 322 343 323 Dim i As Long 344 324 For i=0 To ELM(ThreadNum) 345 346 If currentThread.Equals( ppobj_Thread[i] As Object ) Then 347 Continue 348 End If 349 350 If ppobj_Thread[i] Then 351 ppobj_Thread[i]->Resume() 352 End If 353 Next 354 End Sub 355 325 With collection[i] 326 If currentThread.Equals(.thread) Then 327 Continue 328 ElseIf Not ActiveBasic.IsNothing(.thread) Then 329 .thread.Resume() 330 End If 331 End With 332 Next 333 End Sub 334 */ 356 335 'カレントスレッドを取得 357 336 Function CurrentThread() As Thread 358 Dim dwNowThreadId As DWord 359 dwNowThreadId=GetCurrentThreadId() 360 361 Dim i As Long 362 For i=0 To ELM(ThreadNum) 363 If ppobj_Thread[i]->ThreadId=dwNowThreadId Then 364 Return ByVal ppobj_Thread[i] 337 Dim p = CurrentThreadInfo() 338 If p = 0 Then 339 ' TODO: エラー処理 340 OutputDebugString( Ex"カレントスレッドの取得に失敗\r\n" ) 341 debug 342 Exit Function 343 End If 344 CurrentThread = p->thread 345 End Function 346 347 Function CurrentThreadInfo() As *ThreadInfo 348 CurrentThreadInfo = FindThreadInfo(GetCurrentThreadId()) 349 End Function 350 351 Function FindThreadInfo(threadID As DWord) As *ThreadInfo 352 Dim i As Long 353 For i = 0 To ELM(ThreadNum) 354 If collection[i].thread.ThreadId = threadID Then 355 FindThreadInfo = VarPtr(collection[i]) 356 Exit Function 365 357 End If 366 358 Next 367 368 ' TODO: エラー処理 369 OutputDebugString( "カレントスレッドの取得に失敗" ) 370 debug 371 End Function 372 359 End Function 373 360 374 361 Private … … 376 363 ' スレッド固有の例外処理制御 377 364 '------------------------------------------ 378 ppException As **ExceptionService 379 380 Public 381 Function GetCurrentException() As *ExceptionService 382 Dim dwNowThreadId As DWord 383 dwNowThreadId=GetCurrentThreadId() 365 366 Public 367 Function GetCurrentException() As ExceptionService 368 Dim dwNowThreadId = GetCurrentThreadId() 384 369 385 370 Dim i As Long 386 371 For i=0 To ELM(ThreadNum) 387 If ppobj_Thread[i]->ThreadId=dwNowThreadId Then 388 Return ppException[i] 389 End If 390 Next 391 392 Return NULL 372 With collection[i] 373 If .thread.ThreadId = dwNowThreadId Then 374 Return .exception 375 End If 376 End With 377 Next 378 379 OutputDebugString( Ex"カレントスレッドの取得に失敗\r\n" ) 380 Return Nothing 393 381 End Function 394 382 End Class 395 Dim _System_pobj_AllThreads As *_System_CThreadCollection 383 384 Type ThreadInfo 385 thread As Thread 386 stackBase As *LONG_PTR 387 exception As ExceptionService 388 End Type 389 390 End Namespace 'Detail -
trunk/Include/Classes/System/misc.ab
r391 r400 16 16 End Interface 17 17 18 Interface IClon able18 Interface ICloneable 19 19 ' Method 20 20 Function Clone() As Object -
trunk/Include/basic.sbp
r304 r400 5 5 ' Unicodeが不安定な間の暫定対応 6 6 #define __STRING_IS_NOT_ALWAYS_UNICODE 7 8 7 9 8 #ifndef _INC_BASIC … … 107 106 End Function 108 107 109 Sub SetChar(p As * Char, c As Char)108 Sub SetChar(p As *WCHAR, c As WCHAR) 110 109 p[0] = c 111 110 End Sub 112 111 113 Function GetChar(p As *Char) As Char 112 Function GetChar(p As *WCHAR) As WCHAR 113 GetChar = p[0] 114 End Function 115 116 Sub SetChar(p As *CHAR, c As CHAR) 117 p[0] = c 118 End Sub 119 120 Function GetChar(p As *CHAR) As CHAR 114 121 GetChar = p[0] 115 122 End Function -
trunk/Include/basic/function.sbp
r394 r400 263 263 If _System_IsLowSurrogate(s[0]) Then 264 264 AscW = ((s[0] And &h3FF) As DWord << 10) Or (s[1] And &h3FF) 265 AscW += &h10000 265 266 Exit Function 266 267 End If … … 276 277 Return New String(c As StrChar, 1) 277 278 ElseIf c <= &h10FFFF Then 279 c -= &h10000 278 280 Dim t[1] As WCHAR 279 281 t[0] = (&hD800 Or (c >> 10)) As WCHAR … … 647 649 Val=0 648 650 649 While buf[0]=Asc(" ") or buf[0]=Asc(Ex"\t")651 While ActiveBasic.CType.IsSpace(buf[0]) 650 652 buf = VarPtr(buf[1]) 651 653 Wend … … 655 657 temporary = temporary.ToUpper() 656 658 TempPtr = StrPtr(temporary) 657 If TempPtr(1) =Asc("O") Then659 If TempPtr(1) = Asc("O") Then 658 660 '8進数 659 661 i=2 … … 715 717 716 718 Function Eof(FileNum As Long) As Long 717 Dim dwCurrent As DWord, dwEnd As DWord718 719 719 FileNum-- 720 721 dwCurrent=SetFilePointer(_System_hFile(FileNum),0,NULL,FILE_CURRENT) 722 dwEnd=SetFilePointer(_System_hFile(FileNum),0,NULL,FILE_END) 723 SetFilePointer(_System_hFile(FileNum),dwCurrent,NULL,FILE_BEGIN) 720 Dim dwCurrent = SetFilePointer(_System_hFile(FileNum), 0,NULL, FILE_CURRENT) 721 Dim dwEnd = SetFilePointer(_System_hFile(FileNum), 0, NULL, FILE_END) 722 SetFilePointer(_System_hFile(FileNum), dwCurrent, NULL, FILE_BEGIN) 724 723 725 724 If dwCurrent>=dwEnd Then … … 770 769 771 770 Function _System_malloc(stSize As SIZE_T) As VoidPtr 772 Return HeapAlloc(_System_hProcessHeap, 0,stSize)771 Return HeapAlloc(_System_hProcessHeap, 0, stSize) 773 772 End Function 774 773 775 774 Function _System_calloc(stSize As SIZE_T) As VoidPtr 776 Return HeapAlloc(_System_hProcessHeap, HEAP_ZERO_MEMORY,stSize)775 Return HeapAlloc(_System_hProcessHeap, HEAP_ZERO_MEMORY, stSize) 777 776 End Function 778 777 … … 786 785 787 786 Sub _System_free(lpMem As VoidPtr) 788 HeapFree(_System_hProcessHeap, 0,lpMem)787 HeapFree(_System_hProcessHeap, 0, lpMem) 789 788 End Sub 790 789 -
trunk/Include/crt.sbp
r383 r400 43 43 44 44 Declare Function sscanf CDecl Lib _CrtDllName (buffer As PCSTR, format As PCSTR, ...) As Long 45 Declare Function swscanf CDecl Lib _CrtDllName (buffer As PCWSTR, format As PC STR, ...) As Long45 Declare Function swscanf CDecl Lib _CrtDllName (buffer As PCWSTR, format As PCWSTR, ...) As Long 46 46 47 47 #ifdef UNICODE … … 74 74 #endif 75 75 76 Declare Function memcmp cdecl lib "msvcrt" (p1 As VoidPtr, p2 As VoidPtr, n As SIZE_T) As Long 77 Declare Function wmemcmp cdecl lib "msvcrt" (p1 As *WCHAR, p2 As WCHAR, n As SIZE_T) As Long 78 76 79 77 80 #endif '_INC_CRT -
trunk/Include/system/gc.sbp
r399 r400 156 156 157 157 ' スレッド管理用オブジェクトを生成 158 _System_pobj_AllThreads = New _System_CThreadCollection()158 _System_pobj_AllThreads = New Detail._System_CThreadCollection() 159 159 160 160 ' 自身のThreadオブジェクトを生成 161 Dim thread As Thread(hTargetThread,GetCurrentThreadId(),0)161 Dim thread = New Thread(hTargetThread, GetCurrentThreadId(), 0) 162 162 thread.Name = "main" 163 163 164 _System_pobj_AllThreads->BeginThread( ObjPtr( thread ),_System_gc_StackRoot_StartPtr As *LONG_PTR)164 _System_pobj_AllThreads->BeginThread(thread, _System_gc_StackRoot_StartPtr As *LONG_PTR) 165 165 166 166 End Sub … … 356 356 ExitProcess(-1) 357 357 End If 358 Throw New System.OutOfMemoryException(ActiveBasic.Strings.SPrintf("malloc: Failed to allocate %zu byte(s) memory.", New System.UInt64(size))) 358 Dim s2 = Nothing As Object '#145 359 s2 = New System.UInt64(size) 360 Throw New System.OutOfMemoryException(ActiveBasic.Strings.SPrintf("malloc: Failed to allocate %zu (%&zx) byte(s) memory.", s2, s2)) 359 361 End If 360 362 End Sub … … 550 552 Dim i As Long 551 553 For i=0 To ELM(_System_pobj_AllThreads->ThreadNum) 552 Dim thread = _System_pobj_AllThreads-> ppobj_Thread[i]553 If threadThen554 Dim thread = _System_pobj_AllThreads->collection[i].thread 555 If Not ActiveBasic.IsNothing(thread) Then 554 556 FillMemory(VarPtr(Context),SizeOf(CONTEXT),0) 555 557 Context.ContextFlags=CONTEXT_CONTROL 556 If thread ->__GetContext(Context)=0 Then558 If thread.__GetContext(Context)=0 Then 557 559 _System_DebugOnly_OutputDebugString(Ex"レジスタ情報の取得に失敗しました。\r\n") 558 560 End If … … 564 566 #endif 565 567 566 Dim size=(_System_pobj_AllThreads-> pStackBase[i]As LONG_PTR)-(NowSp As LONG_PTR)568 Dim size=(_System_pobj_AllThreads->collection[i].stackBase As LONG_PTR)-(NowSp As LONG_PTR) 567 569 Dim maxNum = (size\SizeOf(LONG_PTR)) As Long 568 570 … … 666 668 */ 667 669 Function SweepOnOtherThread() As Long 670 Imports System.Threading.Detail 668 671 EnterCriticalSection(CriticalSection) 669 670 672 671 673 Dim startTime = GetTickCount()
Note:
See TracChangeset
for help on using the changeset viewer.
