Changeset 275


Ignore:
Timestamp:
Jun 13, 2007, 12:00:44 AM (17 years ago)
Author:
dai
Message:

（32ビットコンパイラ）
クラス情報取得時のクラス先読み処理で名前空間の関係が崩れてしまうバグを修正。
インクルードパスに'/'文字を含めたときに'
'として判断するようにした。

（ライブラリ）
ActiveBasic.Core名前空間を作成した（動的型情報に関する内部コードをここに移動）。
DateTimeクラスをSystem名前空間に入れた。
TimeSpanクラスをSystem名前空間に入れた。
TimeInfoクラスをSystem名前空間に入れた。

Files:
4 added
10 edited

Legend:

Unmodified
Added
Removed

  • Include/Classes/System/DateTime.ab

    r272 r275  
    1 ' Classes/System/DateTime.ab
     1Namespace System
     2
    23
    34Class DateTime
    … …  
    480481    Saturday
    481482End Enum
     483
     484
     485End Namespace

  • Include/Classes/System/Object.ab

    r246 r275  
    6363    Public
    6464        Sub _System_SetType( typeInfo As TypeInfo )
    65             If _System_TypeBase.IsReady() = False Then
     65            If ActiveBasic.Core._System_TypeBase.IsReady() = False Then
    6666                Return
    6767            End If

  • Include/Classes/System/TimeSpan.ab

    r268 r275  
     1Namespace System
     2
     3
    14Class TimeSpan
    25    m_Time As Int64
    … …  
    199202    End Function
    200203End Class
     204
     205
     206End Namespace

  • Include/Classes/System/TypeInfo.ab

    r259 r275  
    33
    44
    5 'Namespace System
     5Namespace System
    66
    77
    … …  
    1515
    1616    Override Function GetType() As TypeInfo
    17         Return _System_TypeBase.selfTypeInfo
     17        Return ActiveBasic.Core._System_TypeBase.selfTypeInfo
    1818    End Function
    1919
    … …  
    4848
    4949
    50 ' 中間的な実装（継承専用）
    51 Class TypeBaseImpl
    52     Inherits TypeInfo
    53 
    54     strNamespace As String
    55     name As String
    56 
    57 Protected
    58 
    59     baseType As TypeInfo
    60     'interfaces As f(^^;;;
    61 
    62     Sub TypeBaseImpl()
    63         strNamespace = ""
    64         name = ""
    65         baseType = Nothing
    66     End Sub
    67 
    68     Sub TypeBaseImpl( strNamespace As String, name As String )
    69         This.strNamespace = strNamespace
    70         This.name = name
    71         This.baseType = Nothing
    72     End Sub
    73 
    74     Sub TypeBaseImpl( strNamespace As String, name As String, baseType As TypeInfo )
    75         This.strNamespace = strNamespace
    76         This.name = name
    77         This.baseType = baseType
    78     End Sub
    79 
    80     /*
    81     Sub TypeBaseImpl( strNamespace As String, name As String, baseType As Type, interfaces As ... )
    82         This.strNamespace = strNamespace
    83         This.name = name
    84         This.baseType = baseType
    85         This.interfaces = interfaces
    86     End Sub
    87     */
    88 
    89     Sub ~TypeBaseImpl()
    90     End Sub
    91 
    92 Public
    93 
    94 
    95     '----------------------------------------------------------------
    96     ' Public properties
    97     '----------------------------------------------------------------
    98 
    99     Override Function BaseType() As TypeInfo
    100         Return baseType
    101     End Function
    102 
    103     Sub SetBaseType( baseType As TypeInfo )
    104         This.baseType = baseType
    105     End Sub
    106 
    107     Override Function FullName() As String
    108         If strNamespace.Length > 0 Then
    109             Return strNamespace + "." + name
    110         End If
    111         Return name
    112     End Function
    113 
    114     Override Function IsArray() As Boolean
    115         Return False
    116     End Function
    117 
    118     Override Function IsByRef() As Boolean
    119         Return False
    120     End Function
    121 
    122     Override Function IsClass() As Boolean
    123         Return False
    124     End Function
    125 
    126     Override Function IsEnum() As Boolean
    127         Return False
    128     End Function
    129 
    130     Override Function IsInterface() As Boolean
    131         Return False
    132     End Function
    133 
    134     Override Function IsPointer() As Boolean
    135         Return False
    136     End Function
    137 
    138     Override Function IsValueType() As Boolean
    139         Return False
    140     End Function
    141 
    142     Override Function Name() As String
    143         Return name
    144     End Function
    145 
    146     Override Function Namespace() As String
    147         Return strNamespace
    148     End Function
    149 
    150 
    151 
    152     '----------------------------------------------------------------
    153     ' Public methods
    154     '----------------------------------------------------------------
    155 
    156 End Class
    157 
    158 
    159 ' 値型を管理するためのクラス
    160 Class _System_TypeForValueType
    161     Inherits TypeBaseImpl
    162 Public
    163     Sub _System_TypeForValueType( name As String )
    164         TypeBaseImpl( "", name )
    165     End Sub
    166 
    167     Override Function IsValueType() As Boolean
    168         Return True
    169     End Function
    170 End Class
    171 
    172 ' クラスを管理するためのクラス
    173 Class _System_TypeForClass
    174     Inherits TypeBaseImpl
    175 
    176 Public
    177     referenceOffsets As *Long
    178     numOfReference As Long
    179 
    180     Sub _System_TypeForClass( strNamespace As String, name As String, referenceOffsets As *Long, numOfReference As Long )
    181         TypeBaseImpl( strNamespace, name )
    182 
    183         This.referenceOffsets = referenceOffsets
    184         This.numOfReference = numOfReference
    185     End Sub
    186     Sub _System_TypeForClass( strNamespace As String, name As String )
    187         TypeBaseImpl( strNamespace, name )
    188     End Sub
    189     Sub ~_System_TypeForClass()
    190     End Sub
    191 
    192     Override Function IsClass() As Boolean
    193         Return True
    194     End Function
    195 End Class
    196 
    197 ' インターフェイスを管理するためのクラス
    198 Class _System_TypeForInterface
    199     Inherits TypeBaseImpl
    200 Public
    201 End Class
    202 
    203 ' 列挙体を管理するためのクラス
    204 Class _System_TypeForEnum
    205     Inherits TypeBaseImpl
    206 Public
    207 End Class
    208 
    209 ' デリゲートを管理するためのクラス
    210 Class _System_TypeForDelegate
    211     Inherits TypeBaseImpl
    212 Public
    213 End Class
    214 
    215 
    216 '--------------------------------------------------------------------
    217 ' プロセスに存在するすべての型を管理する
    218 '--------------------------------------------------------------------
    219 Class _System_TypeBase
    220     Static pTypes As *TypeBaseImpl
    221     Static count As Long
    222     Static isReady = False
    223 
    224     Static Sub Add( typeInfo As TypeBaseImpl )
    225         pTypes = realloc( pTypes, ( count + 1 ) * SizeOf(*TypeInfo) )
    226         pTypes[count] = typeInfo
    227         count++
    228     End Sub
    229 
    230     Static Sub InitializeValueType()
    231         ' 値型の追加
    232         Add( New _System_TypeForValueType( "Byte" ) )
    233         Add( New _System_TypeForValueType( "SByte" ) )
    234         Add( New _System_TypeForValueType( "Word" ) )
    235         Add( New _System_TypeForValueType( "Integer" ) )
    236         Add( New _System_TypeForValueType( "DWord" ) )
    237         Add( New _System_TypeForValueType( "Long" ) )
    238         Add( New _System_TypeForValueType( "QWord" ) )
    239         Add( New _System_TypeForValueType( "Int64" ) )
    240         Add( New _System_TypeForValueType( "Boolean" ) )
    241         Add( New _System_TypeForValueType( "Single" ) )
    242         Add( New _System_TypeForValueType( "Double" ) )
    243     End Sub
    244 
    245     Static Sub InitializeUserTypes()
    246         ' このメソッドの実装はコンパイラが自動生成する
    247 
    248         '例:
    249         'Add( New _System_TypeForClass( "System", "String", [__offsets...], __numOfOffsets ) )
    250         'Search( "System","String" ).SetBaseType( Search( "System","Object" ) )
    251     End Sub
    252 
    253 Public
    254 
    255     Static Sub Initialize()
    256         pTypes = GC_malloc( 1 )
    257         count = 0
    258 
    259         ' 値型を初期化
    260         InitializeValueType()
    261 
    262         isReady = True
    263         ' Class / Interface / Enum / Delegate を初期化
    264         InitializeUserTypes()
    265 
    266         selfTypeInfo = _System_TypeBase.Search( "System", "TypeInfo" ) As TypeInfo
    267 
    268         _System_DebugOnly_OutputDebugString( Ex"ready dynamic meta datas!\r\n" )
    269     End Sub
    270 
    271     Static Sub _NextPointerForGC()
    272         ' TODO: 実装
    273     End Sub
    274 
    275     Static Function Search( strNamespace As LPSTR, typeName As LPSTR ) As TypeBaseImpl
    276         ' TODO: 名前空間に対応する
    277         Dim i As Long
    278         For i = 0 To ELM( count )
    279             If pTypes[i].Name = typeName Then
    280                 Return pTypes[i]
    281             End If
    282         Next
    283 
    284         Return Nothing
    285     End Function
    286 
    287     Static Function IsReady() As Boolean
    288         Return isReady
    289     End Function
    290 
    291     Static selfTypeInfo = Nothing As TypeInfo
    292 
    293 End Class
    294 
    295 
    296 ' End Namespace ' System
     50End Namespace ' System

  • Include/Classes/index.ab

    r271 r275  
    11' コンパイルに最低限必要なファイル
    22
    3 #require "System\index.ab"
     3#require "./ActiveBasic/index.ab"
     4#require "./System/index.ab"

  • Include/basic.sbp

    r266 r275  
    147147
    148148        ' 動的型情報を生成
    149         _System_TypeBase.Initialize()
     149        ActiveBasic.Core._System_TypeBase.Initialize()
    150150
    151151        'Initialize static variables

  • Include/system/gc.sbp

    r266 r275  
    278278    ' オブジェクトのスキャン
    279279    Function ScanObject(pObject As *Object, pbMark As *Byte) As Boolean
    280         Dim classTypeInfo = Nothing As _System_TypeForClass
    281         classTypeInfo = pObject->GetType() As _System_TypeForClass
     280        Dim classTypeInfo = Nothing As ActiveBasic.Core._System_TypeForClass
     281        classTypeInfo = pObject->GetType() As ActiveBasic.Core._System_TypeForClass
    282282
    283283        If IsNull( classTypeInfo ) Then

  • TestCase/SimpleTestCase/DateTimeTest.ab

    r264 r275  
    44
    55Namespace DateTimeTest
     6
     7Imports System
    68
    79Sub TestMain()

  • TestCase/SimpleTestCase/SimpleTestCase.pj

    r272 r275  
    2323#DEBUG_EXE_PATH=
    2424
    25 #RESOURCE=0
     25#RESOURCE=SimpleTestCase.rc
    2626
    2727#SOURCE
Note: See TracChangeset for help on using the changeset viewer.