VMClass.class.st

"
I am an abstract superclass for all classes in the VM that want to maintain a source timeStamp.  I am also the holder of the InitializationOptions class variable which holds options such as which JIT or which memory manager to use when creating or generating a VM.
"
Class {
	#name : #VMClass,
	#superclass : #SlangClass,
	#instVars : [
		'memoryManager'
	],
	#classVars : [
		'DefaultBase',
		'InitializationOptions'
	],
	#pools : [
		'VMBasicConstants',
		'VMObjectIndices'
	],
	#classInstVars : [
		'timeStamp'
	],
	#category : #Melchor
}

{ #category : #translation }
VMClass class >> apiExportHeaderName [
	"VM classesd that want to generate an api export header override this."
	^nil
]

{ #category : #'adding/removing methods' }
VMClass class >> basicRemoveSelector: aSelector [
	"Override to update the timeStamp"
	^(super basicRemoveSelector: aSelector) ifNotNil:
		[:oldMethod| self touch. oldMethod]
]

{ #category : #accessing }
VMClass class >> bytesPerOop [
	
	^ BytesPerOop
]

{ #category : #accessing }
VMClass class >> bytesPerOop: anInteger [

	BytesPerOop := anInteger
]

{ #category : #accessing }
VMClass class >> bytesPerWord [
	
	^ BytesPerWord 
]

{ #category : #accessing }
VMClass class >> bytesPerWord: anInteger [ 

	^ BytesPerWord := anInteger
]

{ #category : #'accessing class hierarchy' }
VMClass class >> cogitClass [
	"Answer the cogitClass in effect.  Ensure that StackInterpreter has a nil cogitClass."
	(self isInterpreterClass and: [self hasCogit not]) ifTrue:
		[^nil].
	^Smalltalk classNamed: (InitializationOptions
								at: #Cogit
								ifAbsent: [#StackToRegisterMappingCogit])
]

{ #category : #'accessing class hierarchy' }
VMClass class >> constantClass [

	^ VMBasicConstants
]

{ #category : #'accessing class hierarchy' }
VMClass class >> coreInterpreterClass [
	"While the interpreterClass/vmClass for translation may be
	 a subclass that holds a few primitives we want the actual
	 interpreter name at the head of the generated file."
	^((name endsWith: 'Primitives')
	   and: [name beginsWith: superclass name])
		ifTrue: [superclass]
		ifFalse: [self]
]

{ #category : #translation }
VMClass class >> declareC: arrayOfVariableNames as: aCType in: aCCodeGenerator [
	"Declare the variables in arrayOfVariableNames with the given type."

	arrayOfVariableNames
		do: [:varName | aCCodeGenerator var: varName type: aCType]
]

{ #category : #translation }
VMClass class >> declareCAsOop: arrayOfVariableNames in: aCCodeGenerator [
	"Declare the variables in arrayOfVariableNames with type representing position in object memory."

	arrayOfVariableNames do:
		[:varName| aCCodeGenerator var: varName type: #usqInt]
]

{ #category : #translation }
VMClass class >> declareCAsUSqLong: arrayOfVariableNames in: aCCodeGenerator [
	"Declare the variables in arrayOfVariableNames with type representing position in object memory."

	arrayOfVariableNames do:
		[:varName| aCCodeGenerator var: varName type: #usqLong]
]

{ #category : #translation }
VMClass class >> declareCVarsIn: aCCodeGenerator [ 
	"Declare any additional variables and/or add type declarations for existing variables."
	aCCodeGenerator
		var: #expensiveAsserts
		declareC: 'char expensiveAsserts = 0'
]

{ #category : #translation }
VMClass class >> declareInterpreterVersionIn: aCCodeGenerator defaultName: defaultName [	
	aCCodeGenerator
		var: #interpreterVersion
		declareC: 'const char *interpreterVersion = "Croquet Closure ', defaultName, ' VM [',
					(aCCodeGenerator shortMonticelloDescriptionForClass: self),']"'.
]

{ #category : #'accessing class hierarchy' }
VMClass class >> hasCogit [
	^false
]

{ #category : #translation }
VMClass class >> implicitReturnTypeFor: aSelector [
	"Answer the return type for methods that don't have an explicit return."
	^#sqInt
]

{ #category : #initialization }
VMClass class >> initializationOptions [
	^InitializationOptions
]

{ #category : #initialization }
VMClass class >> initialize [
	InitializationOptions ifNil: [InitializationOptions := Dictionary new].
	ExpensiveAsserts := false
]

{ #category : #initialization }
VMClass class >> initializePrimitiveErrorCodes [
	"Define the VM's primitive error codes.  N.B. these are
	 replicated in platforms/Cross/vm/sqVirtualMachine.h."
	"VMClass initializePrimitiveErrorCodes"
	| pet |
	PrimErrTableIndex := 51. "Zero-relative"
	"See SmalltalkImage>>recreateSpecialObjectsArray for the table definition.
	 If the table exists and is large enough the corresponding entry is returned as
	 the primitive error, otherwise the error is answered numerically."
	pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()].
	pet isArray ifFalse: [pet := #()].
	PrimNoErr := 0. "for helper methods that need to answer success or an error code."
	PrimErrGenericFailure		:= pet indexOf: nil ifAbsent: 1.
	PrimErrBadReceiver			:= pet indexOf: #'bad receiver' ifAbsent: 2.
	PrimErrBadArgument		:= pet indexOf: #'bad argument' ifAbsent: 3.
	PrimErrBadIndex			:= pet indexOf: #'bad index' ifAbsent: 4.
	PrimErrBadNumArgs		:= pet indexOf: #'bad number of arguments' ifAbsent: 5.
	PrimErrInappropriate		:= pet indexOf: #'inappropriate operation' ifAbsent: 6.
	PrimErrUnsupported		:= pet indexOf: #'unsupported operation' ifAbsent: 7.
	PrimErrNoModification		:= pet indexOf: #'no modification' ifAbsent: 8.
	PrimErrNoMemory			:= pet indexOf: #'insufficient object memory' ifAbsent: 9.
	PrimErrNoCMemory			:= pet indexOf: #'insufficient C memory' ifAbsent: 10.
	PrimErrNotFound			:= pet indexOf: #'not found' ifAbsent: 11.
	PrimErrBadMethod			:= pet indexOf: #'bad method' ifAbsent: 12.
	PrimErrNamedInternal		:= pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13.
	PrimErrObjectMayMove		:= pet indexOf: #'object may move' ifAbsent: 14.
	PrimErrLimitExceeded		:= pet indexOf: #'resource limit exceeded' ifAbsent: 15.
	PrimErrObjectIsPinned		:= pet indexOf: #'object is pinned' ifAbsent: 16.
	PrimErrWritePastObject		:= pet indexOf: #'primitive write beyond end of object' ifAbsent: 17.
	PrimErrObjectMoved		:= pet indexOf: #'object moved' ifAbsent: 18.
	PrimErrObjectNotPinned	:= pet indexOf: #'object not pinned' ifAbsent: 19.
	PrimErrCallbackError		:= pet indexOf: #'error in callback' ifAbsent: 20.
	PrimErrOSError				:= pet indexOf: #'operating system error' ifAbsent: 21.
	PrimErrFFIException		:= pet indexOf: #'ffi call exception' ifAbsent: 22.
	PrimErrNeedCompaction	:= pet indexOf: #'heap compaction needed' ifAbsent: 23. "N.B. This is currently an internal error in Spur image segment saving."
	PrimErrOperationFailed		:= pet indexOf: #'operation failed' ifAbsent: 24
]

{ #category : #initialization }
VMClass class >> initializeWithOptions: optionsDictionaryOrArray [
	"Initialize the receiver, typically initializing class variables. Initialize any class variables
	 whose names occur in optionsDictionary with the corresponding values there-in."
	InitializationOptions := optionsDictionaryOrArray isArray
								ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray]
								ifFalse: [optionsDictionaryOrArray].

	ExpensiveAsserts := InitializationOptions at: #ExpensiveAsserts ifAbsent: [false]
]

{ #category : #'accessing class hierarchy' }
VMClass class >> interpreterClass [
	^self isInterpreterClass ifTrue: [self]
]

{ #category : #accessing }
VMClass class >> interpreterVersion [ 
	^ self subclassResponsibility
]

{ #category : #translation }
VMClass class >> isAcceptableAncilliaryClass: aClass [
	^true
]

{ #category : #translation }
VMClass class >> isAccessor: aSelector [
	"Answer if aSelector is simply an accessor method for one of our fields.
	 Answer false by default.  VMStructType classes redefine this appropriately."
	^false
]

{ #category : #translation }
VMClass class >> isCogitClass [
	"The various Cogit classes override this."
	^false
]

{ #category : #translation }
VMClass class >> isInterpreterClass [
	"The various Interpreter classes override this."
	^false
]

{ #category : #translation }
VMClass class >> isNonArgumentImplicitReceiverVariableName: aString [
	^false
]

{ #category : #translation }
VMClass class >> isPluginClass [
	"InterpreterPlugin class override this."
	^false
]

{ #category : #translation }
VMClass class >> isSpurMemoryManagerClass [

	^ false
]

{ #category : #accessing }
VMClass class >> memoryManagerVersion [ 
	^ self subclassResponsibility
]

{ #category : #translation }
VMClass class >> monticelloDescription [
	"Answer the Monticello version of the packlage containing the receiver.
	 This is a hook to allow subclasses to expand upon the default monticello description."
	^CCodeGenerator monticelloDescriptionFor: self
]

{ #category : #translation }
VMClass class >> mustBeGlobal: var [
	"Answer if a variable must be global and exported.  Used for inst vars that are accessed from VM support code."

	^var = #expensiveAsserts
]

{ #category : #translation }
VMClass class >> noteCompilationOf: aSelector meta: isMeta [
	"note the recompiliation by resetting the timeStamp "
	timeStamp := Time totalSeconds.
	^super noteCompilationOf: aSelector meta: isMeta
]

{ #category : #'accessing class hierarchy' }
VMClass class >> objectMemoryClass [

	^Smalltalk at: (InitializationOptions
					at: #ObjectMemory
					ifAbsent: [ #Spur32BitMemoryManager ])
]

{ #category : #'accessing class hierarchy' }
VMClass class >> objectRepresentationClass [
	^self objectMemoryClass objectRepresentationClass
]

{ #category : #translation }
VMClass class >> shouldGenerateTypedefFor: aStructClass [
	"Hack to work-around multiple definitions.  Sometimes a type has been defined in an include."
	^aStructClass shouldBeGenerated
]

{ #category : #translation }
VMClass class >> shouldIncludeMethodForSelector: selector [
	"Answer whether a primitive method should be translated.  Emit a warning to the transcript if the method doesn't exist."
	^(self whichClassIncludesSelector: selector)
		ifNotNil:
			[:c|
			 (c >> selector pragmaAt: #option:)
				ifNotNil:
					[:pragma|
					(self constantClass defineAtCompileTime: pragma arguments first)
					 or: [InitializationOptions
							at: pragma arguments first
							ifAbsent: [(self bindingOf: pragma arguments first)
										ifNil: [false]
										ifNotNil: [:binding| binding value ~~ #undefined]]]]
				ifNil: [true]]
		ifNil:
			[Transcript nextPutAll: 'Cannot find implementation of '; nextPutAll: selector; nextPutAll: ' in hierarchy of '; print: self; newLine; flush.
			 false]
]

{ #category : #simulation }
VMClass class >> simulatorClass [
	"For running from Smalltalk - answer a class that can be used to simulate the receiver."

	^self
]

{ #category : #translation }
VMClass class >> specialValueForConstant: constantName default: defaultValue [
	^nil
]

{ #category : #translation }
VMClass class >> staticallyResolvePolymorphicSelector: aSelectorSymbol [
	^((self name select: [:ea| ea isUppercase]), '_', aSelectorSymbol) asSymbol
]

{ #category : #translation }
VMClass class >> timeStamp [
	^timeStamp ifNil:[0]
]

{ #category : #translation }
VMClass class >> touch [
	"Reset the timeStamp"
	"Smalltalk allClasses select:
		[:c| (c category includesSubString: 'VMMaker-JIT') ifTrue: [c touch]]"
	"InterpreterPlugin withAllSubclassesDo:[:pl| pl touch]"
	timeStamp := Time totalSeconds
]

{ #category : #translation }
VMClass class >> translationClass [
	"Return the class to use as the interpreterCLass when translating.  For the all-in-one
	 VMs that inherit from ObjectMemory this is the receiver.  But for the separate VMs
	 where most primitives are in a subclass it will be the subclass with the primitives."
	^self
]

{ #category : #translation }
VMClass class >> writeVMHeaderTo: aStream bytesPerWord: bytesPerWord generator: aCCodeGenerator [
	"Generate the contents of interp.h on aStream.  Specific Interpreter subclasses
	 override to add more stuff."
	aCCodeGenerator
		putDefineOf: 'VM_PROXY_MAJOR' as: self vmProxyMajorVersion on: aStream;
		putDefineOf: 'VM_PROXY_MINOR' as: self vmProxyMinorVersion on: aStream.
	aStream newLine.
	aCCodeGenerator
		putDefineOf: 'SQ_VI_BYTES_PER_WORD' as: bytesPerWord on: aStream.
	aStream newLine.

	"The most basic constants must be defined here, not in e.g. the plugin sources, to allow those
	 other sources to be shared between different builds (Spur vs SqueakV3, 32-bit vs 64-bit, etc)"
	self constantClass mostBasicConstantNames asSet sorted do:
		[:constName|
		(self constantClass classPool at: constName ifAbsent: []) ifNotNil:
			[:const| aCCodeGenerator putDefineOf: constName as: const on: aStream]].
	aStream newLine.

	((self constantClass classPool associations select: [:a| a key beginsWith: 'PrimErr'])
		sorted: [:a1 :a2| a1 value <= a2 value])
		do: [:a| aCCodeGenerator putDefineOf: a key as: a value on: aStream].
	aStream newLine.

	aCCodeGenerator
		putDefineOf: 'MinSmallInteger' as: self objectMemoryClass minSmallInteger on: aStream;
		putDefineOf: 'MaxSmallInteger' as: self objectMemoryClass maxSmallInteger on: aStream;
		putDefineOf: 'NumSmallIntegerTagBits' as: self objectMemoryClass numSmallIntegerTagBits on: aStream.
	aStream newLine
]

{ #category : #'translation support' }
VMClass >> addressOf: anObject [
	<doNotGenerate>
	"Translates into &anObject in C."
	^anObject
]

{ #category : #'translation support' }
VMClass >> addressOf: anObject put: aBlock [
	<doNotGenerate>
	"Simulate a C pointer.  Translates into &anObject in C. Provides something
	 that evaluates aBlock with the new value in response to at:put:"
	| thing |
	thing := anObject.
	^CPluggableAccessor new
		setObject: nil;
		atBlock: [:obj :idx| thing]
		atPutBlock: [:obj :idx :val| aBlock value: (thing := val)]
]

{ #category : #'C library simulation' }
VMClass >> alloca: desiredSize [
	"Simulation of alloca(3)"
	<doNotGenerate>
	| address |
	address := 0 "Does not really matter for now".
	^ CNewArrayAccessor new
		setObject: (SlangMemoryRegion new
			start: address;
			memory: (ByteArray new: desiredSize);
			originallyRequestedMemory: desiredSize;
			yourself);
		address: address;
		yourself
]

{ #category : #'C library extensions' }
VMClass >> alloca: numElements type: elementType [
	<cmacro: '(numElements, elementType) alloca((numElements)*sizeof(elementType))'>
	^CArrayAccessor on: ((1 to: numElements) collect: [:ign| elementType new])
]

{ #category : #'C library extensions' }
VMClass >> asString: aStringOrStringIndex [
	"aStringOrStringIndex is either a string or an address in the heap.
	 Create a String of the requested length form the bytes in the
	 heap starting at stringIndex."
	<doNotGenerate>
	| sz |
	aStringOrStringIndex isString ifTrue:
		[^aStringOrStringIndex].
	sz := self strlen: aStringOrStringIndex.
	^self strncpy: (ByteString new: sz) _: aStringOrStringIndex _: sz
]

{ #category : #'debug support' }
VMClass >> assert: aBooleanExpression l: linenum [
	<doNotGenerate>
	^self assert: aBooleanExpression
]

{ #category : #'debug support' }
VMClass >> asserta: aBooleanExpression [
	<doNotGenerate>
	| result |
	(result := aBooleanExpression value) ifFalse:
		[AssertionFailure signal: 'Assertion failed'].
	^result
]

{ #category : #'debug support' }
VMClass >> asserta: aBooleanExpression l: linenum [
	<doNotGenerate>
	^self asserta: aBooleanExpression
]

{ #category : #'memory access' }
VMClass >> cCoerce: value to: cTypeString [
	"Type coercion. For translation a cast will be emmitted. When running in Smalltalk
	  answer a suitable wrapper for correct indexing."
	<doNotGenerate>
	^value
		ifNil: [value]
		ifNotNil: [value coerceTo: cTypeString sim: self]
]

{ #category : #'translation support' }
VMClass >> cCoerceSimple: value to: cTypeString [
	<doNotGenerate>
	"Type coercion for translation and simulation.
	 For simulation answer a suitable surrogate for the struct types"
	^cTypeString caseOf:
	   {	[#'unsigned long']							->	[value].
		[#'unsigned int']							->	[value].
		[#'unsigned short']							->	[value].
		[#sqInt]									->	[value].
		[#'sqIntptr_t']								->	[value].
		[#'usqIntptr_t']								->	[value].
		[#usqInt]									->	[value].
		[#sqLong]									->	[value].
		[#usqLong]								->	[value].
		[#'AbstractInstruction *']					->	[value].
		[#'SpurSegmentInfo *']						->	[value].
		[#'BytecodeFixup *']						->	[value].
		[#'CogMethod *']							->	[value].
		[#'char *']									->	[value].
		[#'sqInt *']									->	[value].
		[#'void *']									->	[value].
		[#void]										->	[value].
		[#'void (*)()']								->	[value].
		[#'void (*)(void)']							->	[value].
		[#'unsigned long (*)(void)']					->	[value].
		[#'void (*)(unsigned long,unsigned long)']	->	[value].
		[#'usqIntptr_t (*)(void)']					->	[value] }
]

{ #category : #'C library simulation' }
VMClass >> calloc: num _: size [ 

	<doNotGenerate>
	^ self malloc: num * size
]

{ #category : #'translation support' }
VMClass >> contentsOf: valueHolder [

	<cmacro: '(value) value'>

	^ valueHolder contents
]

{ #category : #'translation support' }
VMClass >> cppIf: conditionBlockOrValue ifTrue: trueExpressionOrBlock [
	"When translated, produces #if (condition) #else #endif CPP directives.
	 Example usage:

		self cppIf: IMMUTABILITY
			ifTrue: [(self internalIsImmutable: obj) ifTrue:
						[^self primitiveFailFor: PrimErrNoModification]]"
	<doNotGenerate>
	^self cppIf: conditionBlockOrValue ifTrue: trueExpressionOrBlock ifFalse: nil
]

{ #category : #'C pre-processor extensions' }
VMClass >> defined: aSymbol [
	"Simulated version of the C pre-processor defined()"
	<doNotGenerate>
	^(self class bindingOf: aSymbol)
		ifNil: [false]
		ifNotNil: [:binding| binding value ~~ #undefined]
]

{ #category : #'memory access' }
VMClass >> fetchSingleFloatAtPointer: pointer into: aFloat [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and aFloat is a 32-bit single precision float."
	<doNotGenerate>

	^self fetchSingleFloatAt: pointer into: aFloat
]

{ #category : #'file primitives' }
VMClass >> fgetc: file [ 

	<doNotGenerate>
	^ file next
]

{ #category : #'memory access' }
VMClass >> floatAtPointer: pointer [

	<doNotGenerate>
	self notYetImplemented 
]

{ #category : #'memory access' }
VMClass >> floatAtPointer: pointer put: value [

	<doNotGenerate>
	self notYetImplemented
]

{ #category : #'file primitives' }
VMClass >> fprintf: aStream _: format [ 

	<doNotGenerate>
	^ self fprintf: aStream format: format arguments: { }
]

{ #category : #'file primitives' }
VMClass >> fprintf: aStream _: format _: aValue [ 

	<doNotGenerate>
	^ self fprintf: aStream format: format arguments: { aValue }
]

{ #category : #'file primitives' }
VMClass >> fprintf: aStream _: format _: aValue _: otherValue [

	<doNotGenerate>
	^ self fprintf: aStream format: format arguments: { aValue. otherValue }
]

{ #category : #'file primitives' }
VMClass >> fprintf: aStream format: aFormat arguments: arguments [

	<doNotGenerate>
	| printf |
	printf := PrintfFormatString new setFormat: aFormat.
	
	(ZnNewLineWriterStream on: aStream)	
		nextPutAll: (printf
			 printf: arguments;
			 string);
		flush
]

{ #category : #'C library simulation' }
VMClass >> free: pointer [
	<doNotGenerate>
	"Do nothing"
]

{ #category : #'memory access' }
VMClass >> int16AtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 16 bit integer."
	<doNotGenerate>

	^self shortAt: pointer
]

{ #category : #'memory access' }
VMClass >> int16AtPointer: pointer put: value [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 16 bit integer."
	<doNotGenerate>

	^self shortAt: pointer put: value
]

{ #category : #'memory access' }
VMClass >> int32AtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 32 bit integer."
	<doNotGenerate>

	^self longAt: pointer
]

{ #category : #'memory access' }
VMClass >> int32AtPointer: pointer put: value [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 32 bit integer."
	<doNotGenerate>

	^self longAt: pointer put: value
]

{ #category : #'memory access' }
VMClass >> int64AtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is the width of a machine word."
	<doNotGenerate>

	^ memoryManager long64At: pointer
]

{ #category : #'memory access' }
VMClass >> int64AtPointer: pointer put: longValue [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and longValue is the width of a machine word."
	<doNotGenerate>

	^ memoryManager long64At: pointer put: longValue
]

{ #category : #'memory access' }
VMClass >> int8AtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 16 bit integer."
	<doNotGenerate>

	^self at: pointer
]

{ #category : #'memory access' }
VMClass >> int8AtPointer: pointer put: value [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 16 bit integer."
	<doNotGenerate>

	^self at: pointer put: value
]

{ #category : #'plugin support' }
VMClass >> isInterpreterProxy [
	<doNotGenerate>
	"Return false since I am a real Interpreter simulation"
	^false
]

{ #category : #'hack compatibility' }
VMClass >> localNameFor: aString [
	<doNotGenerate>
	^ aString asFileReference basename
]

{ #category : #logging }
VMClass >> logDebug: aFormat _: aParameter [

	<doNotGenerate>

	(aFormat printf: { aParameter }) traceCr
]

{ #category : #'debug support' }
VMClass >> logError: aMessage [
	
	<doNotGenerate>
	self logError: aMessage withArgs: #()
]

{ #category : #'debug support' }
VMClass >> logError: aFormat _: arg1 [
	
	<doNotGenerate>
	self logError: aFormat withArgs: { arg1 }
]

{ #category : #'debug support' }
VMClass >> logError: aFormat _: arg1 _: arg2 [
	
	<doNotGenerate>
	self logError: aFormat withArgs: { arg1. arg2 }
]

{ #category : #'debug support' }
VMClass >> logError: aFormat withArgs: args [
	
	<doNotGenerate>
	Error signal: (aFormat printf: args)
]

{ #category : #'debug support' }
VMClass >> logWarn: aMessage [
	
	<doNotGenerate>
	self logWarn: aMessage withArgs: #()
]

{ #category : #'debug support' }
VMClass >> logWarn: aMessage _: anArgument [
	
	<doNotGenerate>
	self logWarn: aMessage withArgs: { anArgument }
]

{ #category : #'debug support' }
VMClass >> logWarn: aFormat withArgs: args [
	
	<doNotGenerate>
	(aFormat printf: args) traceCr
]

{ #category : #'memory access' }
VMClass >> long64AtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is the width of a machine word."
	<doNotGenerate>

	^self halt
]

{ #category : #'memory access' }
VMClass >> long64AtPointer: pointer put: longValue [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and longValue is the width of a machine word."
	<doNotGenerate>

	^self halt.
]

{ #category : #'memory access' }
VMClass >> longAtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is the width of a machine word."
	<doNotGenerate>

	^self longAt: pointer
]

{ #category : #'memory access' }
VMClass >> longAtPointer: pointer put: longValue [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and longValue is the width of a machine word."
	<doNotGenerate>

	^self longAt: pointer put: longValue
]

{ #category : #'simulation support' }
VMClass >> majorVersion [
	"This is implemented in sqVirtualMachine.c, so this form is for simulation only."
	<doNotGenerate>
	^self class vmProxyMajorVersion
]

{ #category : #'C library simulation' }
VMClass >> malloc: size [
	<doNotGenerate>
	| address region |
	
	size = 0 ifTrue: [ ^ nil ].
	
	address := memoryManager allocate: size.
	region := memoryManager regionAtAddress: address.
	^ CNewArrayAccessor new
		setObject: region;
		address: address;
		yourself
]

{ #category : #'C library simulation' }
VMClass >> memcpy: dest _: src _: bytes [
	<doNotGenerate>
	"implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
	| getBlock setBlock source destination |

	source := src isVMSimulationAddress
		ifTrue: [src asInteger]
		ifFalse: [src].
	destination := dest isVMSimulationAddress
		ifTrue: [dest asInteger]
		ifFalse: [dest].
	(source isInteger and: [destination isInteger]) ifTrue:
		[ self deny: ((destination <= source and: [destination + bytes > source])
					or: [source <= destination and: [source + bytes > destination]])].

	"Determine the source and destination access blocks based on the parameter type"
	getBlock := source isCollection ifTrue: 
		[source isString ifTrue: 
			"basicAt: answers integers"
			[[ :idx | source basicAt: idx]]
		ifFalse: 
			[source class == ByteArray ifTrue: 
				[[ :idx | source at: idx]]]]
	ifFalse: 
		[source isInteger ifTrue: 
			[[ :idx | self byteAt: source + idx - 1]]
		ifFalse: 
			[source isCArray ifTrue:
				[[ :idx | source at: idx - 1]]]].
	getBlock ifNil: [self error: 'unhandled type of source string'].
	setBlock := destination isCollection ifTrue: 
		[destination isString ifTrue:
			"basicAt:put: stores integers"
			[[ :idx | destination basicAt: idx put: (getBlock value: idx)]] 
		ifFalse: 
			[destination class == ByteArray ifTrue: 
				[[ :idx | destination at: idx put: (getBlock value: idx)]]]]
	ifFalse: 
		[destination isInteger ifTrue:
			[[ :idx | self byteAt: destination + idx - 1 put: (getBlock value: idx)]]
		ifFalse:
			[destination isCArray ifTrue:
				[[ :idx | destination at: idx - 1 put: (getBlock value: idx)]]]].
	setBlock ifNil: [self error: 'unhandled type of destination string'].
	1 to: bytes do: setBlock.

	^destination
]

{ #category : #'C library simulation' }
VMClass >> memmove: destAddress _: sourceAddress _: bytes [
	<doNotGenerate>
	| dst src  |
	dst := destAddress asInteger.
	src := sourceAddress asInteger.
	"Emulate the c library memmove function"
	self assert: bytes \\ 4 = 0.
	destAddress > sourceAddress
		ifTrue:
			[bytes - 4 to: 0 by: -4 do:
				[:i| self longAt: dst + i put: (self longAt: src + i)]]
		ifFalse:
			[0 to: bytes - 4 by: 4 do:
				[:i| self longAt: dst + i put: (self longAt: src + i)]]
]

{ #category : #accessing }
VMClass >> memoryManager [
	<doNotGenerate>
	^ memoryManager
]

{ #category : #accessing }
VMClass >> memoryManager: aMemoryManager [
	<doNotGenerate>
	memoryManager := aMemoryManager
]

{ #category : #'simulation support' }
VMClass >> minorVersion [
	"This is implemented in sqVirtualMachine.c, so this form is for simulation only."
	<doNotGenerate>
	^self class vmProxyMinorVersion
]

{ #category : #'translation support' }
VMClass >> notYetImplemented [

	<inline: true>
	self notYetImplemented: 'Not Yet Implemented!'
]

{ #category : #'translation support' }
VMClass >> notYetImplemented: aMessage [

	<inline: true>

	self
		cCode: [ 
			self logError: aMessage.
			self abort ]
		inSmalltalk: [ super notYetImplemented ]
]

{ #category : #accessing }
VMClass >> objectRepresentationClass [
	<doNotGenerate>
	^self class objectRepresentationClass
]

{ #category : #'oop comparison' }
VMClass >> oop: anOop isGreaterThan: otherOop [
	"Compare two oop values, treating them as object memory locations; i.e. use unsigned comparisons.
	 Use a macro, instead of #cCoerce:to: to provide fast simulation and inline code in conditionals,
	 since the inliner doesn't inline in condtionals."
	<cmacro: '(anOop,otherOop) ((usqInt)(anOop) > (usqInt)(otherOop))'>
	^anOop > otherOop
]

{ #category : #'oop comparison' }
VMClass >> oop: anOop isGreaterThan: baseOop andLessThan: limitOop [
	"Compare two oop values, treating them as object memory locations; i.e. use unsigned comparisons.
	 Use a macro, instead of #cCoerce:to: to provide fast simulation and inline code in conditionals,
	 since the inliner doesn't inline in condtionals."
	<cmacro: '(anOop,baseOop,limitOop) ((usqInt)(anOop) > (usqInt)(baseOop) && (usqInt)(anOop) < (usqInt)(limitOop))'>
	^anOop > baseOop and: [anOop < limitOop]
]

{ #category : #'oop comparison' }
VMClass >> oop: anOop isGreaterThanOrEqualTo: otherOop [
	"Compare two oop values, treating them as object memory locations; i.e. use unsigned comparisons.
	 Use a macro, instead of #cCoerce:to: to provide fast simulation and inline code in conditionals,
	 since the inliner doesn't inline in condtionals."
	<cmacro: '(anOop,otherOop) ((usqInt)(anOop) >= (usqInt)(otherOop))'>
	^anOop >= otherOop
]

{ #category : #'oop comparison' }
VMClass >> oop: anOop isGreaterThanOrEqualTo: baseOop andLessThan: limitOop [
	"Compare two oop values, treating them as object memory locations; i.e. use unsigned comparisons.
	 Use a macro, instead of #cCoerce:to: to provide fast simulation and inline code in conditionals,
	 since the inliner doesn't inline in condtionals."
	<cmacro: '(anOop,baseOop,limitOop) ((usqInt)(anOop) >= (usqInt)(baseOop) && (usqInt)(anOop) < (usqInt)(limitOop))'>
	^anOop >= baseOop and: [anOop < limitOop]
]

{ #category : #'oop comparison' }
VMClass >> oop: anOop isGreaterThanOrEqualTo: baseOop andLessThanOrEqualTo: limitOop [
	"Compare two oop values, treating them as object memory locations; i.e. use unsigned comparisons.
	 Use a macro, instead of #cCoerce:to: to provide fast simulation and inline code in conditionals,
	 since the inliner doesn't inline in condtionals."
	<cmacro: '(anOop,baseOop,limitOop) ((usqInt)(anOop) >= (usqInt)(baseOop) && (usqInt)(anOop) <= (usqInt)(limitOop))'>
	^anOop >= baseOop and: [anOop <= limitOop]
]

{ #category : #'oop comparison' }
VMClass >> oop: anOop isLessThan: otherOop [
	"Compare two oop values, treating them as object memory locations; i.e. use unsigned comparisons.
	 Use a macro, instead of #cCoerce:to: to provide fast simulation and inline code in conditionals,
	 since the inliner doesn't inline in condtionals."
	<cmacro: '(anOop,otherOop) ((usqInt)(anOop) < (usqInt)(otherOop))'>
	^anOop < otherOop
]

{ #category : #'oop comparison' }
VMClass >> oop: anOop isLessThanOrEqualTo: otherOop [
	"Compare two oop values, treating them as object memory locations; i.e. use unsigned comparisons.
	 Use a macro, instead of #cCoerce:to: to provide fast simulation and inline code in conditionals,
	 since the inliner doesn't inline in condtionals."
	<cmacro: '(anOop,otherOop) ((usqInt)(anOop) <= (usqInt)(otherOop))'>
	^anOop <= otherOop
]

{ #category : #'memory access' }
VMClass >> oopForPointer: pointerOrSurrogate [
	"This gets implemented by Macros in C, where its types will also be checked.
	 oop is the width of a machine word, and pointer is a raw address."
	<doNotGenerate>
	^pointerOrSurrogate asInteger
]

{ #category : #'memory access' }
VMClass >> pointerAtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is the width of a machine word."
	<doNotGenerate>

	^self longAt: pointer
]

{ #category : #'memory access' }
VMClass >> pointerAtPointer: pointer put: value [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is the width of a machine word."
	<doNotGenerate>

	^self longAt: pointer put: value
]

{ #category : #'translation support' }
VMClass >> pointerForOop: oop [
	"This gets implemented by Macros in C, where its types will also be checked.
	 oop is the width of a machine word, and pointer is a raw address."
	<doNotGenerate>

	^oop
]

{ #category : #'C library simulation' }
VMClass >> realloc: originalAddress _: desiredSize [

	<doNotGenerate>
	^ memoryManager reallocate: originalAddress withSize: desiredSize
]

{ #category : #arithmetic }
VMClass >> safe: signedInteger mod: positiveModulus [
	<inline>
	| remainder |
	^(remainder := signedInteger \\ positiveModulus) < 0
		ifTrue: [remainder + positiveModulus]
		ifFalse: [remainder]
]

{ #category : #'translation support' }
VMClass >> simulationOnly: aBlock [

	"Evaluate piece of code only during simulation.
	This should get translated as a NOP"
	<inline: #always>
	self
		cCode: [  ]
		inSmalltalk: aBlock
]

{ #category : #'memory access' }
VMClass >> singleFloatAtPointer: pointer [
	<doNotGenerate>
	self halt.
]

{ #category : #'memory access' }
VMClass >> singleFloatAtPointer: pointer put: value [
	<doNotGenerate>
	self halt.
]

{ #category : #'I/O primitive support' }
VMClass >> sqImageFile: imageFile Seek: position [

	<doNotGenerate>
	imageFile position: position
]

{ #category : #'simulation support' }
VMClass >> sqLowLevelMFence [
	<doNotGenerate>
	"A no-op in the simulator"
]

{ #category : #'memory access' }
VMClass >> storeFloatAtPointer: pointer from: aFloat [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and aFloat is a 64-bit double precision float."
	<doNotGenerate>

	^self storeFloatAt: pointer from: aFloat
]

{ #category : #'memory access' }
VMClass >> storeSingleFloatAtPointer: pointer from: aFloat [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and aFloat is a 32-bit single precision float."
	<doNotGenerate>

	^self storeSingleFloatAt: pointer from: aFloat
]

{ #category : #'C library simulation' }
VMClass >> strcat: aString _: bString [
	<doNotGenerate>
	"implementation of strcat(3)"
	^(self asString: aString), (self asString: bString)
]

{ #category : #'C library extensions' }
VMClass >> stretch: s1 cat: s2 [
	<var: 's1' type: #'char *'>
	<var: 's2' type: #'char *'>
	| ns |
	<var: 'ns' type: #'char *'>
	^self
		cCode:
			[ns := self malloc: (self strlen: s1) + (self strlen: s2) + 2.
			 self strcpy: ns _: s1.
			 self strcat: ns  _: s2]
		inSmalltalk: [self strcat: s1  _: s2]
]

{ #category : #'C library simulation' }
VMClass >> strlen: aCString [
	"Simulate strlen(3)"
	<doNotGenerate>
	| len |

	aCString isCArray ifTrue:
		[len := 0.
		 [(aCString at: len) = 0 ifTrue: [^len].
		 len := len + 1] repeat]
	ifFalse:
		[aCString isString ifTrue: 
			[^aCString size]
		ifFalse:
			[aCString class == ByteArray ifTrue: [
				"ByteArrays may be 0 terminated or the correct length (in the simulator)"
				len := 0.
				[(len = aCString size or: [(aCString at: len+1) = 0]) ifTrue: [^len].
				len := len + 1] repeat]]].
	"Must be an address"
	len := 0.
	[(self byteAt: aCString + len) = 0 ifTrue: [^len].
	len := len + 1] repeat
]

{ #category : #'C library simulation' }
VMClass >> strncmp: aString _: bString _: n [
	<doNotGenerate>
	"implementation of strncmp(3)"
	bString isString
		ifTrue:
			[1 to: n do:
				[:i| | v |
				 v := (aString basicAt: i) - (bString basicAt: i).
				 v ~= 0 ifTrue: [^v]]]
		ifFalse:
			[1 to: n do:
				[:i| | v |
				 v := (aString basicAt: i) - (self byteAt: bString + i - 1).
				 v ~= 0 ifTrue: [^v]]].
	^0
]

{ #category : #'C library simulation' }
VMClass >> strncpy: dest _: src _: n [
	<doNotGenerate>
	"implementation of strncpy(3).
	 See e.g. https://manpages.debian.org/stretch/manpages-dev/strncpy.3.en.html
	 The C version always takes an address; the simulation allows a String, ByteArray,
	 CArray or address within the simulation object memory (Positive Integer)"
	| getBlock setBlock count |
	count := n.
	"Determine the source and destination access blocks based on the parameter type"
	getBlock := src isCollection
					ifTrue:
						[count := count min: src size.
						 src isString
							ifTrue: [[ :idx | src basicAt: idx]] "basicAt: answers integers"
							ifFalse:
								[src class == ByteArray ifTrue:
									[[ :idx | src at: idx]]]]
					ifFalse:
						[src isInteger
							ifTrue: [[ :idx | self byteAt: src + idx - 1]]
							ifFalse:
								[src isCArray ifTrue:
									[[ :idx | src at: idx - 1]]]].
	getBlock ifNil: [self error: 'unhandled type of source string'].
	setBlock := dest isCollection
					ifTrue:
						[dest isString
							ifTrue: [[ :idx | dest basicAt: idx put: (getBlock value: idx)]] "basicAt:put: stores integers"
							ifFalse:
								[dest class == ByteArray ifTrue:
									[[ :idx | dest at: idx put: (getBlock value: idx)]]]]
					ifFalse:
						[dest isInteger ifTrue: 
							[[ :idx | self byteAt: dest + idx - 1 put: (getBlock value: idx)]]].
	setBlock ifNil: [self error: 'unhandled type of destination string'].
	1 to: count do: setBlock.
	"SVr4, 4.3BSD, C89, C99 require the remainder of the buffer be filled with nulls"
	getBlock := [:idx| 0].
	count + 1 to: n do: setBlock.
	^dest
]

{ #category : #'memory access' }
VMClass >> uint16AtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 16 bit integer."
	<doNotGenerate>

	^self shortAt: pointer
]

{ #category : #'memory access' }
VMClass >> uint16AtPointer: pointer put: value [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 16 bit integer."
	<doNotGenerate>

	^self shortAt: pointer put: value
]

{ #category : #'memory access' }
VMClass >> uint32AtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 32 bit integer."
	<doNotGenerate>

	^memoryManager readIntegerAt: pointer size: 4 signed: false
]

{ #category : #'memory access' }
VMClass >> uint32AtPointer: pointer put: value [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 32 bit integer."
	<doNotGenerate>

	^memoryManager uint32AtPointer: pointer put: value
]

{ #category : #'memory access' }
VMClass >> uint64AtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is the width of a machine word."

	<doNotGenerate>
	^ memoryManager unsignedLong64At: pointer
]

{ #category : #'memory access' }
VMClass >> uint64AtPointer: pointer put: value [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and longValue is the width of a machine word."
	<doNotGenerate>

	^ memoryManager unsignedLong64At: pointer put: value.

]

{ #category : #'memory access' }
VMClass >> uint8AtPointer: pointer [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 16 bit integer."
	<doNotGenerate>

	^self at: pointer
]

{ #category : #'memory access' }
VMClass >> uint8AtPointer: pointer put: value [
	"This gets implemented by Macros in C, where its types will also be checked.
	 pointer is a raw address, and the result is an 16 bit integer."
	<doNotGenerate>

	^self at: pointer put: value
]

{ #category : #simulation }
VMClass >> unalignedAccessError [
	^self error: 'unaligned access'
]

{ #category : #'debug support' }
VMClass >> unreachable [
	<inline: true>
	self error: 'UNREACHABLE'
]

{ #category : #'memory access' }
VMClass >> unsignedLong32At: anInteger [
	
	<inline: #always>
	^ self uint32AtPointer: anInteger
]

{ #category : #'memory access' }
VMClass >> unsignedLong32At: anInteger put: aValue [
	
	<inline: #always>
	^ self uint32AtPointer: anInteger put: aValue
]

{ #category : #'memory access' }
VMClass >> unsignedLong64At: anInteger [
	
	<inline: #always>
	^ self uint64AtPointer: anInteger
]

{ #category : #'memory access' }
VMClass >> unsignedLong64At: anInteger put: aValue [
	
	<inline: #always>
	^ self uint64AtPointer: anInteger put: aValue
]

{ #category : #'hack compatibility' }
VMClass >> vmPath [
	<doNotGenerate>
	^ (Smalltalk classNamed: #VirtualMachine)
		  ifNotNil: [ :project | "Squeak" Smalltalk vm directory ]
		  ifNil: [ "Pharo" Smalltalk vmPath ]
]

{ #category : #'hack compatibility' }
VMClass >> vmPathSize [
	<doNotGenerate>
	^self vmPath size
]