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

commits at source.squeak.org commits at source.squeak.org
Tue Jul 10 23:22:54 UTC 2012


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

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

Name: VMMaker-dtl.278
Author: dtl
Time: 10 July 2012, 7:21:34.41 pm
UUID: ccf0949c-e240-4a8f-ae48-9745e5f04894
Ancestors: VMMaker-dtl.277

VMMaker 4.9.6

Add new primitives from oscog:
	InterpreterPrimitives>>primitiveSetIdentityHash (primitive 161)
	InterpreterPrimitives>>primitiveBehaviorHash (primitive 175)
	InterpreterPrimitives>>primitiveMaxIdentityHash (primitive 176)

Add primitives from oscog, moving them to StackInterpreterPrimitives
	InterpreterPrimitives>>primitiveEnterCriticalSection
	InterpreterPrimitives>>primitiveExitCriticalSection
	InterpreterPrimitives>>primitiveTestAndSetOwnershipOfCriticalSection

Add primitives from oscog, move to StackInterpreterPrimitives, make abstract in InterpreterPrimitives, and add a new implementation for Interpreter:
	InterpreterPrimitives>>primitiveFloatAt
	InterpreterPrimitives>>primitiveFloatAtPut
	InterpreterPrimitives>>primitivePerformWithArgs
	InterpreterPrimitives>>primitivePerformInSuperclass
	InterpreterPrimitives>>primitiveClosureValue
	InterpreterPrimitives>>primitiveClosureValueWithArgs
	InterpreterPrimitives>>primitiveClosureValueNoContextSwitch

Make InterpreterPrimitives>>primitiveResume abstract with separate implementations in Interpreter and StackInterpreterPrimitives.

Make InterpreterPrimitives>>primitiveInvokeObjectAsMethod abstract with separate implementations in Interpreter and StackInterpreterPrimitives.

Add enough code generator changes from oscog to enable generation structure definitions for a stack interpreter. No functional changes to code generation for standard interpreter.

Add bitClear: to the C translation dictionary.

If assert has not been defined by the build system e.g. using sqAssert.h, then include <assert.h> in CCodeGenerator>>emitDefaultMacrosOn:

Fix code generation for #cPreprocessorDirective: (do not add trailing $; )

=============== Diff against VMMaker-dtl.277 ===============

Item was changed:
  ----- Method: CCodeGenerator>>emitCCodeOn:doAssertions: (in category 'C code generator') -----
  emitCCodeOn: aStream doAssertions: assertionFlag
  	"Emit C code for all methods in the code base onto the given stream. All inlined method calls should already have been expanded."
  
  	self emitCHeaderOn: aStream.
+ 	self emitCTypesOn: aStream.
  	self emitCConstantsOn: aStream.
  	self emitCFunctionPrototypes: preparedMethodList on: aStream.
  	self emitCVariablesOn: aStream.
  'Writing Translated Code...'
  displayProgressAt: Sensor cursorPoint
  from: 0 to: methods size
  during: [:bar |
  	preparedMethodList doWithIndex: [ :m :i | bar value: i.
  		m emitCCodeOn: aStream generator: self.
  ]].
  	self emitExportsOn: aStream.
  !

Item was added:
+ ----- Method: CCodeGenerator>>emitCTypesOn: (in category 'C code generator') -----
+ emitCTypesOn: aStream 
+ 	"Store local type declarations on the given stream."
+ 	vmClass ifNotNil:
+ 		[vmClass ancilliaryStructClasses do:
+ 			[:structClass|
+ 			(vmClass shouldGenerateTypedefFor: structClass) ifTrue:
+ 				[structClass printTypedefOn: aStream.
+ 				 aStream cr; cr]]]!

Item was changed:
  ----- Method: CCodeGenerator>>emitDefaultMacrosOn: (in category 'C code generator') -----
  emitDefaultMacrosOn: aStream
  	"Emit macros to provide default implementations of certain functions used by
  	the interpreter. If not previously defined in config.h they will be defined here.
  	The definitions will be available to any module that includes sqMemoryAccess.h.
  	The default macros are chosen for backward compatibility with existing platform
  	support code."
  
  	"Reduce the obscurity of these macros by flagging some selectors to
  	make this method show up as a sender."
  
+ 	self flag: #assert:.
+ 	"If assert() has not been defined e.g. by sqAssert.h, then use the standard clib version"
+ 	aStream cr;
+ 		nextPutAll: '#ifndef assert'; cr;
+ 		nextPutAll: ' #include <assert.h>'; cr;
+ 		nextPutAll: '#endif'; cr.
+ 
  	self flag: #allocateMemory:minimum:imageFile:headerSize:.
  	aStream cr;
  		nextPutAll: '#ifndef allocateMemoryMinimumImageFileHeaderSize'; cr;
  		nextPutAll: ' /* Called by Interpreter>>allocateMemory:minimum:imageFile:headerSize: */'; cr;
  		nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr;
  		nextPutAll: ' #define allocateMemoryMinimumImageFileHeaderSize(',
  						'heapSize, minimumMemory, fileStream, headerSize) \'; cr;
  		nextPutAll: '    sqAllocateMemory(minimumMemory, heapSize)'; cr;
  		nextPutAll: '#endif'; cr.
  
  	self flag: #sqImage:read:size:length:.
  	aStream cr;
  		nextPutAll: '#ifndef sqImageFileReadEntireImage'; cr;
  		nextPutAll: ' /* Called by Interpreter>>sqImage:read:size:length: */'; cr;
  		nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr;
  		nextPutAll: ' #define sqImageFileReadEntireImage(memoryAddress, ',
  						'elementSize,  length, fileStream) \'; cr;
  		nextPutAll: '    sqImageFileRead(memoryAddress, elementSize,  length, fileStream)'; cr;
  		nextPutAll: '#endif'; cr.
  
  	self flag: #error:.
  	aStream cr;
  		nextPutAll: '#ifndef error'; cr;
  		nextPutAll: ' /* error() function called from Interpreter */'; cr;
  		nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr;
  		nextPutAll: ' #define error(str) defaultErrorProc(str)'; cr;
  		nextPutAll: '#endif'; cr.
  
  	self flag: #primitiveMicrosecondClock; flag: #ioMicroSecondClock.
  	aStream cr;
  		nextPutAll: '#ifndef ioMicroSecondClock'; cr;
  		nextPutAll: ' /* Called by Interpreter>>primitiveMicrosecondClock and GC methods */'; cr;
  		nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr;
  		nextPutAll: ' #define ioMicroSecondClock ioMSecs'; cr;
  		nextPutAll: '#endif'; cr.
  
  	self flag: #primitiveUtcWithOffset; flag: #setMicroSeconds:andOffset:.
  	aStream cr;
  		nextPutAll: '#ifndef ioUtcWithOffset'; cr;
  		nextPutAll: ' /* Called by Interpreter>>primitiveUtcWithOffset */'; cr;
  		nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr;
  		nextPutAll: ' #define ioUtcWithOffset(clock, offset) setMicroSecondsandOffset(clock, offset)'; cr;
  		nextPutAll: '#endif'; cr.
  !

Item was added:
+ ----- Method: CCodeGenerator>>generateBitClear:on:indent: (in category 'C translation') -----
+ generateBitClear: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 
+ 	aStream next: 2 put: $(.
+ 	self emitCExpression: msgNode receiver on: aStream.
+ 	aStream nextPutAll: ' | '.
+ 	self emitCExpression: msgNode args first on: aStream.
+ 	aStream nextPutAll: ') - '.
+ 	self emitCExpression: msgNode args first on: aStream.
+ 	aStream nextPut: $)!

Item was changed:
  ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	| pairs |
  	translationDict := Dictionary new: 200.
  	pairs := #(
  	#&				#generateAnd:on:indent:
  	#|				#generateOr:on:indent:
  	#and:			#generateSequentialAnd:on:indent:
  	#or:			#generateSequentialOr:on:indent:
  	#not			#generateNot:on:indent:
  
  	#+				#generatePlus:on:indent:
  	#-				#generateMinus:on:indent:
  	#negated		#generateNegated:on:indent:
  	#*				#generateTimes:on:indent:
  	#/				#generateDivide:on:indent:
  	#//				#generateDivide:on:indent:
  	#\\				#generateModulo:on:indent:
  	#<<			#generateShiftLeft:on:indent:
  	#>>			#generateShiftRight:on:indent:
  	#min:			#generateMin:on:indent:
  	#max:			#generateMax:on:indent:
  	#between:and:	#generateBetweenAnd:on:indent:
  
  	#bitAnd:		#generateBitAnd:on:indent:
  	#bitOr:			#generateBitOr:on:indent:
  	#bitXor:		#generateBitXor:on:indent:
  	#bitShift:		#generateBitShift:on:indent:
  	#signedBitShift:	#generateSignedBitShift:on:indent:
  	#bitInvert32		#generateBitInvert32:on:indent:
