[Vm-dev] VM Maker: VMMaker-dtl.273.mcz

commits at source.squeak.org commits at source.squeak.org
Mon May 28 14:25:27 UTC 2012


David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.273.mcz

==================== Summary ====================

Name: VMMaker-dtl.273
Author: dtl
Time: 28 May 2012, 10:23:08.237 am
UUID: ba66295e-882e-4569-84c3-407b00d2d2b3
Ancestors: VMMaker-dtl.272

VMMaker 4.9.3

Add check in CCodeGenerator to verify that concrete implementations exist for all methods declared abstract.

Eliminate overrides in InterpreterPrimitives hierarchy. Declare primitiveClone, primitiveCopyObject, and primitiveTerminateTo as abstract methods in InterpreterPrimitives with implementations in Interpreter and StackInterpreter.

Make SlangBrowser and code generation work for methods in StackInterpreter, StackInterpreterPrimitives, NewObjectMemory, etc.

=============== Diff against VMMaker-dtl.272 ===============

Item was changed:
  Object subclass: #CCodeGenerator
+ 	instanceVariableNames: 'translationDict inlineList constants variables variableDeclarations scopeStack methods macros preparedMethodList variablesSetCache headerFiles globalVariableUsage useSymbolicConstants generateDeadCode doNotRemoveMethodList asArgumentTranslationDict receiverDict vmClass currentMethod logger declareMethodsStatic permitMethodPruning pools abstractDeclarations'
- 	instanceVariableNames: 'translationDict inlineList constants variables variableDeclarations scopeStack methods macros preparedMethodList variablesSetCache headerFiles globalVariableUsage useSymbolicConstants generateDeadCode doNotRemoveMethodList asArgumentTranslationDict receiverDict vmClass currentMethod logger declareMethodsStatic permitMethodPruning pools'
  	classVariableNames: 'UseRightShiftForDivide'
  	poolDictionaries: ''
  	category: 'VMMaker-Translation to C'!
  
  !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
  This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.  
  See VMMaker for more useful info!

Item was changed:
  ----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') -----
  addMethodFor: aClass selector: selector
  	"Add the given method to the code base and answer its translation
  	 or nil if it shouldn't be translated."
  
  	| method tmethod |
  	method := aClass compiledMethodAt: selector.
