SlangStructType.class.st

Class {
	#name : #SlangStructType,
	#superclass : #SlangClass,
	#classVars : [
		'StructTypeNameCache'
	],
	#category : #'Slang-Types'
}

{ #category : #accessing }
SlangStructType class >> baseStructClass [
	"The base class of the hierarchy of structs.
	All state and behavior of this class will not be included for generation.
	
	Redefine if you have a your own abstract struct superclass"

	^ SlangStructType
]

{ #category : #translation }
SlangStructType class >> filteredInstVarNames [

	^ self allInstVarNames
]

{ #category : #translation }
SlangStructType class >> isAccessor: aSelector [
	"Answer if aSelector is simply an accessor method for one of our fields."
	^(self instVarIndexFor: (aSelector copyWithout: $:) ifAbsent: [0]) > 0
]

{ #category : #translation }
SlangStructType class >> isStructClass [
	^true
]

{ #category : #translation }
SlangStructType class >> isTypePointerToStruct: type [
	| index |
	StructTypeNameCache ifNil:
		[StructTypeNameCache := Set new.
		 self allSubclassesDo:
			[:sc| StructTypeNameCache add: sc name; add: sc structTypeName ]].
	^type notNil
	  and: [(index := type indexOf: $*) > 0
	  and: [StructTypeNameCache anySatisfy:
			[:structType|
			(type beginsWith: structType)
			and: [index > structType size]]]]
]

{ #category : #translation }
SlangStructType class >> isTypeStruct: type [
	StructTypeNameCache ifNil:
		[StructTypeNameCache := Set new.
		 self allSubclassesDo:
			[:sc| StructTypeNameCache add: sc name; add: sc structTypeName]].
	^type notNil
	  and: [StructTypeNameCache anySatisfy:
			[:structType|
			type = structType]]
]

{ #category : #translation }
SlangStructType class >> needsTypeTag [
	self instVarTypeDeclarationsDo:
		[:ivn :type|
		((type isArray ifTrue: [type] ifFalse: [{type}]) anySatisfy:
			[:str|
			str isString
			and: [str includesSubstring: self structTagName]]) ifTrue:
				[^true]].
	^false

	"VMStructType allSubclasses select: [:sc| sc needsTypeTag]"
]

{ #category : #translation }
SlangStructType class >> printTypedefOn: aStream [

	aStream nextPutAll: 'typedef struct '.
	self needsTypeTag ifTrue: [
		aStream
			nextPutAll: self structTagName;
			space ].
	aStream
		nextPut: ${;
		cr.
	self instVarTypeDeclarationsDo: [ :ivn :typeArg |
		| type |
		ivn first == $#
			ifTrue: [ aStream nextPutAll: ivn ]
			ifFalse: [
				type := typeArg.
				#( BytesPerWord BaseHeaderSize BytesPerOop ) do: [ :sizeConstant |
					| index sizeConstantSize |
					(type notNil and: [
						 (index := type indexOf: sizeConstant ifAbsent: 0) > 0 ])
						ifTrue: [
							sizeConstantSize := self constantClass classPool at:
								                    sizeConstant.
							type := (type at: index + 1) = sizeConstantSize ifTrue: [
								        type := type
									                copyReplaceFrom: index
									                to: index + 1
									                with: #(  ).
								        type size = 1
									        ifTrue: [ type first ]
									        ifFalse: [ type ] ] ] ].
				type ifNotNil: [
					type isArray
						ifTrue: [
							aStream tab: 1.
							aStream nextPutAll: type first.
							(type first last isSeparator or: [ type first last = $* ])
								ifFalse: [ aStream tab: 2 ].
							aStream nextPutAll: ivn.
							type last first isSeparator ifFalse: [ aStream space ].
							aStream nextPutAll: type last ]
						ifFalse: [
							aStream tab: 1.
							aStream nextPutAll: type.
							(type last isSeparator or: [ type last = $* ]) ifFalse: [
								aStream tab: 1 ].
							aStream nextPutAll: ivn ] ].
				aStream nextPut: $; ].
		aStream cr ].
	aStream
		nextPutAll: ' } ';
		nextPutAll: self structTypeName;
		nextPut: $;;
		cr.
	self name ~= self structTypeName ifTrue: [
		(self withAllSuperclasses copyUpThrough:
			 (self class whichClassIncludesSelector: #structTypeName)
				 instanceSide) do: [ :structClass |
			aStream
				cr;
				nextPutAll: '#define ';
				nextPutAll: structClass name;
				space;
				nextPutAll: self structTypeName ].
		aStream cr ].
	aStream flush
]

{ #category : #translation }
SlangStructType class >> returnTypeForAccessor: aSelector [
	| varName deStructTag |
	varName := aSelector copyWithout: $:.
	deStructTag := [:decl| decl copyReplaceAll: 'struct ', self structTagName with: self structTypeName].
	self instVarTypeDeclarationsDo:
		[:var :typeSpec|
		var = varName ifTrue:
			[^typeSpec isArray
				ifTrue: [(deStructTag value: typeSpec first), ' ', typeSpec last]
				ifFalse: [deStructTag value: typeSpec]]].
	^nil


	"InterpreterStackPage returnTypeForAccessor: #nextPage:"
]

{ #category : #translation }
SlangStructType class >> structTagName [
	^'_', self structTypeName
]

{ #category : #translation }
SlangStructType class >> structTargetKindForDeclaration: decl [
	StructTypeNameCache ifNil:
		[StructTypeNameCache := Set new.
		 self allSubclassesDo:
			[:sc| StructTypeNameCache add: sc name; add: sc structTypeName ]].
	^(decl notNil
	   and: [(StructTypeNameCache includes: decl)
			or: [StructTypeNameCache anySatisfy:
					[:structType|
					(decl beginsWith: structType)
					and: [(decl indexOf: $* ifAbsent: [decl indexOf: Character space]) > structType size]]]]) ifTrue:
		[(decl indexOf: $*) > 0
			ifTrue: [#pointer]
			ifFalse: [#struct]]
]

{ #category : #translation }
SlangStructType class >> structTargetKindForType: type [
	StructTypeNameCache ifNil:
		[StructTypeNameCache := Set new.
		 self allSubclassesDo:
			[:sc| StructTypeNameCache add: sc name; add: sc structTypeName ]].
	^(type notNil
	   and: [StructTypeNameCache anySatisfy:
			[:structType|
			(type beginsWith: structType)
			and: [type size = structType size
				or: [(type at: structType size + 1) isAlphaNumeric not]]]]) ifTrue:
		[(type includes: $*)
			ifTrue: [#pointer]
			ifFalse: [#struct]]
]

{ #category : #translation }
SlangStructType class >> structTypeName [
	"Provide the typedef name.  Subclases can override."
	^self name
]

{ #category : #translation }
SlangStructType class >> typeForSelf [
	"Answer the type to give self if appropriate, or nil if not."
	^self structTypeName, ' *'
]

{ #category : #translation }
SlangStructType class >> voidStructTypeCache [
	StructTypeNameCache := nil
]

{ #category : #macros }
SlangStructType >> setField: fieldName to: fieldValue [

	| slot |
	slot := self class slotNamed: fieldName.
	slot write: fieldValue to: self
]

{ #category : #macros }
SlangStructType >> withFieldsDo: forEachBlock separatedBy: separatorBlock [ 

	self class allSlots 
		do: [ :aSlot | forEachBlock value: aSlot name value: (aSlot read: self) ] 
		separatedBy: separatorBlock 
]

{ #category : #macros }
SlangStructType >> withStructNameDo: aFullBlockClosure [ 
	
	^ aFullBlockClosure value: self class structTypeName
]