+ 	#bitClear:			#generateBitClear:on:indent:
  
  	#<				#generateLessThan:on:indent:
  	#<=			#generateLessThanOrEqual:on:indent:
  	#=				#generateEqual:on:indent:
  	#>				#generateGreaterThan:on:indent:
  	#>=			#generateGreaterThanOrEqual:on:indent:
  	#~=			#generateNotEqual:on:indent:
  	#==			#generateEqual:on:indent:
  	#~~			#generateNotEqual:on:indent:
  	#isNil			#generateIsNil:on:indent:
  	#notNil			#generateNotNil:on:indent:
  
  	#whileTrue: 	#generateWhileTrue:on:indent:
  	#whileFalse:	#generateWhileFalse:on:indent:
  	#whileTrue 		#generateDoWhileTrue:on:indent:
  	#whileFalse		#generateDoWhileFalse:on:indent:
  	#to:do:			#generateToDo:on:indent:
  	#to:by:do:		#generateToByDo:on:indent:
  	#repeat 		#generateRepeat:on:indent:
  
  	#ifTrue:			#generateIfTrue:on:indent:
  	#ifFalse:		#generateIfFalse:on:indent:
  	#ifTrue:ifFalse:	#generateIfTrueIfFalse:on:indent:
  	#ifFalse:ifTrue:	#generateIfFalseIfTrue:on:indent:
  
  	#at:			#generateAt:on:indent:
  	#at:put:			#generateAtPut:on:indent:
  	#basicAt:		#generateAt:on:indent:
  	#basicAt:put:	#generateAtPut:on:indent:
  
  	#integerValueOf:			#generateIntegerValueOf:on:indent:
  	#integerObjectOf:			#generateIntegerObjectOf:on:indent:
  	#isIntegerObject: 			#generateIsIntegerObject:on:indent:
  	#cCode:					#generateInlineCCode:on:indent:
  	#cCode:inSmalltalk:			#generateInlineCCode:on:indent:
  	#cPreprocessorDirective:	#generateInlineCPreprocessorDirective:on:indent:
  	#preprocessorExpression:	#generateInlineCppDirective:on:indent:
  	#isDefined:inSmalltalk:comment:ifTrue:	#generateInlineCppIfDef:on:indent:
  	#isDefined:inSmalltalk:comment:ifTrue:ifFalse:	#generateInlineCppIfDefElse:on:indent:
  	#isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse:	#generateInlineCppIfElse:on:indent:
  	#cCoerce:to:				#generateCCoercion:on:indent:
  	#cCoerceSimple:to:			#generateCCoercion:on:indent:
  	#addressOf:				#generateAddressOf:on:indent:
  	#signedIntFromLong			#generateSignedIntFromLong:on:indent:
  	#signedIntToLong			#generateSignedIntToLong:on:indent:
  	#signedIntFromShort		#generateSignedIntFromShort:on:indent:
  	#signedIntToShort			#generateSignedIntToShort:on:indent:
  	#preIncrement				#generatePreIncrement:on:indent:
  	#preDecrement				#generatePreDecrement:on:indent:
  	#inline:						#generateInlineDirective:on:indent:
  	#asFloat					#generateAsFloat:on:indent:
  	#asInteger					#generateAsInteger:on:indent:
  	#asUnsignedInteger			#generateAsUnsignedInteger:on:indent:
  	#asSymbol					#generateAsSymbol:on:indent:
  	#anyMask:					#generateBitAnd:on:indent:
  	#raisedTo:					#generateRaisedTo:on:indent:
  	#touch:						#generateTouch:on:indent:
  	#bytesPerWord		#generateBytesPerWord:on:indent:
  	#baseHeaderSize		#generateBaseHeaderSize:on:indent:
  
  	#sharedCodeNamed:inCase:		#generateSharedCodeDirective:on:indent:
  
  	#perform:							#generatePerform:on:indent:
  	#perform:with:						#generatePerform:on:indent:
  	#perform:with:with:					#generatePerform:on:indent:
  	#perform:with:with:with:				#generatePerform:on:indent:
  	#perform:with:with:with:with:		#generatePerform:on:indent:
  	#perform:with:with:with:with:with:	#generatePerform:on:indent:
  
  	#shouldNotImplement				#generateSmalltalkMetaError:on:indent:
  	#shouldBeImplemented				#generateSmalltalkMetaError:on:indent:
  	).
  
  	1 to: pairs size by: 2 do: [:i |
  		translationDict at: (pairs at: i) put: (pairs at: i + 1)].
  
  	pairs := #(
  	#ifTrue:				#generateIfTrueAsArgument:on:indent:	
  	#ifFalse:			#generateIfFalseAsArgument:on:indent:
  	#ifTrue:ifFalse:		#generateIfTrueIfFalseAsArgument:on:indent:
  	#ifFalse:ifTrue:		#generateIfFalseIfTrueAsArgument:on:indent:
  	#cCode:			#generateInlineCCodeAsArgument:on:indent:
  	#cCode:inSmalltalk:	#generateInlineCCodeAsArgument:on:indent:
  	).
  
  	asArgumentTranslationDict := Dictionary new: 8.
  	1 to: pairs size by: 2 do: [:i |
  		asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was added:
+ ----- Method: CCodeGenerator>>structTargetKindForVariableName: (in category 'C code generator') -----
+ structTargetKindForVariableName: varName "<String>"
+ 	^VMStructType structTargetKindForDeclaration: (self typeOfVariable: varName)!

Item was added:
+ ----- Method: CCodeGenerator>>vmClass (in category 'public') -----
+ vmClass
+ 	"Answer the interpreter classs if any.  This is nil other than for the core VM."
+ 	^vmClass!

Item was added:
+ ----- Method: CCodeGenerator>>vmClass: (in category 'public') -----
+ vmClass: aClass
+ 	"Set the interpreter class if any.  This is nil other than for the core VM."
+ 	vmClass := aClass!

Item was changed:
  ----- Method: Interpreter class>>initializePrimitiveTable (in category 'initialization') -----
  initializePrimitiveTable 
  	"This table generates a C function address table use in primitiveResponse along with dispatchFunctionPointerOn:in:"
  
  	"NOTE: The real limit here is 2047 because of the method header layout but there is no point in going over the needed size"
  	MaxPrimitiveIndex := 575.
  	PrimitiveTable := Array new: MaxPrimitiveIndex + 1.
  	self table: PrimitiveTable from: 
  	#(	"Integer Primitives (0-19)"
  		(0 primitiveFail)
  		(1 primitiveAdd)
  		(2 primitiveSubtract)
  		(3 primitiveLessThan)
  		(4 primitiveGreaterThan)
  		(5 primitiveLessOrEqual)
  		(6 primitiveGreaterOrEqual)
  		(7 primitiveEqual)
  		(8 primitiveNotEqual)
  		(9 primitiveMultiply)
  		(10 primitiveDivide)
  		(11 primitiveMod)
  		(12 primitiveDiv)
  		(13 primitiveQuo)
  		(14 primitiveBitAnd)
  		(15 primitiveBitOr)
  		(16 primitiveBitXor)
  		(17 primitiveBitShift)
  		(18 primitiveMakePoint)
  		(19 primitiveFail)					"Guard primitive for simulation -- *must* fail"
  
  		"LargeInteger Primitives (20-39)"
  		(20 primitiveFail)
  		(21 primitiveAddLargeIntegers)
  		(22 primitiveSubtractLargeIntegers)
  		(23 primitiveLessThanLargeIntegers)
  		(24 primitiveGreaterThanLargeIntegers)
  		(25 primitiveLessOrEqualLargeIntegers)
  		(26 primitiveGreaterOrEqualLargeIntegers)
  		(27 primitiveEqualLargeIntegers)
  		(28 primitiveNotEqualLargeIntegers)
  		(29 primitiveMultiplyLargeIntegers)
  		(30 primitiveDivideLargeIntegers)
  		(31 primitiveModLargeIntegers)
  		(32 primitiveDivLargeIntegers)
  		(33 primitiveQuoLargeIntegers)
  		(34 primitiveBitAndLargeIntegers)
  		(35 primitiveBitOrLargeIntegers)
  		(36 primitiveBitXorLargeIntegers)
  		(37 primitiveBitShiftLargeIntegers)
- 		(38 primitiveFail)
- 		(39 primitiveFail)
  
+ 		"Float Primitives (38-59)"
+ 		(38 primitiveFloatAt)
+ 		(39 primitiveFloatAtPut)
- 		"Float Primitives (40-59)"
  		(40 primitiveAsFloat)
  		(41 primitiveFloatAdd)
  		(42 primitiveFloatSubtract)
  		(43 primitiveFloatLessThan)
  		(44 primitiveFloatGreaterThan)
  		(45 primitiveFloatLessOrEqual)
  		(46 primitiveFloatGreaterOrEqual)
  		(47 primitiveFloatEqual)
  		(48 primitiveFloatNotEqual)
  		(49 primitiveFloatMultiply)
  		(50 primitiveFloatDivide)
  		(51 primitiveTruncated)
  		(52 primitiveFractionalPart)
  		(53 primitiveExponent)
  		(54 primitiveTimesTwoPower)
  		(55 primitiveSquareRoot)
  		(56 primitiveSine)
  		(57 primitiveArctan)
  		(58 primitiveLogN)
  		(59 primitiveExp)
  
  		"Subscript and Stream Primitives (60-67)"
  		(60 primitiveAt)
  		(61 primitiveAtPut)
  		(62 primitiveSize)
  		(63 primitiveStringAt)
  		(64 primitiveStringAtPut)
  		(65 primitiveFail) "was primitiveNext which no longer pays its way (normal Smalltalk code is faster)"
  		(66 primitiveFail) "was primitiveNextPut which no longer pays its way (normal Smalltalk code is faster)"
  		(67 primitiveFail) "was primitiveAtEnd which no longer pays its way (normal Smalltalk code is faster)"
  
  		"StorageManagement Primitives (68-79)"
  		(68 primitiveObjectAt)
  		(69 primitiveObjectAtPut)
  		(70 primitiveNew)
  		(71 primitiveNewWithArg)
  		(72 primitiveArrayBecomeOneWay)	"Blue Book: primitiveBecome"
  		(73 primitiveInstVarAt)
  		(74 primitiveInstVarAtPut)
  		(75 primitiveAsOop)
  		(76 primitiveStoreStackp)					"Blue Book: primitiveAsObject"
  		(77 primitiveSomeInstance)
  		(78 primitiveNextInstance)
  		(79 primitiveNewMethod)
  
  		"Control Primitives (80-89)"
  		(80 primitiveBlockCopy)
  		(81 primitiveValue)
  		(82 primitiveValueWithArgs)
  		(83 primitivePerform)
  		(84 primitivePerformWithArgs)
  		(85 primitiveSignal)
  		(86 primitiveWait)
  		(87 primitiveResume)
  		(88 primitiveSuspend)
  		(89 primitiveFlushCache)
  
  		"Input/Output Primitives (90-109)"
  		(90 primitiveMousePoint)
  		(91 primitiveTestDisplayDepth)			"Blue Book: primitiveCursorLocPut"
  		(92 primitiveSetDisplayMode)				"Blue Book: primitiveCursorLink"
  		(93 primitiveInputSemaphore)
  		(94 primitiveGetNextEvent)				"Blue Book: primitiveSampleInterval"
  		(95 primitiveInputWord)
  		(96 primitiveFail)	"primitiveCopyBits"
  		(97 primitiveSnapshot)
  		(98 primitiveStoreImageSegment)
  		(99 primitiveLoadImageSegment)
  		(100 primitivePerformInSuperclass)		"Blue Book: primitiveSignalAtTick"
  		(101 primitiveBeCursor)
  		(102 primitiveBeDisplay)
  		(103 primitiveScanCharacters)
  		(104 primitiveFail)	"primitiveDrawLoop"
  		(105 primitiveStringReplace)
  		(106 primitiveScreenSize)
  		(107 primitiveMouseButtons)
  		(108 primitiveKbdNext)
  		(109 primitiveKbdPeek)
  
  		"System Primitives (110-119)"
  		(110 primitiveIdentical)
  		(111 primitiveClass)
  		(112 primitiveBytesLeft)
  		(113 primitiveQuit)
  		(114 primitiveExitToDebugger)
  		(115 primitiveChangeClass)					"Blue Book: primitiveOopsLeft"
  		(116 primitiveFlushCacheByMethod)
  		(117 primitiveExternalCall)
  		(118 primitiveDoPrimitiveWithArgs)
  		(119 primitiveFlushCacheSelective)
  			"Squeak 2.2 and earlier use 119.  Squeak 2.3 and later use 116.
  			Both are supported for backward compatibility."
  
  		"Miscellaneous Primitives (120-127)"
  		(120 primitiveCalloutToFFI)
  		(121 primitiveImageName)
  		(122 primitiveNoop)					"Blue Book: primitiveImageVolume"
  		(123 primitiveValueUninterruptably)	"@@@: Remove this when all VMs have support"
  		(124 primitiveLowSpaceSemaphore)
  		(125 primitiveSignalAtBytesLeft)
  
  		"Squeak Primitives Start Here"
  
  		"Squeak Miscellaneous Primitives (128-149)"
  		(126 primitiveDeferDisplayUpdates)
  		(127 primitiveShowDisplayRect)
  		(128 primitiveArrayBecome)
  		(129 primitiveSpecialObjectsOop)
  		(130 primitiveFullGC)
  		(131 primitiveIncrementalGC)
  		(132 primitiveObjectPointsTo)
  		(133 primitiveSetInterruptKey)
  		(134 primitiveInterruptSemaphore)
  		(135 primitiveMillisecondClock)
  		(136 primitiveSignalAtMilliseconds)
  		(137 primitiveSecondsClock)
  		(138 primitiveSomeObject)
  		(139 primitiveNextObject)
  		(140 primitiveBeep)
  		(141 primitiveClipboardText)
  		(142 primitiveVMPath)
  		(143 primitiveShortAt)
  		(144 primitiveShortAtPut)
  		(145 primitiveConstantFill)
  		"NOTE: When removing the obsolete indexed primitives,
  		the following two should go become #primitiveIntegerAt / atPut"
  		(146 primitiveFail)	"primitiveReadJoystick"
  		(147 primitiveFail)	"primitiveWarpBits"
  		(148 primitiveClone)
  		(149 primitiveGetAttribute)
  
  		"File Primitives (150-169) - NO LONGER INDEXED"
  		(150 159 primitiveFail)
  		(160 primitiveAdoptInstance)
+ 		(161 primitiveSetIdentityHash) "CogMemoryManager primitives"
+ 		(162 164 primitiveFail)
- 		(161 164 primitiveFail)
  		(165 primitiveIntegerAt)		"hacked in here for now"
  		(166 primitiveIntegerAtPut)
  		(167 primitiveYield)
  		(168 primitiveCopyObject)
  		(169 primitiveNotIdentical)
  
  		"Sound Primitives (170-199) - NO LONGER INDEXED"
+ 		(170 174 primitiveFail)
- 		(170 185 primitiveFail)
  
+ 		"CogMemoryManager primitives"
+ 		(175 primitiveBehaviorHash)
+ 		(176 primitiveMaxIdentityHash)
+ 		(177 185 primitiveFail)
+ 
  		"Old closure primitives"
  		(186 primitiveFail) "was primitiveClosureValue"
  		(187 primitiveFail) "was primitiveClosureValueWithArgs"
  
  		"Perform method directly"
  		(188 primitiveExecuteMethodArgsArray)
  		(189 primitiveExecuteMethod)
  
  		"Sound Primitives (continued) - NO LONGER INDEXED"
  		(190 194 primitiveFail)
  
  		"Unwind primitives"
  		(195 primitiveFindNextUnwindContext)
  		(196 primitiveTerminateTo)
  		(197 primitiveFindHandlerContext)
  		(198 primitiveMarkUnwindMethod)
  		(199 primitiveMarkHandlerMethod)
  
  		"new closure primitives (were Networking primitives)"
  		(200 primitiveClosureCopyWithCopiedValues)
  		(201 primitiveClosureValue) "value"
  		(202 primitiveClosureValue) "value:"
  		(203 primitiveClosureValue) "value:value:"
  		(204 primitiveClosureValue) "value:value:value:"
  		(205 primitiveClosureValue) "value:value:value:value:"
  		(206 primitiveClosureValueWithArgs) "valueWithArguments:"
  
  		(207 209 primitiveFail) "reserved for Cog primitives"
  
  		(210 primitiveAt)		"Compatibility with Cog StackInterpreter Context primitives"
  		(211 primitiveAtPut)	"Compatibility with Cog StackInterpreter Context primitives"
  		(212 primitiveSize)	"Compatibility with Cog StackInterpreter Context primitives"
  		(213 219 primitiveFail) "reserved for Cog primitives"
  
  		(220 primitiveFail)		"reserved for Cog primitives"
  
  		(221 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch"
  		(222 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch:"
  
  		(223 229 primitiveFail)	"reserved for Cog primitives"
  
  		(230 primitiveRelinquishProcessor)
  		(231 primitiveForceDisplayUpdate)
  		(232 primitiveFormPrint)
  		(233 primitiveSetFullScreen)
  		(234 primitiveFail) "primBitmapdecompressfromByteArrayat"
  		(235 primitiveFail) "primStringcomparewithcollated"
  		(236 primitiveFail) "primSampledSoundconvert8bitSignedFromto16Bit"
  		(237 primitiveFail) "primBitmapcompresstoByteArray"
  		(238 241 primitiveFail) "serial port primitives"
  		(242 primitiveFail)
  		(243 primitiveFail) "primStringtranslatefromtotable"
  		(244 primitiveFail) "primStringfindFirstInStringinSetstartingAt"
  		(245 primitiveFail) "primStringindexOfAsciiinStringstartingAt"
  		(246 primitiveFail) "primStringfindSubstringinstartingAtmatchTable"
  		(247 primitiveSnapshotEmbedded)
  		(248 primitiveInvokeObjectAsMethod)
  		(249 primitiveArrayBecomeOneWayCopyHash)
  
  		"VM Implementor Primitives (250-255)"
  		(250 clearProfile)
  		(251 dumpProfile)
  		(252 startProfiling)
  		(253 stopProfiling)
  		(254 primitiveVMParameter)
  		(255 primitiveFail) "primitiveInstVarsPutFromStack. Never used except in Disney tests.  Remove after 2.3 release."
  
  		"Quick Push Const Methods"
  		(256 primitivePushSelf)
  		(257 primitivePushTrue)
  		(258 primitivePushFalse)
  		(259 primitivePushNil)
  		(260 primitivePushMinusOne)
  		(261 primitivePushZero)
  		(262 primitivePushOne)
  		(263 primitivePushTwo)
  
  		"Quick Push Const Methods"
  		(264 519 primitiveLoadInstVar)
  
  		"These ranges used to be used by obsiolete indexed primitives."
  		(520 529 primitiveFail)
  		(530 539 primitiveFail)
  		(540 549 primitiveFail)
  		(550 559 primitiveFail)
  		(560 569 primitiveFail)
  
  		"External primitive support primitives"
  		(570 primitiveFlushExternalPrimitives)
  		(571 primitiveUnloadModule)
  		(572 primitiveListBuiltinModule)
  		(573 primitiveListExternalModule)
  		(574 primitiveFail) "reserved for addl. external support prims"
  
  		"Unassigned Primitives"
  		(575 primitiveFail)).
  !

Item was changed:
  ----- Method: Interpreter class>>requiredMethodNames (in category 'translation') -----
  requiredMethodNames
  	"return the list of method names that should be retained for export or other support reasons"
  	| requiredList |
  	requiredList := Set new:400.
  	"A number of methods required by VM support code, jitter, specific platforms etc"
+ 	requiredList addAll: #(fullDisplayUpdate interpret printCallStack printAllStacks readImageFromFile:HeapSize:StartingAt: success: readableFormat: getCurrentBytecode characterForAscii: findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: loadInitialContext nullCompilerHook setCompilerInitialized: getFullScreenFlag getInterruptCheckCounter getInterruptKeycode getInterruptPending getNextWakeupTick getSavedWindowSize setFullScreenFlag: setInterruptCheckCounter: setInterruptKeycode: setInterruptPending: setNextWakeupTick: setSavedWindowSize: forceInterruptCheck getThisSessionID setMicroSeconds:andOffset:).
- 	requiredList addAll: #(fullDisplayUpdate interpret printCallStack printAllStacks readImageFromFile:HeapSize:StartingAt: success: readableFormat: getCurrentBytecode characterForAscii: findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: loadInitialContext nullCompilerHook primitiveFlushExternalPrimitives setCompilerInitialized: getFullScreenFlag getInterruptCheckCounter getInterruptKeycode getInterruptPending getNextWakeupTick getSavedWindowSize setFullScreenFlag: setInterruptCheckCounter: setInterruptKeycode: setInterruptPending: setNextWakeupTick: setSavedWindowSize: forceInterruptCheck getThisSessionID setMicroSeconds:andOffset:).
  
  	"Nice to actually have all the primitives available"
  	requiredList addAll: self primitiveTable.
  
  	"InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
  	InterpreterProxy organization categories do: [:cat |
  		((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [
  			requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
  	
  	^requiredList!

Item was added:
+ ----- Method: Interpreter>>primitiveFloatAt (in category 'indexing primitives') -----
+ primitiveFloatAt
+ 	"Provide platform-independent access to 32-bit words comprising
+ 	 a Float.  Map index 1 onto the most significant word and index 2
+ 	 onto the least significant word."
+ 	| rcvr index result |
+ 	<var: #result type: #usqInt>
+ 	self initPrimCall.
+ 	rcvr := self stackValue: 1.
+ 	index := self stackTop.
+ 	index = ConstOne ifTrue:
+ 		[result := self positive32BitIntegerFor:
+ 					(objectMemory fetchLong32: 0
+ 						ofObject: rcvr).
+ 		^self pop: 2 thenPush: result].
+ 	index = ConstTwo ifTrue:
+ 		[result := self positive32BitIntegerFor:
+ 					(objectMemory fetchLong32: 1
+ 						ofObject: rcvr).
+ 		^self pop: 2 thenPush: result].
+ 	self primitiveFailFor: ((objectMemory isIntegerObject: index)
+ 							ifTrue: [PrimErrBadIndex]
+ 							ifFalse: [PrimErrBadArgument])!

Item was added:
+ ----- Method: Interpreter>>primitiveFloatAtPut (in category 'indexing primitives') -----
+ primitiveFloatAtPut
+ 	"Provide platform-independent access to 32-bit words comprising
+ 	 a Float.  Map index 1 onto the most significant word and index 2
+ 	 onto the least significant word."
+ 	| rcvr index oopToStore valueToStore |
+ 	<var: #result type: #usqInt>
+ 	self initPrimCall.
+ 	oopToStore := self stackTop.
+ 	valueToStore := self positive32BitValueOf: oopToStore.
+ 	self successful ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
+ 	rcvr := self stackValue: 2.
+ 	index := self stackValue: 1.
+ 	index = ConstOne ifTrue:
+ 		[objectMemory storeLong32: 0
+ 			ofObject: rcvr
+ 			withValue: valueToStore.
+ 		^self pop: 3 thenPush: oopToStore].
+ 	index = ConstTwo ifTrue:
+ 		[objectMemory storeLong32: 1
+ 			ofObject: rcvr
+ 			withValue: valueToStore.
+ 		^self pop: 3 thenPush: oopToStore].
+ 	self primitiveFailFor: ((objectMemory isIntegerObject: index)
+ 							ifTrue: [PrimErrBadIndex]
+ 							ifFalse: [PrimErrBadArgument])!

Item was added:
+ ----- Method: Interpreter>>primitiveResume (in category 'process primitives') -----
+ primitiveResume
+ 	"Put this process on the scheduler's lists thus allowing it to proceed next
+ 	time there is a chance for processes of its priority level"
+ 
+ 	| proc |
+ 	proc := self stackTop.  "rcvr"
+ 	"self success: ((self fetchClassOf: proc) = (self splObj: ClassProcess))."
+ 	self successful ifTrue: [ self resume: proc ].!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveBehaviorHash (in category 'object access primitives') -----
+ primitiveBehaviorHash
+ 	| hashOrError |
+ 	self assert: (objectMemory isIntegerObject: self stackTop) not.
+ 	hashOrError := objectMemory ensureBehaviorHash: self stackTop.
+ 	hashOrError >= 0
+ 		ifTrue: [self pop: 1 thenPushInteger: hashOrError]
+ 		ifFalse: [self primitiveFailFor: hashOrError negated]!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveClosureValue (in category 'control primitives') -----
+ primitiveClosureValue
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveClosureValueNoContextSwitch (in category 'control primitives') -----
+ primitiveClosureValueNoContextSwitch
+ 	"An exact clone of primitiveClosureValue except that this version will not
+ 	 check for interrupts on stack overflow.  It may invoke the garbage collector
+ 	 but will not switch processes.  See checkForInterruptsMayContextSwitch:"
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveClosureValueWithArgs (in category 'control primitives') -----
+ primitiveClosureValueWithArgs
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveFloatAt (in category 'indexing primitives') -----
+ primitiveFloatAt
+ 	"Provide platform-independent access to 32-bit words comprising
+ 	 a Float.  Map index 1 onto the most significant word and index 2
+ 	 onto the least significant word."
+ 
+ 	self subclassResponsibility
+ !

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveFloatAtPut (in category 'indexing primitives') -----
+ primitiveFloatAtPut
+ 	"Provide platform-independent access to 32-bit words comprising
+ 	 a Float.  Map index 1 onto the most significant word and index 2
+ 	 onto the least significant word."
+ 
+ 	self subclassResponsibility
+ !

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveInvokeObjectAsMethod (in category 'control primitives') -----
+ primitiveInvokeObjectAsMethod
+ 	"Primitive. 'Invoke' an object like a function, sending the special message 
+ 		run: originalSelector with: arguments in: aReceiver.
+ 	"
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveMaxIdentityHash (in category 'object access primitives') -----
+ primitiveMaxIdentityHash
+ 	self pop: 1 thenPushInteger: objectMemory maxIdentityHash!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitivePerformInSuperclass (in category 'control primitives') -----
+ primitivePerformInSuperclass
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitivePerformWithArgs (in category 'control primitives') -----
+ primitivePerformWithArgs
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveResume (in category 'process primitives') -----
  primitiveResume
+ 	"Put this process on the scheduler's lists thus allowing it to proceed next
+ 	time there is a chance for processes of its priority level"
+ 
+ 	self subclassResponsibility
+ !
- "put this process on the scheduler's lists thus allowing it to proceed next time there is a chance for processes of it's priority level"
- 	| proc |
- 	proc := self stackTop.  "rcvr"
- 	"self success: ((self fetchClassOf: proc) = (self splObj: ClassProcess))."
- 	self successful ifTrue: [ self resume: proc ].!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveSetIdentityHash (in category 'object access primitives') -----
+ primitiveSetIdentityHash
+ 	| hash oldHash thisReceiver |
+ 	hash := self stackIntegerValue: 0.
+ 	thisReceiver := self stackObjectValue: 1.
+ 	self successful ifTrue:
+ 		[oldHash := objectMemory hashBitsOf: thisReceiver.
+ 		 objectMemory setHashBitsOf: thisReceiver to: hash.
+ 		 self pop: argumentCount + 1 thenPushInteger: oldHash]!

Item was changed:
+ VMStructType subclass: #InterpreterStackPage
- ProtoObject subclass: #InterpreterStackPage
  	instanceVariableNames: 'stackLimit headSP headFP baseFP baseAddress realStackLimit lastAddress trace nextPage prevPage'
  	classVariableNames: 'LargeContextBytes'
  	poolDictionaries: 'VMBasicConstants VMSqueakV3BytecodeConstants'
  	category: 'VMMaker-Interpreter'!
  
  !InterpreterStackPage commentStamp: '<historical>' prior: 0!
  I am a class that helps organize the StackInterpreter's collection of stack pages.  I represent the control block for a single stack page in the collection of stack pages represented by an InterpreterStackPages instance.!

Item was added:
+ ----- Method: ObjectMemory>>ensureBehaviorHash: (in category 'header access') -----
+ ensureBehaviorHash: oop
+ 
+ 	^self hashBitsOf: oop!

Item was added:
+ ----- Method: ObjectMemory>>maxIdentityHash (in category 'forward compatibility') -----
+ maxIdentityHash
+ 	^HashMaskUnshifted!

Item was added:
+ ----- Method: ObjectMemory>>setHashBitsOf:to: (in category 'header access') -----
+ setHashBitsOf: oop to: hash
+ 	self longAt: oop
+ 		put: (((self baseHeader: oop) bitClear: HashBits)
+ 				bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset)!

Item was added:
+ ----- Method: SlangTest>>testIvarShouldNotBeRedeclaredAsLocal (in category 'testing variable declaration') -----
+ testIvarShouldNotBeRedeclaredAsLocal
+ 	"Document a bug in some versions of the code generator. If an instance variable is
+ 	referenced in the generated code, that variable should not be declared as a local
+ 	in the function."
+ 
+ 	| s |
+ 	s := SlangTestSupportInterpreter asCString: #setBreakSelector: .
+ 	self deny: (s includesSubString: 'sqInt breakSelector;')
+ !

Item was changed:
  ObjectMemory subclass: #SlangTestSupportInterpreter
+ 	instanceVariableNames: 'primFailCode aVarWithOneReference aVarWithTwoReferences objectMemory aVariable breakSelector'
- 	instanceVariableNames: 'primFailCode aVarWithOneReference aVarWithTwoReferences objectMemory aVariable'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Tests'!
  
  !SlangTestSupportInterpreter commentStamp: 'dtl 9/19/2010 21:36' prior: 0!
  SlangTestSupport implements translatable methods for use in SlangTest unit tests.
  
  	"VMMaker clearCacheEntriesFor: SlangTestSupportInterpreter.
  	SlangTestSupportInterpreter asCString"!

Item was added:
+ ----- Method: SlangTestSupportInterpreter>>setBreakSelector: (in category 'local and instance vars') -----
+ setBreakSelector: aString
+ 	"breakSelector is an instance variable and should not be declared as a local in
+ 	the generated code"
+ 	breakSelector := aString!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveClosureCopyWithCopiedValues (in category 'control primitives') -----
  primitiveClosureCopyWithCopiedValues
  	| newClosure numArgs |
  	numArgs := self stackIntegerValue: 1.
  	self successful ifFalse:
  		[^self primitiveFail].
  
  	newClosure := self
  					closureIn: (self stackValue: 2)
  					numArgs: numArgs
  							"greater by 1 due to preIncrement of localIP"
+ 					instructionPointer: instructionPointer + 2 - (method + self baseHeaderSize)
- 					instructionPointer: instructionPointer + 2 - (method+BaseHeaderSize)
  					copiedValues: self stackTop.
  	self pop: 3 thenPush: newClosure!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveClosureValue (in category 'control primitives') -----
+ primitiveClosureValue
+ 	| blockClosure numArgs closureMethod outerContext |
+ 	blockClosure := self stackValue: argumentCount.
+ 	numArgs := self argumentCountOfClosure: blockClosure.
+ 	argumentCount = numArgs ifFalse:
+ 		[^self primitiveFail].
+ 
+ 	"Somewhat paranoiac checks we need while debugging that we may be able to discard
+ 	 in a robust system."
+ 	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ 	(self isContext: outerContext) ifFalse:
+ 		[^self primitiveFail].
+ 	closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
+ 	"Check if the closure's method is actually a CompiledMethod."
+ 	(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
+ 		[^self primitiveFail].
+ 
+ 	"Note we use activateNewMethod, not executeNewMethod, to avoid
+ 	 quickCheckForInterrupts.  Don't check until we have a full activation."
+ 	self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveClosureValueNoContextSwitch (in category 'control primitives') -----
+ primitiveClosureValueNoContextSwitch
+ 	"An exact clone of primitiveClosureValue except that this version will not
+ 	 check for interrupts on stack overflow.  It may invoke the garbage collector
+ 	 but will not switch processes.  See checkForInterruptsMayContextSwitch:"
+ 	| blockClosure numArgs closureMethod outerContext |
+ 	blockClosure := self stackValue: argumentCount.
+ 	numArgs := self argumentCountOfClosure: blockClosure.
+ 	argumentCount = numArgs ifFalse:
+ 		[^self primitiveFail].
+ 
+ 	"Somewhat paranoiac checks we need while debugging that we may be able to discard
+ 	 in a robust system."
+ 	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ 	(self isContext: outerContext) ifFalse:
+ 		[^self primitiveFail].
+ 	closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
+ 	"Check if the closure's method is actually a CompiledMethod."
+ 	(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
+ 		[^self primitiveFail].
+ 
+ 	"Note we use activateNewMethod, not executeNewMethod, to avoid
+ 	 quickCheckForInterrupts.  Don't check until we have a full activation."
+ 	self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: false!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveClosureValueWithArgs (in category 'control primitives') -----
+ primitiveClosureValueWithArgs
+ 	| argumentArray arraySize blockClosure numArgs closureMethod index outerContext |
+ 	argumentArray := self stackTop.
+ 	(objectMemory isArray: argumentArray) ifFalse:
+ 		[^self primitiveFail].
+ 
+ 	"Check for enough space in thisContext to push all args"
+ 	arraySize := objectMemory fetchWordLengthOf: argumentArray.
+ 	(self roomToPushNArgs: arraySize) ifFalse:
+ 		[^self primitiveFail].
+ 
+ 	blockClosure := self stackValue: argumentCount.
+ 	numArgs := self argumentCountOfClosure: blockClosure.
+ 	arraySize = numArgs ifFalse:
+ 		[^self primitiveFail].
+ 
+ 	"Somewhat paranoiac checks we need while debugging that we may be able to discard
+ 	 in a robust system."
+ 	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
+ 	(self isContext: outerContext) ifFalse:
+ 		[^self primitiveFail].
+ 	closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
+ 	"Check if the closure's method is actually a CompiledMethod."
+ 	(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
+ 		[^self primitiveFail].
+ 
+ 	self popStack.
+ 
+ 	"Copy the arguments to the stack, and activate"
+ 	index := 1.
+ 	[index <= numArgs]
+ 		whileTrue:
+ 		[self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
+ 		index := index + 1].
+ 
+ 	"Note we use activateNewMethod, not executeNewMethod, to avoid
+ 	 quickCheckForInterrupts.  Don't check until we have a full activation."
+ 	self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
  primitiveDoNamedPrimitiveWithArgs
  	"Simulate an primitiveExternalCall invocation (e.g. for the Debugger).  Do not cache anything.
  	 e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
  	| argumentArray arraySize methodArg methodHeader
  	  moduleName functionName moduleLength functionLength
  	  spec addr primRcvr ctxtRcvr |
  	<var: #addr declareC: 'void (*addr)()'>
  	argumentArray := self stackTop.
  	(objectMemory isArray: argumentArray) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  	arraySize := objectMemory fetchWordLengthOf: argumentArray.
  	self success: (self roomToPushNArgs: arraySize).
  
  	methodArg := self stackObjectValue: 2.
  	self successful ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
  	(objectMemory isOopCompiledMethod: methodArg) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
  	methodHeader := self headerOf: methodArg.
  
  	(self literalCountOfHeader: methodHeader) > 2 ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  	(self assertClassOf: (spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg)
  		is: (objectMemory splObj: ClassArray) 
  		compactClassIndex: ClassArrayCompactIndex).
  	(self successful
  	and: [(objectMemory lengthOf: spec) = 4
  	and: [(self primitiveIndexOfMethodHeader: methodHeader) = 117]]) ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: spec.
  	moduleName = objectMemory nilObject
  		ifTrue: [moduleLength := 0]
  		ifFalse: [self success: (objectMemory isBytes: moduleName).
  				moduleLength := objectMemory lengthOf: moduleName.
  				self cCode: '' inSmalltalk:
  					[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
  						ifTrue: [moduleLength := 0  "Cause all of these to fail"]]].
  	functionName := objectMemory fetchPointer: 1 ofObject: spec.
  	self success: (objectMemory isBytes: functionName).
  	functionLength := objectMemory lengthOf: functionName.
  	self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
  
+ 	addr := self ioLoadExternalFunction: functionName + self baseHeaderSize
- 	addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
  				OfLength: functionLength
+ 				FromModule: moduleName + self baseHeaderSize
- 				FromModule: moduleName + BaseHeaderSize
  				OfLength: moduleLength.
  	addr = 0 ifTrue:
  		[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
  
  	"Cannot fail this primitive from now on.  Can only fail the external primitive."
  	objectMemory pushRemappableOop: (argumentArray := self popStack).
  	objectMemory pushRemappableOop: (primRcvr := self popStack).
  	objectMemory pushRemappableOop: self popStack. "the method"
  	objectMemory pushRemappableOop: self popStack. "the context receiver"
  	self push: primRcvr. "replace context receiver with actual receiver"
  	argumentCount := arraySize.
  	1 to: arraySize do:
  		[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
  	"Run the primitive (sets primFailCode)"
  	lkupClass := objectMemory nilObject.
  	self callExternalPrimitive: addr.
  	ctxtRcvr  := objectMemory popRemappableOop.
  	methodArg := objectMemory popRemappableOop.
  	primRcvr := objectMemory popRemappableOop.
  	argumentArray := objectMemory popRemappableOop.
  	self successful ifFalse: "If primitive failed, then restore state for failure code"
  		[self pop: arraySize + 1.
  		 self push: ctxtRcvr.
  		 self push: methodArg.
  		 self push: primRcvr.
  		 self push: argumentArray.
  		 argumentCount := 3.
  		 "Hack.  A nil prim error code (primErrorCode = 1) is interpreted by the image
  		  as meaning this primitive is not implemented.  So to pass back nil as an error
  		  code we use -1 to indicate generic failure."
  		 primFailCode = 1 ifTrue:
  			[primFailCode := -1]]!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveEnterCriticalSection (in category 'process primitives') -----
+ primitiveEnterCriticalSection
+ 	"Attempt to enter a CriticalSection/Mutex.  If not owned, set the owner to the current
+ 	 process and answer false. If owned by the current process  answer true.   Otherwise
+ 	 suspend the process.  Answer if the receiver is owned by the current process.
+ 	 For simulation if there is an argument it is taken to be the effective activeProcess
+ 	 (see Process>>effectiveProcess)."
+ 	| criticalSection owningProcessIndex owningProcess activeProc |
+ 	argumentCount > 0
+ 		ifTrue:
+ 			[criticalSection := self stackValue: 1.  "rcvr"
+ 			 activeProc := self stackTop]
+ 		ifFalse:
+ 			[criticalSection := self stackTop.  "rcvr"
+ 			 activeProc := self activeProcess].
+ 	owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores"
+ 	owningProcess := objectMemory fetchPointer: owningProcessIndex ofObject: criticalSection.
+ 	owningProcess = objectMemory nilObject ifTrue:
+ 		[objectMemory storePointer: owningProcessIndex
+ 			ofObject: criticalSection
+ 			withValue: activeProc.
+ 		 ^self pop: argumentCount + 1 thenPush: objectMemory falseObject].
+ 	owningProcess = activeProc ifTrue:
+ 		[^self pop: argumentCount + 1 thenPush: objectMemory trueObject].
+ 	"Arrange to answer false (unowned) when the process is resumed."
+ 	self pop: argumentCount + 1 thenPush: objectMemory falseObject.
+ 	self addLastLink: activeProc toList: criticalSection.
+ 	self transferTo: self wakeHighestPriority!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveExitCriticalSection (in category 'process primitives') -----
+ primitiveExitCriticalSection
+ 	"Exit the critical section.
+ 	 This may change the active process as a result."
+ 	| criticalSection owningProcessIndex owningProcess |
+ 	criticalSection := self stackTop.  "rcvr"
+ 	owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores"
+ 	(self isEmptyList: criticalSection)
+ 		ifTrue:
+ 			[objectMemory storePointerUnchecked: owningProcessIndex
+ 				ofObject: criticalSection
+ 				withValue: objectMemory nilObject]
+ 		ifFalse:
+ 			[owningProcess := self removeFirstLinkOfList: criticalSection.
+ 			 "store check unnecessary because criticalSection referred to owningProcess
+ 			  via its FirstLinkIndex slot before owningProcess was removed."
+ 			 objectMemory storePointerUnchecked: owningProcessIndex
+ 				ofObject: criticalSection
+ 				withValue: owningProcess.
+ 			 "Note that resume: isn't fair; it won't suspend the active process.
+ 			  For fairness we must do the equivalent of a primitiveYield, but that
+ 			  may break old code, so we stick with unfair resume:."
+ 			self resume: owningProcess preemptedYieldingIf: preemptionYields]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveExternalCall (in category 'plugin primitives') -----
  primitiveExternalCall
  	"Call an external primitive. External primitive methods first literals are an array of
  		* The module name (String | Symbol) 
  		* The function name (String | Symbol) 
  		* The session ID (SmallInteger) [OBSOLETE] 
  		* The function index (Integer) in the externalPrimitiveTable
  	For fast interpreter dispatch in subsequent invocations the primitiveFunctionPointer
  	in the method cache is rewritten, either to the function itself, or to zero if the external
  	function is not found.   This allows for fast responses as long as the method stays in
  	the cache. The cache rewrite relies on lastMethodCacheProbeWrite which is set in
  	addNewMethodToCache:. 
  	Now that the VM flushes function addresses from its tables, the session ID is obsolete,
  	but it is kept for backward compatibility. Also, a failed lookup is reported specially. If a
  	method has been  looked up and not been found, the function address is stored as -1
  	(i.e., the SmallInteger -1 to distinguish from 16rFFFFFFFF which may be returned from
  	lookup), and the primitive fails with PrimErrNotFound."
  	| lit addr moduleName functionName moduleLength functionLength index |
  	<var: #addr declareC: 'void (*addr)()'>
  	
  	"Fetch the first literal of the method"
  	(self literalCountOf: newMethod) > 0 ifFalse:
  		[^self primitiveFailFor: PrimErrBadMethod].
  
  	lit := self literal: 0 ofMethod: newMethod. 
  	"Check if it's an array of length 4"
  	((objectMemory isArray: lit) and: [(objectMemory lengthOf: lit) = 4]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadMethod].
  
  	"Look at the function index in case it has been loaded before"
  	index := objectMemory fetchPointer: 3 ofObject: lit.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadMethod].
  	index := objectMemory integerValueOf: index.
  	"Check if we have already looked up the function and failed."
  	index < 0 ifTrue:
  		["Function address was not found in this session, 
  		  Void the primitive function."
  		 self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
  		 ^self primitiveFailFor: PrimErrNotFound].
  
  	"Try to call the function directly"
  	(index > 0 and: [index <= MaxExternalPrimitiveTableSize]) ifTrue:
  		[addr := externalPrimitiveTable at: index - 1.
  		 addr ~= 0 ifTrue:
  			[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: 'addr' inSmalltalk: [1000 + index]).
  			 self callExternalPrimitive: addr.
  			 ^nil].
  		"if we get here, then an index to the external prim was 
  		kept on the ST side although the underlying prim 
  		table was already flushed"
  		^self primitiveFailFor: PrimErrNamedInternal].
  
  	"Clean up session id and external primitive index"
  	objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero.
  	objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero.
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: lit.
  	moduleName = objectMemory nilObject
  		ifTrue: [moduleLength := 0]
  		ifFalse: [(objectMemory isBytes: moduleName) ifFalse:
  					[self primitiveFailFor: PrimErrBadMethod].
  				moduleLength := objectMemory lengthOf: moduleName].
  	functionName := objectMemory fetchPointer: 1 ofObject: lit.
  	(objectMemory isBytes: functionName) ifFalse:
  		[self primitiveFailFor: PrimErrBadMethod].
  	functionLength := objectMemory lengthOf: functionName.
  
+ 	addr := self ioLoadExternalFunction: functionName + self baseHeaderSize
- 	addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
  				OfLength: functionLength
+ 				FromModule: moduleName + self baseHeaderSize
- 				FromModule: moduleName + BaseHeaderSize
  				OfLength: moduleLength.
  	addr = 0
  		ifTrue: [index := -1]
  		ifFalse: ["add the function to the external primitive table"
  			index := self addToExternalPrimitiveTable: addr].
  
  	"Store the index (or -1 if failure) back in the literal"
  	objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index).
  
  	"If the function has been successfully loaded cache and call it"
  	index >= 0
  		ifTrue:
  			[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: [addr] inSmalltalk: [1000 + index]).
  			self callExternalPrimitive: addr]
  		ifFalse: ["Otherwise void the primitive function and fail"
  			self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
  			^self primitiveFailFor: PrimErrNotFound]!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveFloatAt (in category 'indexing primitives') -----
+ primitiveFloatAt
+ 	"Provide platform-independent access to 32-bit words comprising
+ 	 a Float.  Map index 1 onto the most significant word and index 2
+ 	 onto the least significant word."
+ 	| rcvr index result |
+ 	<var: #result type: #usqInt>
+ 	self initPrimCall.
+ 	rcvr := self stackValue: 1.
+ 	index := self stackTop.
+ 	index = ConstOne ifTrue:
+ 		[result := self positive32BitIntegerFor:
+ 					(objectMemory fetchLong32: (VMBIGENDIAN ifTrue: [0] ifFalse: [1])
+ 						ofObject: rcvr).
+ 		^self pop: 2 thenPush: result].
+ 	index = ConstTwo ifTrue:
+ 		[result := self positive32BitIntegerFor:
+ 					(objectMemory fetchLong32: (VMBIGENDIAN ifTrue: [1] ifFalse: [0])
+ 						ofObject: rcvr).
+ 		^self pop: 2 thenPush: result].
+ 	self primitiveFailFor: ((objectMemory isIntegerObject: index)
+ 							ifTrue: [PrimErrBadIndex]
+ 							ifFalse: [PrimErrBadArgument])!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveFloatAtPut (in category 'indexing primitives') -----
+ primitiveFloatAtPut
+ 	"Provide platform-independent access to 32-bit words comprising
+ 	 a Float.  Map index 1 onto the most significant word and index 2
+ 	 onto the least significant word."
+ 	| rcvr index oopToStore valueToStore |
+ 	<var: #result type: #usqInt>
+ 	self initPrimCall.
+ 	oopToStore := self stackTop.
+ 	valueToStore := self positive32BitValueOf: oopToStore.
+ 	self successful ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
+ 	rcvr := self stackValue: 2.
+ 	index := self stackValue: 1.
+ 	index = ConstOne ifTrue:
+ 		[objectMemory storeLong32: (VMBIGENDIAN ifTrue: [0] ifFalse: [1])
+ 			ofObject: rcvr
+ 			withValue: valueToStore.
+ 		^self pop: 3 thenPush: oopToStore].
+ 	index = ConstTwo ifTrue:
+ 		[objectMemory storeLong32: (VMBIGENDIAN ifTrue: [1] ifFalse: [0])
+ 			ofObject: rcvr
+ 			withValue: valueToStore.
+ 		^self pop: 3 thenPush: oopToStore].
+ 	self primitiveFailFor: ((objectMemory isIntegerObject: index)
+ 							ifTrue: [PrimErrBadIndex]
+ 							ifFalse: [PrimErrBadArgument])!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveInvokeObjectAsMethod (in category 'control primitives') -----
+ primitiveInvokeObjectAsMethod
+ 	"Primitive. 'Invoke' an object like a function, sending the special message 
+ 		run: originalSelector with: arguments in: aReceiver.
+ 	"
+ 	<returnTypeC: #void>
+ 	| runReceiver runArgs lookupClass |
+ 	runArgs := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount.
+ 	argumentCount - 1 to: 0 by: -1  do:
+ 		[:i| objectMemory storePointerUnchecked: i ofObject: runArgs withValue: self popStack].
+ 
+ 	runReceiver := self popStack.
+ 	"setup send of newMethod run: originalSelector with: runArgs in: runReceiver"
+ 	self push: newMethod. "newReceiver"
+ 	self push: messageSelector "original selector".
+ 	self push: runArgs.
+ 	self push: runReceiver.
+ 
+ 	"stack is clean here"
+ 
+ 	messageSelector := objectMemory splObj: SelectorRunWithIn.
+ 	argumentCount := 3.
+ 	lookupClass := objectMemory fetchClassOf: newMethod.
+ 	self findNewMethodInClass: lookupClass.
+ 	self executeNewMethod.  "Recursive xeq affects successFlag"
+ 	self initPrimCall!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitivePerform (in category 'control primitives') -----
  primitivePerform
  	<returnTypeC: #void>
  	| performSelector newReceiver lookupClass performMethod |
  	performSelector := messageSelector.
  	performMethod := newMethod.
  	messageSelector := self stackValue: argumentCount - 1.
  	newReceiver := self stackValue: argumentCount.
  
  	"NOTE: the following lookup may fail and be converted to #doesNotUnderstand:,
  	 so we must adjust argumentCount and slide args now, so that will work."
  
  	"Slide arguments down over selector"
  	argumentCount := argumentCount - 1.
  	argumentCount to: 1 by: -1 do:
  		[:i|
  		stackPages
  			longAt: stackPointer + (i * BytesPerWord)
  			put: (stackPages longAt: stackPointer + ((i - 1) * BytesPerWord))].
  	self pop: 1.
  	lookupClass := objectMemory fetchClassOf: newReceiver.
+ 	self sendBreak: messageSelector + self baseHeaderSize
- 	self sendBreak: messageSelector + BaseHeaderSize
  		point: (objectMemory lengthOf: messageSelector)
  		receiver: newReceiver.
  	self findNewMethodInClass: lookupClass.
  
  	"Only test CompiledMethods for argument count - other objects will have to take their chances"
  	((objectMemory isOopCompiledMethod: newMethod)
  	  and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse:
  		["Slide the args back up (sigh) and re-insert the selector."
  		self unPop: 1.
  		1 to: argumentCount by: 1 do:
  			[:i |
  			stackPages longAt: stackPointer + ((i - 1) * BytesPerWord)
  				put: (stackPages longAt: stackPointer + (i * BytesPerWord))].
  		stackPages longAt: stackPointer + (argumentCount * BytesPerWord) put: messageSelector.
  		argumentCount := argumentCount + 1.
  		newMethod := performMethod.
  		messageSelector := performSelector.
  		^self primitiveFail].
  
  	self executeNewMethod.
  	"Recursive xeq affects primErrorCode"
  	self initPrimCall!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitivePerformInSuperclass (in category 'control primitives') -----
+ primitivePerformInSuperclass
+ 	| lookupClass rcvr currentClass |
+ 	lookupClass := self stackTop.
+ 	rcvr := self stackValue: 3.
+ 	currentClass := objectMemory fetchClassOf: rcvr.
+ 	[currentClass ~= lookupClass] whileTrue:
+ 		[currentClass := self superclassOf: currentClass.
+ 		 currentClass = objectMemory nilObject ifTrue: [^self primitiveFailFor: PrimErrBadArgument]].
+ 
+ 	self primitiveObject: rcvr "a.k.a. self stackValue: 3"
+ 		perform: (self stackValue: 2)
+ 		withArguments: (self stackValue: 1)
+ 		lookedUpIn: lookupClass "a.k.a. self stackTop"!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitivePerformWithArgs (in category 'control primitives') -----
+ primitivePerformWithArgs
+ 
+ 	| lookupClass rcvr |
+ 	rcvr := self stackValue: 2.
+ 	lookupClass := objectMemory fetchClassOf: rcvr.
+ 
+ 	self primitiveObject: rcvr "a.k.a. self stackValue: 2"
+ 		perform: (self stackValue: 1)
+ 		withArguments: self stackTop
+ 		lookedUpIn: lookupClass!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveResume (in category 'process primitives') -----
+ primitiveResume
+ 	"Put this process on the scheduler's lists thus allowing it to proceed next time there is
+ 	 a chance for processes of it's priority level.  It must go to the back of its run queue so
+ 	 as not to preempt any already running processes at this level.  If the process's priority
+ 	 is higher than the current process, preempt the current process."
+ 	| proc |
+ 	proc := self stackTop.  "rcvr"
+ 	(self isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)) ifFalse:
+ 		[^self primitiveFail].
+ 	self resume: proc preemptedYieldingIf: preemptionYields
+ 
+ 	"Personally I would like to check MyList, which should not be one of the elements of the scheduler lists.
+ 	 But there are awful race conditions in things like should:notTakeMoreThan: that mean we can't.
+ 	 eem 9/27/2010 23:08. e.g.
+ 
+ 	| proc myList classLinkedList |
+ 	proc := self stackTop.
+ 	myList := objectMemory fetchPointer: MyListIndex ofObject: proc.
+ 	classLinkedList := self superclassOf: (objectMemory splObj: ClassSemaphore).
+ 	((self fetchClassOfNonInt: myList) ~= classLinkedList
+ 	and: [self isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)]) ifFalse:
+ 		[^self primitiveFail].
+ 	self resume: proc preemptedYieldingIf: preemptionYields"!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveTestAndSetOwnershipOfCriticalSection (in category 'process primitives') -----
+ primitiveTestAndSetOwnershipOfCriticalSection
+ 	"Attempt to test-and-set the ownership of the critical section.  If not owned,
+ 	 set the owner to the current process and answer false. If owned by the
+ 	 current process answer true.  If owned by some other process answer nil.
+ 	 For simulation if there is an argument it is taken to be the effective activeProcess
+ 	 (see Process>>effectiveProcess)."
+ 	| criticalSection owningProcessIndex owningProcess activeProc |
+ 	argumentCount > 0
+ 		ifTrue:
+ 			[criticalSection := self stackValue: 1.  "rcvr"
+ 			 activeProc := self stackTop]
+ 		ifFalse:
+ 			[criticalSection := self stackTop.  "rcvr"
+ 			 activeProc := self activeProcess].
+ 	owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores"
+ 	owningProcess := objectMemory fetchPointer: owningProcessIndex ofObject: criticalSection.
+ 	owningProcess = objectMemory nilObject ifTrue:
+ 		[objectMemory storePointer: owningProcessIndex
+ 			ofObject: criticalSection
+ 			withValue: activeProc.
+ 		 ^self pop: argumentCount + 1 thenPush: objectMemory falseObject].
+ 	owningProcess = activeProc ifTrue:
+ 		[^self pop: argumentCount + 1 thenPush: objectMemory trueObject].
+ 	self pop: argumentCount + 1 thenPush: objectMemory nilObject!

Item was removed:
- ----- Method: TAssignmentNode>>isStructTarget: (in category 'testing') -----
- isStructTarget: aCodeGen
- 	"Answer if the recever evaluates to a struct pointer
- 	 and hence can be dereferenced using ->"
- 	^variable isStructTarget: aCodeGen!

Item was added:
+ ----- Method: TAssignmentNode>>structTargetKind: (in category 'testing') -----
+ structTargetKind: aCodeGen
+ 	"Answer if the recever evaluates to a struct or struct pointer
+ 	 and hence can be dereferenced using . or ->.  Answer any of
+ 	 #struct #pointer or nil"
+ 	^variable structTargetKind: aCodeGen!

Item was changed:
  ----- Method: TMethod>>emitCFunctionPrototype:generator: (in category 'C code generation') -----
  emitCFunctionPrototype: aStream generator: aCodeGen
  	"Emit a C function header for this method onto the given stream."
  
+ 	properties ifNotNil:
+ 		[(properties at: #api: ifAbsent: []) ifNotNil:
+ 			[:pragma|
+ 			aStream nextPutAll: (pragma argumentAt: 1).
+ 			^self]].
+ 	self emitCFunctionPrototype: aStream generator: aCodeGen newlineBeforeName: false!
- 	| arg |
- 	export 
- 		ifTrue:[aStream nextPutAll:'EXPORT('; nextPutAll: returnType; nextPutAll:') ']
- 		ifFalse:[(self isStaticIn: aCodeGen)
- 					ifTrue:[aStream nextPutAll:'static '].
- 				aStream nextPutAll: returnType; space].
- 	aStream nextPutAll: (aCodeGen cFunctionNameFor: self selectorForCodeGeneration), '('.
- 	args isEmpty ifTrue: [ aStream nextPutAll: 'void' ].
- 	1 to: args size do: [ :i |
- 		arg := args at: i.
- 		(declarations includesKey: arg) ifTrue: [
- 			aStream nextPutAll: (declarations at: arg).
- 		] ifFalse: [
- 			aStream nextPutAll: 'sqInt ', (args at: i).
- 		].
- 		i < args size ifTrue: [ aStream nextPutAll: ', ' ].
- 	].
- 	aStream nextPutAll: ')'.!

Item was added:
+ ----- Method: TMethod>>emitCFunctionPrototype:generator:newlineBeforeName: (in category 'C code generation') -----
+ emitCFunctionPrototype: aStream generator: aCodeGen newlineBeforeName: newlineBeforeName "<Boolean>"
+ 	"Emit a C function header for this method onto the given stream."
+ 
+ 	export 
+ 		ifTrue:[aStream nextPutAll: 'EXPORT('; nextPutAll: returnType; nextPut: $)]
+ 		ifFalse:[(self isStaticIn: aCodeGen) ifTrue:[aStream nextPutAll: 'static '].
+ 				aStream nextPutAll: returnType].
+ 	newlineBeforeName ifTrue: [aStream cr] ifFalse: [aStream space].
+ 	(returnType last = $)
+ 	and: [returnType includesSubString: (aCodeGen cFunctionNameFor: self selectorForCodeGeneration)]) ifTrue:
+ 		["Hack fix for e.g. <returnTypeC: 'void (*setInterruptCheckChain(void (*aFunction)(void)))()'>"
+ 		 ^self].
+ 	aStream
+ 		nextPutAll: (aCodeGen cFunctionNameFor: self selectorForCodeGeneration);
+ 		nextPut: $(.
+ 	args isEmpty
+ 		ifTrue: [aStream nextPutAll: #void]
+ 		ifFalse:
+ 			[args
+ 				do: [:arg| aStream nextPutAll: (self declarationAt: arg)]
+ 				separatedBy: [ aStream nextPutAll: ', ' ]].
+ 	aStream nextPut: $)!

Item was added:
+ ----- Method: TMethod>>extractExpandCaseDirective (in category 'transformations') -----
+ extractExpandCaseDirective
+ 	"Scan the top-level statements for an inlining directive of the form:
+ 		self expandCases
+ 	 and remove the directive from the method body. Answer whether
+ 	 there was such a directive."
+ 
+ 	^self
+ 		extractDirective: #expandCases
+ 		valueBlock: [:sendNode| true]
+ 		default: false!

Item was changed:
  ----- Method: TMethod>>extractStaticDirective (in category 'transformations') -----
  extractStaticDirective
  	"Scan the top-level statements for an inlining directive of the form:
  
  		self static: <boolean>
  
+ 	and remove the directive from the method body. Answer the argument of the
+ 	directive. If there is no static directive, answer true if this is an api method,
+ 	otherwise answer nil for undefined. The code generator may determine the
+ 	static declaration when undefined."
- 	 and remove the directive from the method body. Return the argument of the directive or true if there is no static directive."
  
- 	| result newStatements methodDirectiveFound default |
- 	result := true.
- 	methodDirectiveFound := false.
- 	newStatements := OrderedCollection new: parseTree statements size.
- 	parseTree statements do: [ :stmt |
- 		(stmt isSend and: [stmt selector = #static:]) ifTrue: [
- 			methodDirectiveFound := true.
- 			result := stmt args first value ~= false.
- 		] ifFalse: [
- 			newStatements add: stmt.
- 		].
- 	].
- 	parseTree setStatements: newStatements asArray.
- 	methodDirectiveFound ifTrue: [^ result].
- 	"No method declaration was used, so check for a pragma declaration.
- 	If not explicitly specified, default is nil and may be determined by the
- 	code generator."
- 	default := (export
- 					or: [(properties includesKey: #api)
- 							or: [properties includesKey: #api:]])
- 				ifTrue: [false].
  	^self
  		extractDirective: #static:
  		valueBlock: [:sendNode| sendNode args first value ~= false]
+ 		default: (((properties includesKey: #api) or: [properties includesKey: #api:])
+ 					ifTrue: [false] "api methods cannot be declared static"
+ 					ifFalse: [nil]) "undefined, defer to the code generator for default"!
- 		default: default
- 	!

Item was added:
+ ----- Method: TMethod>>static: (in category 'accessing') -----
+ static: aBoolean
+ 	static := aBoolean!

Item was removed:
- ----- Method: TParseNode>>isStructTarget: (in category 'testing') -----
- isStructTarget: aCodeGen
- 	"Answer if the recever evaluates to a struct pointer
- 	 and hence can be dereferenced using ->"
- 	^false!

Item was added:
+ ----- Method: TParseNode>>structTargetKind: (in category 'testing') -----
+ structTargetKind: aCodeGen
+ 	"Answer if the recever evaluates to a struct or struct pointer
+ 	 and hence can be dereferenced using . or ->.  Answer any of
+ 	 #struct #pointer or nil"
+ 	^nil!

Item was changed:
+ ----- Method: TSendNode>>copyTree (in category 'accessing') -----
- ----- Method: TSendNode>>copyTree (in category 'as yet unclassified') -----
  copyTree
  
  	^self class new
  		setSelector: selector
  		receiver: receiver copyTree
  		arguments: (arguments collect: [ :arg | arg copyTree ])
  		isBuiltInOp: isBuiltinOperator!

Item was changed:
+ ----- Method: TSendNode>>inlineMethodsUsing: (in category 'C code generation') -----
- ----- Method: TSendNode>>inlineMethodsUsing: (in category 'as yet unclassified') -----
  inlineMethodsUsing: aDictionary
  
  	arguments := arguments collect: [ :arg |
  		arg inlineMethodsUsing: aDictionary.
  	].
  	"xxx inline this message if it is in the dictionary xxx"!

Item was changed:
+ ----- Method: TSendNode>>isDirective (in category 'testing') -----
- ----- Method: TSendNode>>isDirective (in category 'as yet unclassified') -----
  isDirective
  	"Preprocessor directive, e.g. a cpp macro"
  
  	^ {	#preprocessorExpression: .
  		#isDefined:inSmalltalk:comment:ifTrue:ifFalse: .
  		#isDefined:inSmalltalk:comment:ifTrue: .
+ 		#isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse: .
+ 		#cPreprocessorDirective:
- 		#isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse:
  		} identityIncludes: selector!

Item was changed:
  ----- Method: TSendNode>>isStructSend: (in category 'testing') -----
  isStructSend: aCodeGen
  	"Answer if the recever is a send of a structure accessor.
  	 This is tricky.  We want
  		foo bar => foo->bar
+ 		foo bar => foo.bar
  		foo bar: expr => foo->bar = expr
+ 		foo bar: expr => foo.bar = expr
+ 	 depending on whether foo is a struct or a pointer to a struct,
  	 but only if both foo is a struct type and bar is a field accessor.
  	 The tricky cases are self-sends within struct class methods.  Here we need to
  	 distinguish between self-sends of ordinary methods from self sends of accessors."
  	^arguments size <= 1
+ 	   and: [(receiver structTargetKind: aCodeGen) notNil
- 	   and: [(receiver isStructTarget: aCodeGen)
  	   and: [(aCodeGen methodNamed: selector)
  				ifNil: [false]
  				ifNotNil: [:method| method isStructAccessor]]]!

Item was removed:
- ----- Method: TSendNode>>isStructTarget: (in category 'testing') -----
- isStructTarget: aCodeGen
- 	"Answer if the recever evaluates to a struct pointer
- 	 and hence can be dereferenced using ->"
- 	selector == #cCoerceSimple:to: ifTrue:
- 		[^aCodeGen isTypePointerToStruct: arguments last value].
- 
- 	^aCodeGen selectorReturnsPointerToStruct: selector!

Item was changed:
+ ----- Method: TSendNode>>printOn:level: (in category 'testing') -----
- ----- Method: TSendNode>>printOn:level: (in category 'as yet unclassified') -----
  printOn: aStream level: level
  
  	| keywords |
  	receiver printOn: aStream level: level.
  	arguments size = 0 ifTrue: [
  		aStream space; nextPutAll: selector.
  		^self
  	].
  	keywords := selector keywords.
  	1 to: keywords size do: [ :i |
  		aStream space.
  		aStream nextPutAll: (keywords at: i); space.
  		(arguments at: i) printOn: aStream level: level + 1.
  	].!

Item was changed:
+ ----- Method: TSendNode>>requiresCLineTerminator (in category 'testing') -----
- ----- Method: TSendNode>>requiresCLineTerminator (in category 'as yet unclassified') -----
  requiresCLineTerminator
  
  	^ (self isComment or: [self isDirective]) not
  !

Item was added:
+ ----- Method: TSendNode>>structTargetKind: (in category 'testing') -----
+ structTargetKind: aCodeGen
+ 	"Answer if the recever evaluates to a struct or struct pointer
+ 	 and hence can be dereferenced using . or ->.  Answer any of
+ 	 #struct #pointer or nil.  Right now we don't need or support
+ 	 structure return so this method answers either #pointer or nil."
+ 	selector == #cCoerceSimple:to: ifTrue:
+ 		[^(VMStructType isTypePointerToStruct: arguments last value) ifTrue:
+ 			[#pointer]].
+ 
+ 	^(aCodeGen selectorReturnsPointerToStruct: selector) ifTrue:
+ 		[#pointer]!

Item was removed:
- ----- Method: TVariableNode>>isStructTarget: (in category 'testing') -----
- isStructTarget: aCodeGen
- 	"Answer if the recever is a struct pointer
- 	 and hence can be dereferenced using ->"
- 	^aCodeGen isPointerToStructVariableName: name!

Item was added:
+ ----- Method: TVariableNode>>structTargetKind: (in category 'testing') -----
+ structTargetKind: aCodeGen
+ 	"Answer if the recever evaluates to a struct or struct pointer
+ 	 and hence can be dereferenced using . or ->.  Answer any of
+ 	 #struct #pointer or nil"
+ 	^aCodeGen structTargetKindForVariableName: name!

Item was added:
+ ----- Method: VMClass class>>ancilliaryClasses (in category 'translation') -----
+ ancilliaryClasses
+ 	"Answer any extra classes to be included in the translation."
+ 	^#()!

Item was added:
+ ----- Method: VMClass class>>ancilliaryStructClasses (in category 'translation') -----
+ ancilliaryStructClasses
+ 	^#()!

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

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 vmClass: self interpreterClass.
  	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)].
  !

Item was changed:
  ----- Method: VMStructType class>>printTypedefOn: (in category 'translation') -----
  printTypedefOn: aStream
  	aStream nextPutAll: 'typedef struct '.
  	self needsTypeTag ifTrue:
  		[aStream nextPutAll: self structTagName; space].
  	aStream nextPut: ${; cr.
  	self instVarNamesAndTypesForTranslationDo:
+ 		[:ivn :typeArg| | type |
- 		[:ivn :typeArg| | type index |
  		type := typeArg.
- 		(index := type indexOf: #BytesPerWord ifAbsent: 0) > 0 ifTrue:
- 			[type := (type at: index + 1) = BytesPerWord 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 = $: ifTrue:
  						[aStream space].
  					 aStream
  						nextPutAll: type last;
  						nextPut: $;;
  						cr]
  				ifFalse:
  					[aStream tab: 1.
  					aStream nextPutAll: type.
  					(type last isSeparator or: [type last = $*]) ifFalse:
  						[aStream tab: 1].
  					 aStream
  						nextPutAll: ivn;
  						nextPut: $;;
  						cr]]].
  	aStream
  		nextPutAll: ' } ';
  		nextPutAll: self structTypeName;
  		nextPut: $;;
  		cr.
  	self name ~= self structTypeName ifTrue:
  		[aStream cr; nextPutAll: '#define '; nextPutAll: self name; space; nextPutAll: self structTypeName; cr].
  	aStream flush!



More information about the Vm-dev mailing list