Changeset 475 for trunk/Include/Classes/ActiveBasic/Core
- Timestamp:
- Mar 13, 2008, 9:44:51 AM (17 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Include/Classes/ActiveBasic/Core/TypeInfo.ab
r452 r475 73 73 End Sub 74 74 75 Sub SetBaseType( baseType As System.TypeInfo ) 76 This.baseType = baseType 77 End Sub 78 75 79 Function GetPtrType() As TypeBaseImpl 76 80 If Object.ReferenceEquals( ptrType, Nothing ) Then … … 91 95 Return baseType 92 96 End Function 93 94 Sub SetBaseType( baseType As System.TypeInfo )95 This.baseType = baseType96 End Sub97 97 98 98 Override Function FullName() As String … … 171 171 End Class 172 172 173 TypeDef _SYSTEM_CONSTRUCTOR_PROC = *Sub( pThis As *Object ) 174 TypeDef _SYSTEM_DESTRUCTOR_PROC = *Sub( pThis As *Object ) 175 173 176 ' クラスを管理するためのクラス 174 177 Class _System_TypeForClass 175 178 Inherits TypeBaseImpl 176 179 180 Static Const _SYSTEM_OBJECT_HEAD_SIZE = SizeOf(LONG_PTR) * 4 181 182 size As SIZE_T 183 comVtbl As VoidPtr 184 vtblList As VoidPtr 185 pDefaultConstructor As _SYSTEM_CONSTRUCTOR_PROC 186 pDestructor As _SYSTEM_DESTRUCTOR_PROC 187 177 188 Public 178 189 referenceOffsets As *Long … … 191 202 End Sub 192 203 204 Sub SetClassInfo( size As SIZE_T, comVtbl As VoidPtr, vtblList As VoidPtr, pDefaultConstructor As _SYSTEM_CONSTRUCTOR_PROC, pDestructor As _SYSTEM_DESTRUCTOR_PROC ) 205 This.size = size 206 This.comVtbl = comVtbl 207 This.vtblList = vtblList 208 This.pDefaultConstructor = pDefaultConstructor 209 This.pDestructor = pDestructor 210 End Sub 211 193 212 Override Function IsClass() As Boolean 194 213 Return True 214 End Function 215 216 217 Static Function _System_New( typeForClass As ActiveBasic.Core._System_TypeForClass ) As Object 218 If typeForClass.pDefaultConstructor = NULL Then 219 Throw New System.SystemException( "デフォルトコンストラクタを持たないクラスに対して_System_New関数は使えません。" ) 220 End If 221 222 ' まずはメモリを確保 223 Dim pPtr = _System_GC_malloc_ForObject( typeForClass.size + _SYSTEM_OBJECT_HEAD_SIZE ) As VoidPtr 224 225 ' pPtr[0]=オブジェクトの個数 226 Set_LONG_PTR( pPtr, 1 ) 227 pPtr += SizeOf(LONG_PTR) 228 229 ' pPtr[1]=オブジェクトのサイズ 230 Set_LONG_PTR( pPtr, typeForClass.size ) 231 pPtr += SizeOf(LONG_PTR) 232 233 ' pPtr[2]=デストラクタの関数ポインタ 234 Set_LONG_PTR( pPtr, typeForClass.pDestructor As LONG_PTR ) 235 pPtr += SizeOf(LONG_PTR) 236 237 ' pPtr[3]=reserve 238 pPtr += SizeOf(LONG_PTR) 239 240 Dim pObject = pPtr As *Object 241 242 ' com_vtblをセット 243 Set_LONG_PTR( pObject, typeForClass.comVtbl As LONG_PTR ) 244 245 ' vtbl_listをセット 246 Set_LONG_PTR( pObject + SizeOf(LONG_PTR), typeForClass.vtblList As LONG_PTR ) 247 248 ' 動的型情報をセットする 249 pObject->_System_SetType( typeForClass ) 250 251 ' コンストラクタを呼び出す 252 Dim proc = typeForClass.pDefaultConstructor 253 proc( pObject ) 254 255 Return ByVal pObject 195 256 End Function 196 257 End Class
Note:
See TracChangeset
for help on using the changeset viewer.