Changeset 214
- Timestamp:
- Apr 15, 2007, 1:55:46 AM (18 years ago)
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
Include/Classes/System/Object.ab
r212 r214 67 67 End Sub 68 68 69 Function GetType() As TypeInfo69 Virtual Function GetType() As TypeInfo 70 70 Return typeInfo 71 71 End Function -
Include/Classes/System/TypeInfo.ab
r207 r214 13 13 Sub ~TypeInfo() 14 14 End Sub 15 16 Override Function GetType() As TypeInfo 17 Return _System_TypeBase.selfTypeInfo 18 End Function 15 19 16 20 … … 162 166 Class _System_TypeForClass 163 167 Inherits TypeBaseImpl 164 Public 168 169 Public 170 referenceOffsets As *Long 171 numOfReference As Long 172 173 Sub _System_TypeForClass( strNamespace As String, name As String, referenceOffsets As *Long, numOfReference As Long ) 174 TypeBaseImpl( strNamespace, name ) 175 176 This.referenceOffsets = referenceOffsets 177 This.numOfReference = numOfReference 178 End Sub 165 179 Sub _System_TypeForClass( strNamespace As String, name As String ) 166 180 TypeBaseImpl( strNamespace, name ) … … 168 182 Sub ~_System_TypeForClass() 169 183 End Sub 184 170 185 Override Function IsClass() As Boolean 171 186 Return True … … 225 240 226 241 '例: 227 'Add( New _System_TypeForClass( "System", "String" ) )242 'Add( New _System_TypeForClass( "System", "String", [__offsets...], __numOfOffsets ) ) 228 243 'Search( "String" ).SetBaseType( Search( "Object" ) ) 229 244 End Sub … … 242 257 InitializeUserTypes() 243 258 259 selfTypeInfo = _System_TypeBase.Search( "System", "TypeInfo" ) As TypeInfo 244 260 245 261 OutputDebugString( Ex"ready dynamic meta datas!\r\n" ) … … 251 267 252 268 Static Function Search( strNamespace As LPSTR, typeName As LPSTR ) As TypeBaseImpl 253 254 269 ' TODO: 名前空間に対応する 255 270 Dim i As Long … … 267 282 End Function 268 283 284 Static selfTypeInfo = Nothing As TypeInfo 285 269 286 End Class 270 287 -
Include/Classes/index.ab
r58 r214 1 1 ' コンパイルに最低限必要なファイル 2 2 3 ' System4 3 #require "System\index.ab" 5 6 ' System.Thread 4 #require "System\Diagnostics\index.ab" 7 5 #require "System\Threading\index.ab" -
Include/basic.sbp
r207 r214 132 132 _System_pGC->Begin() 133 133 134 ' 動的型情報を生成 134 135 _System_TypeBase.Initialize() 135 136 -
Include/basic/command.sbp
r179 r214 266 266 267 267 Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double 268 Dim _System_UsingStrData[_System_MAX_PARMSNUM] As String268 Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char 'TODO: 暫定対応(動作未確認) 269 269 Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord 270 270 Function _System_GetUsingFormat(UsingStr As String) As String -
Include/basic/function.sbp
r208 r214 779 779 i64data=1 780 780 While i>=2 781 Val += i64data * TempPtr[i]781 Val += ( i64data * TempPtr[i] ) As Double 782 782 783 783 i64data *= &O10 -
Include/system/gc.sbp
r203 r214 20 20 Const _System_GC_FLAG_OBJECT = 8 21 21 22 Type _System_GlobalRoot 23 ptr As *LONG_PTR 24 count As Long 25 End Type 26 22 27 Class _System_CGarbageCollection 23 28 ppPtr As *VoidPtr … … 32 37 CriticalSection As CRITICAL_SECTION 33 38 34 ' メモリの上限値(この値を超えるとGCが発動します)35 '※バイト単位36 limitMemory Size As LONG_PTR39 ' メモリの上限値(この値を超えるとGCが発動します) 40 limitMemorySize As LONG_PTR ' バイト単位 41 limitMemoryObjectNum As Long ' メモリオブジェクトの個数単位 37 42 38 43 isFinish As Boolean 39 44 40 Public 45 46 ' Global Root 47 pGlobalRoots As *_System_GlobalRoot 48 globalRootNum As Long 49 Sub AddGlobalRootPtr( ptr As *LONG_PTR, count As Long ) 50 pGlobalRoots = _System_realloc( pGlobalRoots, (globalRootNum + 1) * SizeOf(_System_GlobalRoot) ) 51 pGlobalRoots[globalRootNum].ptr = ptr 52 pGlobalRoots[globalRootNum].count = count 53 globalRootNum++ 54 End Sub 55 56 Sub RegisterGlobalRoots() 57 ' このメソッドの実装はコンパイラが自動生成する 58 59 ' AddGlobalRootPtr(...) 60 ' ... 61 End Sub 41 62 42 63 ' 特殊クラスのため、コンストラクタ・デストラクタは呼ばれません … … 46 67 End Sub 47 68 69 Public 70 48 71 Sub Begin() 49 72 If ppPtr Then Exit Sub … … 52 75 53 76 'メモリの上限値(この値を超えるとGCが発動します) 54 '※バイト単位55 limitMemory Size = 1024*1024 As LONG_PTR77 limitMemorySize = 1024*1024 As LONG_PTR ' バイト単位 78 limitMemoryObjectNum = 2000 ' メモリオブジェクトの個数単位 56 79 57 80 ppPtr=_System_calloc( 1 ) … … 59 82 pdwFlags=_System_calloc( 1 ) 60 83 n=0 84 85 ' Global Root 86 pGlobalRoots = _System_calloc( 1 ) 87 globalRootNum = 0 88 RegisterGlobalRoots() 61 89 62 90 iAllSize=0 … … 107 135 '_System_pobj_AllThreads->ResumeAnotherThread() 108 136 109 HeapFree(_System_hProcessHeap,0,ppPtr) 110 ppPtr=0 111 112 HeapFree(_System_hProcessHeap,0,pSize) 113 pSize=0 114 HeapFree(_System_hProcessHeap,0,pdwFlags) 115 pdwFlags=0 137 _System_free( ppPtr ) 138 ppPtr = NULL 139 140 _System_free( pSize ) 141 pSize = NULL 142 _System_free( pdwFlags ) 143 pdwFlags = NULL 144 145 _System_free( pGlobalRoots ) 146 pGlobalRoots = NULL 116 147 117 148 'クリティカルセッションを破棄 … … 198 229 199 230 Sub sweep() 200 If isSweeping <> False Or iAllSize<limitMemorySizeThen231 If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then 201 232 'メモリ使用量が上限値を超えていないとき 202 233 Exit Sub 203 234 End If 204 OutputDebugString( Ex"garbage colletion sweep start!\r\n" )205 235 206 236 Dim hThread As HANDLE … … 214 244 Private 215 245 246 Static Function IsNull( object As Object ) As Boolean 247 If VarPtr( object ) = NULL Then 248 Return True 249 End If 250 Return False 251 End Function 252 216 253 ' 生存検知 217 254 Function HitTest(pSample As VoidPtr) As Long … … 225 262 End Function 226 263 264 ' オブジェクトのスキャン 265 Function ScanObject(pObject As *Object, pbMark As *Byte) As Boolean 266 Dim classTypeInfo = Nothing As _System_TypeForClass 267 classTypeInfo = pObject->GetType() As _System_TypeForClass 268 269 If IsNull( classTypeInfo ) Then 270 Return False 271 End If 272 273 Dim i As Long 274 For i = 0 To ELM(classTypeInfo.numOfReference) 275 Scan( (pObject + classTypeInfo.referenceOffsets[i]) As *LONG_PTR, 1, pbMark ) 276 Next 277 278 Return True 279 End Function 280 227 281 ' 指定領域のスキャン 228 Sub Scan(pStartPtr As *LONG_PTR, size As LONG_PTR, pbMark As *Byte)229 Dim i As Long, count As Long,index As Long230 count=(size\SizeOf(LONG_PTR)) As Long 231 For i=0 To ELM( count)282 Sub Scan(pStartPtr As *LONG_PTR, maxNum As Long, pbMark As *Byte) 283 Dim i As Long, index As Long 284 285 For i=0 To ELM(maxNum) 232 286 index=HitTest(pStartPtr[i] As VoidPtr) 233 287 If index<>-1 Then … … 235 289 pbMark[index]=1 236 290 237 If (pdwFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then 238 'ヒープ領域がポインタ値を含む可能性があるとき 291 If pdwFlags[index] and _System_GC_FLAG_OBJECT Then 292 ' オブジェクトの場合 293 If ScanObject( (ppPtr[index] + 3*SizeOf(LONG_PTR)) As *Object, pbMark) = False Then 294 Dim maxNum = (pSize[index]\SizeOf(LONG_PTR)) As Long 295 Scan(ppPtr[index] As *LONG_PTR, maxNum, pbMark) 296 End If 297 298 ElseIf (pdwFlags[index] and _System_GC_FLAG_ATOMIC)=0 Then 299 ' ヒープ領域がポインタ値を含む可能性があるとき 239 300 If ppPtr[index] = 0 Then 240 301 'エラー 241 302 242 303 End If 243 Scan(ppPtr[index] As *LONG_PTR,pSize[index],pbMark) 304 305 Dim maxNum = (pSize[index]\SizeOf(LONG_PTR)) As Long 306 Scan(ppPtr[index] As *LONG_PTR, maxNum, pbMark) 244 307 End If 245 308 End If … … 268 331 #endif 269 332 270 size=(_System_pobj_AllThreads->pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR) 333 Dim size=(_System_pobj_AllThreads->pStackBase[i] As LONG_PTR)-(NowSp As LONG_PTR) 334 Dim maxNum = (size\SizeOf(LONG_PTR)) As Long 271 335 272 336 If NowSp = 0 Then … … 275 339 End If 276 340 277 Scan( NowSp, size, pbMark )341 Scan( NowSp, maxNum, pbMark ) 278 342 End If 279 343 Next … … 313 377 _System_SweepingDelete (ptr + SizeOf( LONG_PTR ) * 3 ) 314 378 Else 315 iAllSize-=size316 379 HeapFree(_System_hProcessHeap,0,ptr) 317 380 End If 381 382 iAllSize-=size 318 383 End If 319 384 Next … … 347 412 EnterCriticalSection(CriticalSection) 348 413 349 If isSweeping <> False Or iAllSize<limitMemorySize Then 414 415 Dim startTime = GetTickCount() 416 417 OutputDebugString( Ex"garbage colletion sweep start!\r\n" ) 418 419 420 If isSweeping <> False or (iAllSize<limitMemorySize and n<limitMemoryObjectNum) Then 350 421 ExitThread(0) 351 422 End If … … 359 430 360 431 ' グローバル領域をルートに指定してスキャン 361 Scan( _System_gc_GlobalRoot_StartPtr, _System_gc_GlobalRoot_Size, pbMark ) 432 Dim i As Long 433 For i = 0 To ELM( globalRootNum ) 434 Scan( pGlobalRoots[i].ptr, pGlobalRoots[i].count, pbMark ) 435 Next 362 436 363 437 ' ローカル領域をルートに指定してスキャン … … 386 460 '許容量を拡張する 387 461 limitMemorySize *= 2 462 limitMemoryObjectNum *= 2 388 463 389 464 OutputDebugString( Ex"memory size is extended for gc!\r\n" ) … … 391 466 392 467 Dim temp[100] As Char 393 wsprintf(temp,Ex"object items ... %d -> %d ( %d MB -> %dMB )\r\n",iBeforeN,n, iBackAllSize\1024\1024, iAllSize\1024\1024)468 wsprintf(temp,Ex"object items ... %d -> %d ( %d MB -> %d MB )\r\n",iBeforeN,n, iBackAllSize\1024\1024, iAllSize\1024\1024) 394 469 OutputDebugString( temp ) 395 470 wsprintf(temp,Ex"limit size of memory ... %d\r\n",limitMemorySize) 396 471 OutputDebugString( temp ) 397 OutputDebugString( Ex"garbage colletion sweep finish!\r\n" ) 472 wsprintf(temp,Ex"garbage colletion sweep finish! (%d ms)\r\n\r\n", GetTickCount()-startTime) 473 OutputDebugString( temp ) 398 474 399 475
Note:
See TracChangeset
for help on using the changeset viewer.