+ 	method requiresConcreteImplementation ifTrue: [abstractDeclarations add: selector].
  	method isAbstract ifTrue: [^nil].
  	(method pragmaAt: #doNotGenerate) ifNotNil: [^nil].
  	"process optional methods by interpreting the argument to the option: pragma as either
  	 a Cogit class name or a class variable name or a variable name in VMBasicConstants."
  	(method pragmaAt: #option:) ifNotNil:
  		[:pragma| | key |
  		key := pragma argumentAt: 1.
  		"((Cogit withAllSubclasses anySatisfy: [:c| c name = key])
  		and: [VMClass getVMMaker cogitClassName ~= key]) ifTrue:
  			[^nil]."
  		(aClass bindingOf: key) ifNotNil:
  			[:binding|
  			binding value ifFalse: [^nil]].
  		(VMBasicConstants bindingOf: key) ifNotNil:
  			[:binding|
  			binding value ifFalse: [^nil]]].
  	tmethod := self compileToTMethodSelector: selector in: aClass.
  	tmethod hasDoNotGenerateStatement ifTrue: [^nil].
  	self addMethod: tmethod.
  	"If the method has a macro then add the macro.  But keep the method
  	 for analysis purposes (e.g. its variable accesses)."
  	(method pragmaAt: #cmacro:) ifNotNil:
  		[:pragma|
  		self addMacro: (pragma argumentAt: 1) for: selector].
  	(method propertyValueAt: #cmacro:) ifNotNil:
  		[:macro|
  		self addMacro: macro for: selector].
  	^tmethod!

Item was added:
+ ----- Method: CCodeGenerator>>checkAbstractMethods (in category 'error notification') -----
+ checkAbstractMethods
+ 	"For each method that has been declared abstract, ensure that a concrete
+ 	implementation has been provided. This check should be performed prior to
+ 	inlining because methods may be removed during the inlining process."
+ 
+ 	| selectors |
+ 	selectors := methods keys, self permittedAbstractMethods.
+ 	abstractDeclarations do: [:sel |
+ 		(selectors includes: sel)
+ 			ifFalse: [self error: 'missing implementation for ', sel]]
+ !

Item was added:
+ ----- Method: CCodeGenerator>>declareVar:type: (in category 'public') -----
+ declareVar: varName type: type
+ 	"This both creates a varable and provides its type"
+ 	self var: (variables add: varName asString) type: type!

Item was added:
+ ----- Method: CCodeGenerator>>fileHeaderVersionStampForSourceClass: (in category 'C code generator') -----
+ fileHeaderVersionStampForSourceClass: sourceClass
+ 	"Answer a suitable versiomn stamp to include in the header."
+ 	| exportBuildInfo slangDescription sourceDescription |
+ 	[exportBuildInfo := sourceClass isInterpreterClass
+ 						ifTrue: ['char *__interpBuildInfo = __buildInfo;']
+ 						ifFalse:
+ 							[sourceClass isCogitClass
+ 								ifTrue: ['char *__cogitBuildInfo = __buildInfo;']]]
+ 		on: MessageNotUnderstood
+ 		do: [:ex| ex resume: false].
+ 	[slangDescription := self monticelloDescriptionFor: self class.
+ 	 sourceClass ifNotNil:
+ 		[sourceDescription := self monticelloDescriptionFor: sourceClass]]
+ 		on: Error
+ 		do: [:ex| | now |
+ 			now := Time dateAndTimeNow printString.
+ 			^String streamContents:
+ 				[:s|
+ 				s nextPutAll: '/* Automatically generated from Squeak on '.
+ 				s nextPutAll: now.
+ 				s nextPutAll: ' */'; cr; cr.
+ 				s nextPutAll: 'static char __buildInfo[] = "Generated on '.
+ 				s nextPutAll: now.
+ 				s nextPutAll: '. Compiled on "'.
+ 				s nextPutAll: '__DATE__ ;'; cr.
+ 				exportBuildInfo ifNotNil:
+ 					[s nextPutAll: exportBuildInfo; cr].
+ 				s cr]].
+ 	^String streamContents:
+ 		[:s|
+ 		s nextPutAll: '/* Automatically generated by'.
+ 		s crtab.
+ 		s nextPutAll: slangDescription.
+ 		sourceDescription ifNotNil:
+ 			[s cr; nextPutAll: '   from'; crtab; nextPutAll: sourceDescription].
+ 		s cr; nextPutAll: ' */'; cr.
+ 		sourceDescription ifNotNil:
+ 			[s nextPutAll: 'static char __buildInfo[] = "'.
+ 			 s nextPutAll: sourceDescription.
+ 			 s nextPutAll: ' " __DATE__ ;'; cr.
+ 			exportBuildInfo ifNotNil:
+ 				[s nextPutAll: exportBuildInfo; cr].
+ 			s cr]]!

Item was changed:
  ----- Method: CCodeGenerator>>initialize (in category 'public') -----
  initialize
  	translationDict := Dictionary new.
  	inlineList := Array new.
  	constants := Dictionary new: 100.
  	variables := OrderedCollection new: 100.
  	variableDeclarations := Dictionary new: 100.
  	methods := Dictionary new: 500.
  	macros := Dictionary new.
  	self initializeCTranslationDictionary.
  	receiverDict := Dictionary new.
  	headerFiles := OrderedCollection new.
  	globalVariableUsage := Dictionary new.
  	useSymbolicConstants := true.
  	generateDeadCode := true.
  	scopeStack := OrderedCollection new.
  	logger := (ProvideAnswerNotification new tag: #logger; signal) ifNil: [Transcript].
+ 	pools := IdentitySet new.
+ 	abstractDeclarations := IdentitySet new.!
- 	pools := IdentitySet new.!

Item was added:
+ ----- Method: CCodeGenerator>>monticelloDescriptionFor: (in category 'C code generator') -----
+ monticelloDescriptionFor: aClass
+ 	"Answer a suitable Monticello package stamp to include in the header."
+ 	| pkgInfo pkg uuid |
+ 	pkgInfo := PackageOrganizer default packageOfClass: aClass.
+ 	pkg := MCWorkingCopy allManagers detect: [:ea| ea packageName = pkgInfo packageName].
+ 	pkg ancestry ancestors isEmpty ifFalse:
+ 		[uuid := pkg ancestry ancestors first id].
+ 	^aClass name, (pkg modified ifTrue: [' * '] ifFalse: [' ']), pkg ancestry ancestorString, ' uuid: ', uuid asString!

Item was added:
+ ----- Method: CCodeGenerator>>needToGenerateHeader:file:contents: (in category 'C code generator') -----
+ needToGenerateHeader: headerName file: interpHdrPath contents: newContentsArg
+ 	"Check if we need to regenerate a header file.  We always need to if the contents have changed.
+ 	 But if not we can avoid needless recompilations by not regenerating.  So only regenerate if the
+ 	 package is clean (version doesn't include a '*').  If we can't find a package version ask the user."
+ 	| newContents oldContents |
+ 	(FileDirectory default fileExists: interpHdrPath) ifFalse:
+ 		[^true].
+ 	newContents := newContentsArg.
+ 	oldContents := (FileDirectory default oldFileNamed: interpHdrPath) contentsOfEntireFile.
+ 	(newContents beginsWith: '/*') = (oldContents beginsWith: '/*') ifFalse:
+ 		[(newContents beginsWith: '/*') ifTrue:
+ 			[newContents := newContents readStream upToAll: '*/'; skipSeparators; upToEnd].
+ 		 (oldContents beginsWith: '/*') ifTrue:
+ 			[oldContents := oldContents readStream upToAll: '*/'; skipSeparators; upToEnd]].
+ 	oldContents := oldContents copyReplaceAll: {Character cr. Character lf} with: {Character cr}.
+ 	oldContents replaceAll: Character lf with: Character cr.
+ 	^oldContents ~= newContents
+ 	 or: [[((self monticelloDescriptionFor: vmClass) includes: $*) not]
+ 			on: Error
+ 			do: [:ex|
+ 				self confirm: headerName, ' contents are unchanged.\Writing the file may cause recompilation of support files.\Do you want to write the header file?\The interpreter will still be written either way.' withCRs]]!

Item was added:
+ ----- Method: CCodeGenerator>>permittedAbstractMethods (in category 'error notification') -----
+ permittedAbstractMethods
+ 	"Methods generated directly by the code generator require concrete implementations
+ 	only in simulation. These may safely be declared abstract in order to ensure that
+ 	implemenations are provided in the simulator classes."
+ 
+ 	^ #(
+ 			bytesPerWord.
+ 			baseHeaderSize.
+ 			byteAt:.
+ 			anAbstractMethod	"for unit test"
+ 		).
+ !

Item was changed:
  ----- Method: CCodeGenerator>>prepareMethodsInlined:doAssertions: (in category 'C code generator') -----
  prepareMethodsInlined: inlineFlag doAssertions: assertionFlag
  	"Prepare to emit C code for all methods in the code base. All inlined method calls should be expanded. Answer a list of methods to be emitted as C code."
  
  	| verbose methodList |
  	"method preparation"
  	verbose := false.
  	self prepareMethods.
  	verbose ifTrue: [
  		self printUnboundCallWarnings.
  		self printUnboundVariableReferenceWarnings.
  		Transcript cr.
  	].
+ 	self checkAbstractMethods.
  	assertionFlag ifFalse: [ self removeAssertions ].
  	self doInlining: inlineFlag.
  
  	"code generation"
  
  	methodList := methods asSortedCollection: [ :m1 :m2 | m1 selector < m2 selector ].
  	"clean out no longer valid variable names and then handle any global
  		variable usage in each method"
  	methodList do: [:m | self checkForGlobalUsage: m removeUnusedTemps in: m].
  	self localizeGlobalVariables.
  	^ preparedMethodList := methodList
  !

Item was added:
+ ----- Method: CCodeGenerator>>shortMonticelloDescriptionForClass: (in category 'C code generator') -----
+ shortMonticelloDescriptionForClass: aClass
+ 	"Answer a suitable Monticello package stamp to include in a moduleName."
+ 	| mdesc |
+ 	mdesc := [self monticelloDescriptionFor: aClass]
+ 				on: Error
+ 				do: [:ex| ^' ', Date today asString].
+ 	^mdesc copyFrom: 1 to: (mdesc indexOfSubCollection: ' uuid:') - 1!

Item was added:
+ ----- Method: CCodeGenerator>>storeHeaderOnFile:contents: (in category 'public') -----
+ storeHeaderOnFile: fileName contents: contents
+ 	"Store C header code on the given file. Evaluate
+ 	 aBlock with the stream to generate its contents."
+ 
+ 	| aStream |
+ 	aStream := VMMaker forceNewFileNamed: fileName.
+ 	aStream ifNil: [Error signal: 'Could not open C header file: ', fileName].
+ 	[(contents beginsWith: '/* Automatic') ifFalse:
+ 		[aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr].
+ 	 aStream nextPutAll: contents]
+ 		ensure: [aStream close]!

Item was added:
+ ----- Method: Interpreter class>>additionalHeadersDo: (in category 'translation') -----
+ additionalHeadersDo: aBinaryBlock
+ 	"Evaluate aBinaryBlock with the names and contents of
+ 	 any additional header files that need to be generated."!

Item was removed:
- ----- Method: Interpreter class>>buildCodeGenerator (in category 'translation') -----
- buildCodeGenerator
- 	"Build a CCodeGenerator. Use VMMaker to determine an appropriate
- 	code generator for the current platform."
- 	 | cg |
- 	cg := VMMaker new createCodeGenerator.
- 	cg declareMethodsStatic: false.
- 	cg permitMethodPruning: true.
- 	^self initializeCodeGenerator: cg.
- !

Item was removed:
- ----- Method: Interpreter class>>emitInterpreterProxyVersionOn: (in category 'api version') -----
- emitInterpreterProxyVersionOn: aStream
- 	"Specify the version level that corresponds to this interpreter. External
- 	support code may define additional functions that are not supported by
- 	this interpreter. "
- 	aStream
- 		nextPutAll: '#define VM_PROXY_MAJOR '; print: self vmProxyMajorVersion; cr;
- 		nextPutAll: '#define VM_PROXY_MINOR '; print: self vmProxyMinorVersion; cr; cr!

Item was removed:
- ----- Method: Interpreter class>>vmProxyMajorVersion (in category 'api version') -----
- vmProxyMajorVersion
- 	"Define the  VM_PROXY_MAJOR version for this VM as used to
- 	 define the api in platforms/Cross/vm/sqVirtualMachine.[ch]"
- 	^1!

Item was removed:
- ----- Method: Interpreter class>>vmProxyMinorVersion (in category 'api version') -----
- vmProxyMinorVersion
- 	"Define the  VM_PROXY_MINOR version for this VM as used to
- 	 define the api in platforms/Cross/vm/sqVirtualMachine.[ch]"
- 	^9!

Item was added:
+ ----- Method: Interpreter>>primitiveClone (in category 'object access primitives') -----
+ primitiveClone
+ 	"Return a shallow copy of the receiver."
+ 
+ 	| newCopy |
+ 	newCopy := objectMemory clone: (self stackTop).
+ 	newCopy = 0
+ 		ifTrue:["not enough memory most likely" ^self primitiveFail].
+ 	self pop: 1 thenPush: newCopy.!

Item was added:
+ ----- Method: Interpreter>>primitiveCopyObject (in category 'object access primitives') -----
+ primitiveCopyObject
+ 	"Primitive. Copy the state of the receiver from the argument. 
+ 		Fail if receiver and argument are of a different class. 
+ 		Fail if the receiver or argument are non-pointer objects.
+ 		Fail if receiver and argument have different lengths (for indexable objects).
+ 	"
+ 	| rcvr arg length |
+ 	self methodArgumentCount = 1 ifFalse:[^self primitiveFail].
+ 	arg := self stackObjectValue: 0.
+ 	rcvr := self stackObjectValue: 1.
+ 
+ 	self failed ifTrue:[^nil].
+ 	(objectMemory isPointers: rcvr) ifFalse:[^self primitiveFail].
+ 	(objectMemory fetchClassOf: rcvr) = (objectMemory fetchClassOf: arg) ifFalse:[^self primitiveFail].
+ 	length := self lengthOf: rcvr.
+ 	length = (self lengthOf: arg) ifFalse:[^self primitiveFail].
+ 	
+ 	"Now copy the elements"
+ 	0 to: length-1 do:[:i|
+ 		objectMemory storePointer: i ofObject: rcvr withValue: (objectMemory fetchPointer: i ofObject: arg)].
+ 
+ 	"Note: The above could be faster for young receivers but I don't think it'll matter"
+ 	self pop: 1. "pop arg; answer receiver"
+ !

Item was added:
+ ----- Method: Interpreter>>primitiveTerminateTo (in category 'process primitives') -----
+ primitiveTerminateTo
+ 	"Primitive. Terminate up the context stack from the receiver up to but not including the argument, if previousContext is on my Context stack. Make previousContext my sender. This prim has to shadow the code in ContextPart>terminateTo: to be correct"
+ 	| thisCntx currentCntx aContext nextCntx nilOop |
+ 	aContext := self popStack.
+ 	thisCntx := self popStack.
+ 
+ 	"make sure that aContext is in my chain"
+ 	(self context: thisCntx hasSender: aContext) ifTrue:[
+ 		nilOop := objectMemory nilObj.
+ 		currentCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
+ 		[currentCntx = aContext] whileFalse: [
+ 			nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCntx.
+ 			objectMemory storePointer: SenderIndex ofObject: currentCntx withValue: nilOop.
+ 			objectMemory storePointer: InstructionPointerIndex ofObject: currentCntx withValue: nilOop.
+ 			currentCntx := nextCntx]].
+ 
+ 	objectMemory storePointer: SenderIndex ofObject: thisCntx withValue: aContext.
+ 	^self push: thisCntx!

Item was added:
+ ----- Method: InterpreterPrimitives class>>buildCodeGenerator (in category 'translation') -----
+ buildCodeGenerator
+ 	"Build a CCodeGenerator. Use VMMaker to determine an appropriate
+ 	code generator for the current platform."
+ 	 | cg |
+ 	cg := VMMaker new createCodeGenerator.
+ 	cg declareMethodsStatic: false.
+ 	cg permitMethodPruning: true.
+ 	^self initializeCodeGenerator: cg.
+ !

Item was added:
+ ----- Method: InterpreterPrimitives class>>emitInterpreterProxyVersionOn: (in category 'api version') -----
+ emitInterpreterProxyVersionOn: aStream
+ 	"Specify the version level that corresponds to this interpreter. External
+ 	support code may define additional functions that are not supported by
+ 	this interpreter. "
+ 	aStream
+ 		nextPutAll: '#define VM_PROXY_MAJOR '; print: self vmProxyMajorVersion; cr;
+ 		nextPutAll: '#define VM_PROXY_MINOR '; print: self vmProxyMinorVersion; cr; cr!

Item was added:
+ ----- Method: InterpreterPrimitives class>>vmProxyMajorVersion (in category 'api version') -----
+ vmProxyMajorVersion
+ 	"Define the  VM_PROXY_MAJOR version for this VM as used to
+ 	 define the api in platforms/Cross/vm/sqVirtualMachine.[ch]"
+ 	^1!

Item was added:
+ ----- Method: InterpreterPrimitives class>>vmProxyMinorVersion (in category 'api version') -----
+ vmProxyMinorVersion
+ 	"Define the  VM_PROXY_MINOR version for this VM as used to
+ 	 define the api in platforms/Cross/vm/sqVirtualMachine.[ch]"
+ 	^9!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveClone (in category 'object access primitives') -----
  primitiveClone
  	"Return a shallow copy of the receiver."
  
+ 	self subclassResponsibility!
- 	| newCopy |
- 	newCopy := objectMemory clone: (self stackTop).
- 	newCopy = 0
- 		ifTrue:["not enough memory most likely" ^self primitiveFail].
- 	self pop: 1 thenPush: newCopy.!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveCopyObject (in category 'object access primitives') -----
  primitiveCopyObject
  	"Primitive. Copy the state of the receiver from the argument. 
  		Fail if receiver and argument are of a different class. 
  		Fail if the receiver or argument are non-pointer objects.
  		Fail if receiver and argument have different lengths (for indexable objects).
  	"
+ 	self subclassResponsibility!
- 	| rcvr arg length |
- 	self methodArgumentCount = 1 ifFalse:[^self primitiveFail].
- 	arg := self stackObjectValue: 0.
- 	rcvr := self stackObjectValue: 1.
- 
- 	self failed ifTrue:[^nil].
- 	(objectMemory isPointers: rcvr) ifFalse:[^self primitiveFail].
- 	(objectMemory fetchClassOf: rcvr) = (objectMemory fetchClassOf: arg) ifFalse:[^self primitiveFail].
- 	length := self lengthOf: rcvr.
- 	length = (self lengthOf: arg) ifFalse:[^self primitiveFail].
- 	
- 	"Now copy the elements"
- 	0 to: length-1 do:[:i|
- 		objectMemory storePointer: i ofObject: rcvr withValue: (objectMemory fetchPointer: i ofObject: arg)].
- 
- 	"Note: The above could be faster for young receivers but I don't think it'll matter"
- 	self pop: 1. "pop arg; answer receiver"
- !

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveTerminateTo (in category 'process primitives') -----
  primitiveTerminateTo
  	"Primitive. Terminate up the context stack from the receiver up to but not including the argument, if previousContext is on my Context stack. Make previousContext my sender. This prim has to shadow the code in ContextPart>terminateTo: to be correct"
- 	| thisCntx currentCntx aContext nextCntx nilOop |
- 	aContext := self popStack.
- 	thisCntx := self popStack.
  
+ 	self subclassResponsibility!
- 	"make sure that aContext is in my chain"
- 	(self context: thisCntx hasSender: aContext) ifTrue:[
- 		nilOop := objectMemory nilObj.
- 		currentCntx := objectMemory fetchPointer: SenderIndex ofObject: thisCntx.
- 		[currentCntx = aContext] whileFalse: [
- 			nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCntx.
- 			objectMemory storePointer: SenderIndex ofObject: currentCntx withValue: nilOop.
- 			objectMemory storePointer: InstructionPointerIndex ofObject: currentCntx withValue: nilOop.
- 			currentCntx := nextCntx]].
- 
- 	objectMemory storePointer: SenderIndex ofObject: thisCntx withValue: aContext.
- 	^self push: thisCntx!

Item was added:
+ ----- Method: InterpreterPrimitives>>printHex: (in category 'debug printing') -----
+ printHex: n
+ 	"Print n in hex,  in the form '    0x1234', padded to a width of 10 characters
+ 	 in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles)"
+ 	<api>
+ 	| len buf |
+ 	<var: #buf declareC: 'char buf[35]'> "large enough for a 64-bit value in hex plus the null plus 16 spaces"
+ 	self cCode: 'memset(buf,'' '',34)' inSmalltalk: [buf := 'doh!!'].
+ 	len := self cCode: 'sprintf(buf + 2 + 2 * BYTES_PER_WORD, "0x%lx", (unsigned long)(n))'.
+ 	self cCode: 'printf("%s", buf + len)'.
+ 	len touch: buf!

Item was added:
+ ----- Method: InterpreterPrimitives>>printHexPtr: (in category 'debug printing') -----
+ printHexPtr: p
+ 	"Print n in hex, passed to 10 characters in the form '    0x1234'"
+ 	<inline: true>
+ 	<var: #p type: #'void *'>
+ 	self printHex: (self oopForPointer: p)!

Item was added:
+ ----- Method: InterpreterPrimitives>>space (in category 'debug printing') -----
+ space
+ 	<inline: true>
+ 	self printChar: $ !

Item was added:
+ ----- Method: InterpreterPrimitives>>tab (in category 'debug printing') -----
+ tab
+ 	<inline: true>
+ 	self printChar: $	"<-Character tab"!

Item was removed:
- ----- Method: NewObjectMemory>>printHex: (in category 'debug printing') -----
- printHex: n
- 	"Print n in hex,  in the form '    0x1234', padded to a width of 10 characters
- 	 in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles)"
- 	"Duplicated from StackInterpreter -dtl"
- 	<api>
- 	| len buf |
- 	<var: #buf declareC: 'char buf[35]'> "large enough for a 64-bit value in hex plus the null plus 16 spaces"
- 	self cCode: 'memset(buf,'' '',34)' inSmalltalk: [buf := 'doh!!'].
- 	len := self cCode: 'sprintf(buf + 2 + 2 * BYTES_PER_WORD, "0x%lx", (unsigned long)(n))'.
- 	self cCode: 'printf("%s", buf + len)'.
- 	len touch: buf!

Item was removed:
- ----- Method: NewObjectMemory>>printHexPtr: (in category 'debug printing') -----
- printHexPtr: p
- 	"Print n in hex, passed to 10 characters in the form '    0x1234'"
- 	"Duplicated from StackInterpreter -dtl"
- 	<inline: true>
- 	<var: #p type: #'void *'>
- 	self printHex: (self oopForPointer: p)!

Item was removed:
- ----- Method: NewObjectMemory>>tab (in category 'debug printing') -----
- tab
- 	"Duplicated from StackInterpreter -dtl"
- 	<inline: true>
- 	self printChar: $	"<-Character tab"!

Item was added:
+ ----- Method: ObjectMemory class>>additionalHeadersDo: (in category 'translation') -----
+ additionalHeadersDo: aBinaryBlock
+ 	"Evaluate aBinaryBlock with the names and contents of
+ 	 any additional header files that need to be generated."!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
  	instanceVariableNames: 'currentBytecode localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue primitiveFunctionPointer methodCache atCache lkupClass highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBytes interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals classByteArrayCompactIndex messageSelector preemptionYields profileProcess nextProfileTick profileMethod profileSemaphore'
+ 	classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeTable BytesPerWord COGMTVM COGVM CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition IMMUTABILITY MULTIPLEBYTECODESETS MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex NewspeakVM PrimitiveExternalCallIndex PrimitiveTable STACKVM VMBIGENDIAN'
- 	classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable VMBIGENDIAN'
  	poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter commentStamp: '<historical>' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.  This VM supports Closures but *not* old-style BlockContexts.
  
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
  
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
  
  In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
  
  NOTE:  Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
  
  1.  There are a number of things that should be done the next time we plan to release a completely incompatible image format.  These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:.  Also, contexts should be given a special format code (see next item).
  
  2.  There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change.  This is necessary because the oops may change during a compaction when the oops are being adjusted.  It's important to be aware of this when writing a new image using the SystemTracer.  A better solution would be to reserve one of the format codes for Contexts only.
  
  3.  We have made normal files tolerant to size and positions up to 32 bits.  This has not been done for async files, since they are still experimental.  The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes.
  
  4.  Note that 0 is used in a couple of places as an impossible oop.  This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment).  The places include the method cache and the at cache.
  
  5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT
  
  6.  If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images.!

Item was added:
+ ----- Method: StackInterpreter class>>declareInterpreterVersionIn:defaultName: (in category 'translation') -----
+ declareInterpreterVersionIn: aCCodeGenerator defaultName: defaultName
+ 	NewspeakVM ifTrue:
+ 		["Newspeak as of mid 2011 derives SystemScope systemName from the interpreterVersion
+ 		  (via system attribute 1004) by copying up to but not including the last space, provided the
+ 		  string ends with a digit.  So spaces must be eliminated from the Monitcello version string,
+ 		  and we can't surround it with square brackets."
+ 		(aCCodeGenerator shortMonticelloDescriptionForClass: self) last isDigit ifFalse:
+ 			[self error: 'Newspeak expects interpreterVersion ends with a digit'].
+ 		aCCodeGenerator
+ 			var: #interpreterVersion
+ 			declareC: 'const char *interpreterVersion = "Newspeak Virtual Machine ',
+ 							((aCCodeGenerator shortMonticelloDescriptionForClass: self) copyReplaceAll: ' ' with: '_'),
+ 							'"'.
+ 		^self].
+ 	
+ 	aCCodeGenerator
+ 		var: #interpreterVersion
+ 		declareC: 'const char *interpreterVersion = "Croquet Closure ', defaultName, ' VM [',
+ 					(aCCodeGenerator shortMonticelloDescriptionForClass: self),']"'.!

Item was added:
+ ----- Method: StackInterpreter class>>initialize (in category 'initialization') -----
+ initialize
+ 	"StackInterpreter initialize"
+ 
+ 	"Copied in part from VMClass class>>initializeMiscConstantsWith:"
+ 
+ 	"Falsify the `what type of VM is this?' flags that are defined in the various interp.h files,
+ 	 or in the case of VMBIGENDIAN the various sqConfig.h files.
+ 	 Subclass implementations need to include a super initializeMiscConstantsWith:."
+ 
+ 	BytesPerWord := 4.
+ 	VMBIGENDIAN := false.	"Intel"
+ 	VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:"
+ 	STACKVM := COGVM := COGMTVM := false.
+ 	IMMUTABILITY := NewspeakVM := false.
+ 	MULTIPLEBYTECODESETS := false.
+ 
+ 	NewspeakVM := false.
+ 	self initializeWithOptions: Dictionary new.
+ !

Item was removed:
- ----- Method: StackInterpreter>>allocateMemory:minimum:imageFile:headerSize: (in category 'image save/restore') -----
- allocateMemory: heapSize minimum: minimumMemory imageFile: fileStream headerSize: headerSize
- 
- 	"Translate to C function call with (case sensitive) camelCase. The purpose of this
- 	method is to document the translation.
- 	The default implementation is sqAllocateMemory(minimumMemory, heapSize). This may
- 	be redefined to make use of the image file and header size parameters for efficient
- 	implementation with mmap().
- 	See CCodeGenerator>>writeDefaultMacrosOn: which specifies a default implementation."
- 
- 	<inline: true>
- 	<returnTypeC: #'char *'>
- 	<var: #fileStream type: #sqImageFile>
- 	^ self
- 		allocateMemory: heapSize
- 		Minimum: minimumMemory
- 		ImageFile: fileStream
- 		HeaderSize: headerSize
- !

Item was removed:
- ----- Method: StackInterpreter>>printHex: (in category 'debug printing') -----
- printHex: n
- 	"Print n in hex,  in the form '    0x1234', padded to a width of 10 characters
- 	 in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles)"
- 	<api>
- 	| len buf |
- 	<var: #buf declareC: 'char buf[35]'> "large enough for a 64-bit value in hex plus the null plus 16 spaces"
- 	self cCode: 'memset(buf,'' '',34)' inSmalltalk: [buf := 'doh!!'].
- 	len := self cCode: 'sprintf(buf + 2 + 2 * BytesPerWord, "0x%lx", (unsigned long)(n))'.
- 	self cCode: 'printf("%s", buf + len)'.
- 	len touch: buf!

