src/mobius/types.slate

   1 define: #Type &basedOn: Types Type &slots: {#dispatcher -> Cloneable clone}.
   2 "A dispatching object for statically determining which pidgin method to invoke."
   3
   4 t@(Type traits) clone
   5 [
   6   resend `>> [dispatcher := t dispatcher clone. ]
   7 ].
   8
   9 t@(Type traits) dependencies
  10 [Set new `>> [addDependency: t withVisited: Set new. remove: t. ]].
  11
  12 c addDependency: t@(Type traits) withVisited: visited
  13 [
  14 ].
  15
  16 t@(Type traits) alignment
  17 [| bits |
  18   (bits := t bitSize) >= LongInt bitSize \/ [bits = 0]
  19     ifTrue: [LongInt bitSize]
  20     ifFalse: [bits]
  21 ].
  22
  23 t@(Type traits) byteSize
  24 [
  25   (t bitSize + Char bitSize - 1) // Char bitSize
  26 ].
  27
  28 t@(Type traits) wordSize
  29 [
  30   (t bitSize + LongInt bitSize - 1) // LongInt bitSize
  31 ].
  32
  33 define: #NamedType &basedOn: Type &slots: {#cName}.
  34
  35 define: #Pointer &basedOn: Type &slots: {#targetType}.
  36
  37 p@(Pointer traits) to: targetType
  38 "Creates a new Pointer Type for the targetType."
  39 "TODO: Map an IdentityDictionary from types to types of pointers to those
  40 types, and unify implicitly?"
  41 [
  42   p clone `>> [targetType := targetType. ]
  43 ].
  44
  45 p@(Pointer traits) cName ['P' ; p targetType slateName].
  46 p@(Pointer traits) slateName ['UndefinedSlatePointer'].
  47
  48
  49 _@(Pointer traits) bitSize
  50 [
  51   LongInt bitSize
  52 ].
  53
  54 t@(Type traits) pointer
  55 [
  56   Pointer to: t
  57 ].
  58
  59 p@(Pointer traits) = q@(Pointer traits)
  60 [p targetType = q targetType].
  61
  62 c addDependency: p@(Pointer traits) withVisited: visited
  63 [
  64   (visited includes: p)
  65     ifFalse:
  66       [visited include: p.
  67        (p targetType isSameAs: Synonym)
  68           ifTrue: [c addDependency: p targetType withVisited: visited]]
  69 ].
  70
  71 define: #Integer &basedOn: Type &slots: {#pointerType. #cPrintName}.
  72
  73 _@(Integer traits) baseByteSize [overrideThis].
  74
  75 n@(Integer traits) byteSize &platform: p
  76 [
  77   n baseByteSizeOn: (p `defaultsTo: Platform Current)
  78 ].
  79
  80 n@(Integer traits) bitSize &platform: p
  81 [(n byteSize &platform: p) * 8].
  82
  83 n@(Integer traits) cName
  84 [n cPrintName `defaultsTo: n printName name fromCamelCase].
  85
  86 n@(Integer traits) slateName
  87 [n printName].
  88
  89 n@(Integer traits) pointer
  90 [n pointerType `defaultsTo: (Pointer to: n)].
  91
  92 define: #Signed &basedOn: Integer.
  93 define: #Unsigned &basedOn: Integer.
  94
  95 define: #Char &basedOn: Signed.
  96 _@(Char traits) baseByteSizeOn: _ [1].
  97 define: #UnsignedChar &basedOn: Unsigned.
  98 _@(UnsignedChar traits) baseByteSizeOn: _ [1].
  99 define: #ShortInt &basedOn: Signed.
 100 _@(ShortInt traits) baseByteSizeOn: _ [2].
 101 define: #UnsignedShortInt &basedOn: Unsigned.
 102 _@(UnsignedShortInt traits) baseByteSizeOn: _ [2].
 103 define: #LongInt &basedOn: Signed.
 104 _@(LongInt traits) baseByteSizeOn: p [p bytesPerWord].
 105 define: #UnsignedLongInt &basedOn: Unsigned.
 106 _@(UnsignedLongInt traits) baseByteSizeOn: p [p bytesPerWord].
 107 define: #LongLongInt &basedOn: Signed.
 108 _@(LongLongInt traits) baseByteSizeOn: p [p bytesPerWord * 2].
 109 define: #UnsignedLongLongInt &basedOn: Unsigned.
 110 _@(UnsignedLongLongInt traits) baseByteSizeOn: p [p bytesPerWord * 2].
 111 define: #Float &basedOn: Type.
 112 _@(Float traits) baseByteSizeOn: p [4].
 113 define: #Double &basedOn: Float.
 114 _@(Double traits) baseByteSizeOn: p [8].
 115 define: #Void &basedOn: Type.
 116 _@(Void traits) baseByteSizeOn: _ [0].
 117
 118 define: #FixedInteger &basedOn: Integer.
 119
 120 define: #FixedSigned &basedOn: FixedInteger.
 121 define: #FixedUnsigned &basedOn: FixedInteger.
 122
 123 define: #Modifier &basedOn: Type &slots: {#baseType -> Type}.
 124
 125 t@(Modifier traits) cName [t modifierName ; ' ' ; t baseType cName].
 126
 127 m@(Modifier traits) for: b
 128 [m clone `>> [baseType := b. ]].
 129
 130 define: #Mutability &basedOn: Modifier.
 131 define: #Const &basedOn: Mutability.
 132 _@Const modifierName [#const].
 133 t@(Type traits) const [Const for: t].
 134 define: #Volatile &basedOn: Mutability.
 135 _@Volatile modifierName [#volatile].
 136 t@(Type traits) volatile [Volatile for: t].
 137
 138 define: #Storage &basedOn: Modifier.
 139 Storage traits None     ::= Storage clone.
 140 Storage traits Auto     ::= Storage clone.
 141 _@(Storage Auto traits) modifierName [#auto].
 142 t@(Type traits) auto [Storage Auto for: t].
 143 Storage traits Static   ::= Storage clone.
 144 _@(Storage Static traits) modifierName [#static].
 145 t@(Type traits) static [Storage Static for: t].
 146 Storage traits Extern   ::= Storage clone.
 147 _@(Storage Extern traits) modifierName [#extern].
 148 t@(Type traits) extern [Storage Extern for: t].
 149 Storage traits Register ::= Storage clone.
 150 _@(Storage Register traits) modifierName [#register].
 151 t@(Type traits) register [Storage Register for: t].
 152
 153 define: #Array &basedOn: Type &slots:
 154   {#elementType -> UnsignedLongInt.
 155    #size -> Nil}.
 156
 157 t@(Array traits) of: elementType size: size
 158 [t clone `>> [elementType := elementType. size := size. ]].
 159
 160 t@(Array traits) of: elementType
 161 [t of: elementType size: Nil].
 162
 163 c addDependency: t@(Array traits) withVisited: visited
 164 [
 165   (visited includes: t)
 166     ifFalse:
 167       [
 168         visited include: t.
 169         c addDependency: t elementType withVisited: visited
 170       ]
 171 ].
 172
 173 t@(Array traits) bitSize
 174 [
 175   t elementType bitSize * t size
 176 ].
 177
 178 define: #Synonym &basedOn: NamedType
 179   &slots: {#targetType. #pointer -> Pointer. #isExported -> False}.
 180
 181 t@(Synonym traits) newNamed: name type: type
 182 [
 183   t clone `>> [| :newT |
 184     cName := name.
 185     pointer := t pointer to: newT.
 186     targetType := type. ]
 187 ].
 188
 189 t@(Synonym traits) export
 190 [
 191   t isExported := True.
 192   t
 193 ].
 194
 195 c addDependency: t@(Synonym traits) withVisited: visited
 196 [
 197   (visited includes: t)
 198     ifFalse:
 199       [visited include: t.
 200        c include: t.
 201        c addDependency: t targetType withVisited: visited]
 202 ].
 203
 204 t@(Synonym traits) bitSize
 205 [
 206   t targetType bitSize
 207 ].
 208
 209 define: #Structure &basedOn: NamedType
 210   &slots: {#basis. #pointer -> Pointer. #isExported -> False.
 211            #elementSpecs -> ExtensibleArray new}.
 212
 213 t@(Structure traits) newNamed: name basedOn: basis
 214 [
 215   t clone `>>
 216    [| :newT | cName := name. basis := basis.
 217     pointer := t pointer to: newT.
 218     "pointer rules rawAddDelegate: #basisPointer valued: basis pointer rules.
 219     pointer dispatcher rawAddDelegate: #basisPointer valued: basis pointer dispatcher."
 220     elementSpecs := basis elementSpecs copy.
 221     elementSpecs do:
 222       [| :se | [| :_ | se type] asMethod: se cName asInferenceRule
 223                                 on: {newT}]. ]
 224 ].
 225
 226 t@(Structure traits) newNamed: name
 227 [
 228   t clone `>> [| :newT |
 229     cName := name.
 230     basis := Nil.
 231     pointer := t pointer to: newT.
 232     elementSpecs := t elementSpecs new. ]
 233 ].
 234
 235 t@(Structure traits) export
 236 [
 237   t isExported := True.
 238   t
 239 ].
 240
 241 c addDependency: t@(Structure traits) withVisited: visited
 242 [
 243   (visited includes: t)
 244     ifFalse:
 245       [
 246         visited include: t.
 247         c include: t.
 248         t elementSpecs do: [| :se | c addDependency: se type withVisited: visited]
 249       ]
 250 ].
 251
 252 t@(Structure traits) doElements: block
 253 [| previousSE bits |
 254   previousSE := t elementSpecs first.
 255   block applyTo: {previousSE. 0}.
 256   bits := previousSE bitSize.
 257   t elementSpecs allButFirstDo:
 258     [| :se |
 259       previousSE packed /\ [se packed]
 260         ifFalse:
 261           [| alignment |
 262             alignment := se type alignment.
 263             previousSE packed
 264               ifTrue:
 265                 [alignment := alignment max: previousSE type bitSize].
 266             bits := (bits / alignment) ceiling * alignment].
 267       block applyTo: {se. bits}.
 268       bits += se bitSize.
 269       previousSE := se]
 270 ].
 271
 272 t@(Type traits) walkElements: block &bitOffset: offset
 273 [
 274   t walkElements: block withPath: Stack new atBitOffset: (offset ifNil: [0])
 275 ].
 276
 277 _@(Type traits) walkElements: _ withPath: _ atBitOffset: _
 278 [
 279 ].
 280
 281 t@(Structure traits) walkElements: block withPath: path atBitOffset: baseOffset
 282 [
 283   t doElements:
 284     [| :se :offset |
 285      path push: se.
 286      block applyTo: {path. baseOffset + offset}.
 287      se type walkElements: block withPath: path atBitOffset: baseOffset + offset.
 288      path pop]
 289 ].
 290
 291 t@(Structure traits) unpaddedSize
 292 [| lastSE lastOffset |
 293   t elementSpecs isEmpty
 294     ifTrue: [^ 0].
 295   t doElements:
 296     [| :se :offset |
 297       lastSE := se.
 298       lastOffset := offset].
 299   lastOffset + lastSE bitSize
 300 ].
 301
 302 t@(Structure traits) alignment
 303 [
 304   t elementSpecs inject: 0 into:
 305     [| :maxAlign :se | maxAlign max: se type alignment]
 306 ].
 307
 308 t@(Structure traits) bitSize
 309 [| maxAlign |
 310   maxAlign := t alignment.
 311   (t unpaddedSize / maxAlign) ceiling * maxAlign
 312 ].
 313
 314
 315 define: #Union &basedOn: Structure.
 316
 317 t@(Union traits) doElements: block
 318 [
 319   t elementSpecs do:
 320     [| :se | block applyTo: {se. 0}]
 321 ].
 322
 323 t@(Union traits) unpaddedSize
 324 [| maxSize |
 325   maxSize := 0.
 326   t doElements:
 327     [| :se :_ |
 328       maxSize := maxSize max: se type bitSize].
 329   maxSize
 330 ].
 331
 332 define: #StructureElement &basedOn: NamedType
 333   &slots: {#type -> UnsignedLongInt}.
 334
 335 se@(StructureElement traits) newNamed: name type: type
 336 [
 337   se clone `>> [cName := name. type := type. ]
 338 ].
 339
 340 t@(Structure traits) addElement: se
 341 [
 342   t elementSpecs
 343     do: [| :each | each cName = se cName
 344           ifTrue: [warn: 'Attempted Redefinition of type StructureElement, named "' ; each cName ; '".'.
 345             ^ each]].
 346   [| :_ | se type] asMethod: se cName asInferenceRule on: {t}.
 347   [| :_ | se type] asMethod: se cName asInferenceRule on: {t pointer}.
 348   t elementSpecs addLast: se
 349 ].
 350
 351 t@(Structure traits) addElementNamed: name &type
 352 [
 353   type `defaultsTo: UnsignedLongInt.
 354   t addElement: (StructureElement newNamed: name type: type)
 355 ].
 356
 357 t@(StructureElement traits) bitSize
 358 [
 359   t type bitSize
 360 ].
 361
 362 _@(StructureElement traits) packed
 363 [
 364   False
 365 ].
 366
 367 define: #PackedStructureElement &basedOn: StructureElement
 368   &slots: {#bitSize -> 0}.
 369
 370 se@(PackedStructureElement traits) newNamed: name size: size
 371 [
 372   (se newNamed: name type: UnsignedLongInt) `>> [bitSize := size. ]
 373 ].
 374
 375 t@(Structure traits) addPackedElementNamed: name size: size
 376 [
 377   t addElement: (PackedStructureElement newNamed: name size: size)
 378 ].
 379
 380 _@(PackedStructureElement traits) packed
 381 [True].
 382
 383 define: #Function &basedOn: Type
 384   &slots: {#argumentTypes -> {}. #resultType -> Void}.
 385
 386 fun@(Function traits) from: argumentTypes to: resultType
 387 [
 388   fun clone `>>
 389    [| :newFun | argumentTypes := argumentTypes as: newFun argumentTypes.
 390     resultType := resultType. ]
 391 ].
 392
 393 define: #FunctionPointer &basedOn: Pointer.
 394
 395 fun@(Function traits) pointer
 396 [
 397   FunctionPointer to: fun
 398 ].
 399
 400 _@(FunctionPointer traits) from: argumentTypes to: resultType
 401 [
 402   (Function from: argumentTypes to: resultType) pointer
 403 ].
 404
 405 define: #Module &basedOn: Type.
 406