Item was removed:
- ----- Method: StackInterpreter>>printHexPtr: (in category 'debug printing') -----
- printHexPtr: p
- 	"Print n in hex, passed to 10 characters in the form '    0x1234'"
- 	<inline: true>
- 	<var: #p type: #'void *'>
- 	self printHex: (self oopForPointer: p)!

Item was removed:
- ----- Method: StackInterpreter>>space (in category 'debug printing') -----
- space
- 	<inline: true>
- 	self printChar: $ !

Item was removed:
- ----- Method: StackInterpreter>>tab (in category 'debug printing') -----
- tab
- 	<inline: true>
- 	self printChar: $	"<-Character tab"!

Item was removed:
- ----- Method: StackInterpreter>>wordSwapped: (in category 'image save/restore') -----
- wordSwapped: w
- 	"Return the given 64-bit integer with its halves in the reverse order."
- 
- 	self bytesPerWord = 8 ifFalse: [self error: 'This cannot happen.'].
- 	^   ((w bitShift: self byte4ShiftNegated) bitAnd: self bytes3to0Mask)
- 	  + ((w bitShift: self byte4Shift         ) bitAnd: self bytes7to4Mask)
- !

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveClone (in category 'object access primitives') -----
  primitiveClone
  	"Return a shallow copy of the receiver.
  	 Special-case non-single contexts (because of context-to-stack mapping).
  	 Can't fail for contexts cuz of image context instantiation code (sigh)."
  
+ 	| recvr newCopy |
+ 	recvr := self stackTop.
+ 	(objectMemory isIntegerObject: recvr)
- 	| receiver newCopy |
- 	receiver := self stackTop.
- 	(objectMemory isIntegerObject: receiver)
  		ifTrue:
+ 			[newCopy := recvr]
- 			[newCopy := receiver]
  		ifFalse:
+ 			[(self isContextNonInt: recvr)
- 			[(self isContextNonInt: receiver)
  				ifTrue:
+ 					[newCopy := self cloneContext: recvr]
- 					[newCopy := self cloneContext: receiver]
  				ifFalse:
+ 					[newCopy := objectMemory clone: recvr].
- 					[newCopy := objectMemory clone: receiver].
  			newCopy = 0 ifTrue:
  				[^self primitiveFailFor: PrimErrNoMemory]].
  	self pop: 1 thenPush: newCopy!

Item was added:
+ ----- Method: TMethod>>returnType: (in category 'accessing') -----
+ returnType: aString
+ 	"Set the type of the values returned by this method. This string will be used in the C declaration of this function."
+ 
+ 	returnType := aString!

Item was changed:
  SharedPool subclass: #VMBasicConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'DoAssertionChecks DoExpensiveAssertionChecks PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectMayMove PrimErrUnsupported PrimNoErr'
- 	classVariableNames: 'DoAssertionChecks DoExpensiveAssertionChecks NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectMayMove PrimErrUnsupported PrimNoErr'
  	poolDictionaries: ''
  	category: 'VMMaker-Interpreter'!
  
  !VMBasicConstants commentStamp: 'dtl 4/21/2011 22:44' prior: 0!
  I am a shared pool for basic constants upon which the VM as a whole depends.!

Item was added:
+ VMStructType subclass: #VMCallbackContext
+ 	instanceVariableNames: 'thunkp stackp intregargsp floatregargsp savedCStackPointer savedCFramePointer rvs trampoline savedReenterInterpreter'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Support'!

Item was added:
+ ----- Method: VMCallbackContext class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ 	"Define a CallbackContext, the argument to sendInvokeCallbackContext:
+ 	 self typedef"
+ 
+ 	self instVarNames do:
+ 		[:ivn|
+ 		aBinaryBlock
+ 			value: ivn
+ 			value: (ivn caseOf: {
+ 					['thunkp']				-> [#'void *'].
+ 					['stackp']				-> [#'long *'].
+ 					['intregargsp']			-> [#'long *'].
+ 					['floatregargsp']		-> [#'double *'].
+ 					['rvs']					-> [
+ 						'union {
+ 							long valword;
+ 							struct { int low, high; } valleint64;
+ 							struct { int high, low; } valbeint64;
+ 							double valflt64;
+ 							struct { void *addr; long size; } valstruct;
+ 						}'].
+ 					['savedCStackPointer']		-> [#'void *'].
+ 					['savedCFramePointer']		-> [#'void *'].
+ 					['trampoline']				-> [#'jmp_buf'].
+ 					['savedReenterInterpreter']	-> [#'jmp_buf']})]!

Item was added:
+ ----- Method: VMCallbackContext class>>needsTypeTag (in category 'translation') -----
+ needsTypeTag
+ 	"This allows sqVirtualMachine.h to declare VMCallbackContext  as an
+ 	 opaque type avoiding everyone including setjmp.h & vmCallback.h"
+ 	^true!

Item was added:
+ ----- Method: VMCallbackContext class>>printTypedefOn: (in category 'translation') -----
+ printTypedefOn: aStream
+ 	super printTypedefOn: aStream.
+ 	aStream
+ 		cr;
+ 		nextPutAll: '/* The callback return type codes */'; cr;
+ 		nextPutAll: '#define retword 1'; cr;
+ 		nextPutAll: '#define retword64 2'; cr;
+ 		nextPutAll: '#define retdouble 3'; cr;
+ 		nextPutAll: '#define retstruct 4'; cr;
+ 		cr!

Item was added:
+ ----- Method: VMCallbackContext>>floatregargsp (in category 'accessing') -----
+ floatregargsp
+ 	"Answer the value of floatregargsp"
+ 
+ 	^ floatregargsp!

Item was added:
+ ----- Method: VMCallbackContext>>floatregargsp: (in category 'accessing') -----
+ floatregargsp: anObject
+ 	"Set the value of floatregargsp"
+ 
+ 	^floatregargsp := anObject!

Item was added:
+ ----- Method: VMCallbackContext>>intregargsp (in category 'accessing') -----
+ intregargsp
+ 	"Answer the value of intregargsp"
+ 
+ 	^ intregargsp!

Item was added:
+ ----- Method: VMCallbackContext>>intregargsp: (in category 'accessing') -----
+ intregargsp: anObject
+ 	"Set the value of intregargsp"
+ 
+ 	^intregargsp := anObject!

Item was added:
+ ----- Method: VMCallbackContext>>rvs (in category 'accessing') -----
+ rvs
+ 	"Answer the value of rvs"
+ 
+ 	^ rvs!

Item was added:
+ ----- Method: VMCallbackContext>>rvs: (in category 'accessing') -----
+ rvs: anObject
+ 	"Set the value of rvs"
+ 
+ 	^rvs := anObject!

Item was added:
+ ----- Method: VMCallbackContext>>savedCFramePointer (in category 'accessing') -----
+ savedCFramePointer
+ 	"Answer the value of savedCFramePointer"
+ 
+ 	^ savedCFramePointer!

Item was added:
+ ----- Method: VMCallbackContext>>savedCFramePointer: (in category 'accessing') -----
+ savedCFramePointer: anObject
+ 	"Set the value of savedCFramePointer"
+ 
+ 	^savedCFramePointer := anObject!

Item was added:
+ ----- Method: VMCallbackContext>>savedCStackPointer (in category 'accessing') -----
+ savedCStackPointer
+ 	"Answer the value of savedCStackPointer"
+ 
+ 	^ savedCStackPointer!

Item was added:
+ ----- Method: VMCallbackContext>>savedCStackPointer: (in category 'accessing') -----
+ savedCStackPointer: anObject
+ 	"Set the value of savedCStackPointer"
+ 
+ 	^savedCStackPointer := anObject!

Item was added:
+ ----- Method: VMCallbackContext>>savedReenterInterpreter (in category 'accessing') -----
+ savedReenterInterpreter
+ 	"Answer the value of savedReenterInterpreter"
+ 
+ 	^ savedReenterInterpreter!

Item was added:
+ ----- Method: VMCallbackContext>>savedReenterInterpreter: (in category 'accessing') -----
+ savedReenterInterpreter: anObject
+ 	"Set the value of savedReenterInterpreter"
+ 
+ 	^savedReenterInterpreter := anObject!

Item was added:
+ ----- Method: VMCallbackContext>>stackp (in category 'accessing') -----
+ stackp
+ 	"Answer the value of stackp"
+ 
+ 	^ stackp!

Item was added:
+ ----- Method: VMCallbackContext>>stackp: (in category 'accessing') -----
+ stackp: anObject
+ 	"Set the value of stackp"
+ 
+ 	^stackp := anObject!

Item was added:
+ ----- Method: VMCallbackContext>>thunkp (in category 'accessing') -----
+ thunkp
+ 	"Answer the value of thunkp"
+ 
+ 	^ thunkp!

Item was added:
+ ----- Method: VMCallbackContext>>thunkp: (in category 'accessing') -----
+ thunkp: anObject
+ 	"Set the value of thunkp"
+ 
+ 	^thunkp := anObject!

Item was added:
+ ----- Method: VMCallbackContext>>trampoline (in category 'accessing') -----
+ trampoline
+ 	"Answer the value of trampoline"
+ 
+ 	^ trampoline!

Item was added:
+ ----- Method: VMCallbackContext>>trampoline: (in category 'accessing') -----
+ trampoline: anObject
+ 	"Set the value of trampoline"
+ 
+ 	^trampoline := anObject!

Item was added:
+ ----- Method: VMClass class>>apiExportHeaderName (in category 'translation') -----
+ apiExportHeaderName
+ 	"VM classes that want to generate an api export header override this."
+ 	^nil!

Item was added:
+ ----- Method: VMClass class>>declareC:as:in: (in category 'translation') -----
+ declareC: arrayOfVariableNames as: aCType in: aCCodeGenerator
+ 	"Declare the variables in arrayOfVariableNames with the given type."
+ 
+ 	arrayOfVariableNames
+ 		do: [:varName | aCCodeGenerator var: varName type: aCType]!

Item was added:
+ ----- Method: VMClass class>>exportAPISelectors (in category 'translation') -----
+ exportAPISelectors
+ 	^self exportAPISelectorsFor: self!

Item was added:
+ ----- Method: VMClass class>>exportAPISelectorsFor: (in category 'translation') -----
+ exportAPISelectorsFor: aClass
+ 	^(aClass selectors select:
+ 		[:s| | m |
+ 		((m := aClass compiledMethodAt: s) pragmaAt: #api) notNil or: [(m pragmaAt: #api:) notNil]]) asSet!

Item was added:
+ ----- Method: VMClass class>>initializeMiscConstantsWith: (in category 'initialization') -----
+ initializeMiscConstantsWith: optionsDictionary
+ 	"Falsify the `what type of VM is this?' flags that are defined in the various interp.h files,
+ 	 or in the case of VMBIGENDIAN the various sqConfig.h files.
+ 	 Subclass implementations need to include a super initializeMiscConstantsWith:."
+ 
+ 	"moved to StackInterpreter -dtl"!

Item was added:
+ ----- Method: VMClass class>>initializeWithOptions: (in category 'initialization') -----
+ initializeWithOptions: optionsDictionary
+ 	"Initialize the receiver, typically initializing class variables. Initialize any class variables
+ 	 whose names occur in optionsDictionary with the corresponding values there-in."!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.9.3'!
- 	^'4.9.2'!

Item was changed:
  ----- Method: VMMaker>>generateInterpreterFile (in category 'generate sources') -----
  generateInterpreterFile
  	"Translate the Smalltalk description of the virtual machine into C.  If 'self doInlining' is true, small method bodies are inlined to reduce procedure call overhead.  On the PPC, this results in a factor of three speedup with only 30% increase in code size.  Subclasses can use specialised versions of CCodeGenerator and interpreterClass."
  
  	| cg |
  	self needsToRegenerateInterpreterFile ifFalse: [^nil].
  	self interpreterClass initialize.
  	ObjectMemory initializeConstants.
  	Interpreter initializeInterpreterSourceVersion.
  	cg := self createCodeGenerator.
  	cg declareMethodsStatic: false.
  	self interpreterClass initializeCodeGenerator: cg.
  	cg storeHeaderFor: interpreterClassName onFile: self interpreterHeaderPath.
+ 	cg storeCodeOnFile: self interpreterFilePath doInlining: self doInlining.
+ 	self interpreterClass additionalHeadersDo:
+ 		[:headerName :headerContents| | filePath |
+ 		 filePath := self coreVMDirectory fullNameFor: headerName.
+ 		 (cg needToGenerateHeader: headerName file: filePath contents: headerContents) ifTrue:
+ 			 [cg storeHeaderOnFile: filePath contents: headerContents]].
+ 	self interpreterClass apiExportHeaderName ifNotNil:
+ 		[cg storeAPIExportHeader: self interpreterClass apiExportHeaderName
+ 			OnFile: (self sourceFilePathFor: self interpreterClass apiExportHeaderName)].
+ !
- 	cg storeCodeOnFile: self interpreterFilePath doInlining: self doInlining!



More information about the Vm-dev mailing list