[Vm-dev] VM Maker: VMMaker.oscog-eem.1205.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Apr 17 19:11:20 UTC 2015


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1205.mcz

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

Name: VMMaker.oscog-eem.1205
Author: eem
Time: 17 April 2015, 12:09:11.953 pm
UUID: e6bba287-15f1-427b-ad63-4a84f10b3122
Ancestors: VMMaker.oscog-eem.1204

Save a version of VMMaker.oscog-eem.1208 that
isn't subject to regressions caused in recent wizard
experiments in improving #== code in the VM.

Head slap!  Fix the copy-paste error that caused
the regression in VMMaker.oscog-eem.1160/3308.

Fix tiny formatting issue.

Don't merge with VMMaker.oscog-cb.1205 et al yet;
they have changes that are as yet incomplete and
incorrect.

=============== Diff against VMMaker.oscog-eem.1204 ===============

Item was changed:
  ----- Method: Cogit>>markLiteralsAndUnlinkIfUnmarkedSend:pc:method: (in category 'garbage collection') -----
  markLiteralsAndUnlinkIfUnmarkedSend: annotation pc: mcpc method: cogMethod
  	"Mark and trace literals.  Unlink sends that have unmarked cache tags or targets."
  	<var: #mcpc type: #'char *'>
  	<var: #nsSendCache type: #'NSSendCache *'>
  	| literal |
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asUnsignedInteger.
  		 (objectRepresentation
  				markAndTraceLiteral: literal
  				in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  				atpc: mcpc asUnsignedInteger) ifTrue:
  			[codeModified := true]].
  
  	self cppIf: NewspeakVM ifTrue:
  		[annotation = IsNSSendCall ifTrue:
  			[| nsSendCache entryPoint targetMethod sel eo |
  			nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  			entryPoint := nsSendCache target.
  			entryPoint ~= 0 ifTrue: "Send is linked"
  				[targetMethod := entryPoint - cmNoCheckEntryOffset.
  				 (self markAndTraceOrFreeCogMethod: targetMethod
  					firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger) ifTrue:	
  						[self voidNSSendCache: nsSendCache]].
  			sel := nsSendCache selector.
  			(objectMemory isForwarded: sel)
  				ifFalse: [objectMemory markAndTrace: sel]
  				ifTrue: [sel := objectMemory followForwarded: literal.
  						nsSendCache selector: sel.
  						self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
  			eo := nsSendCache enclosingObject.
  			eo ~= 0 ifTrue:
  				[(objectMemory isForwarded: eo)
  					ifFalse: [objectMemory markAndTrace: eo]
  					ifTrue: [eo := objectMemory followForwarded: literal.
  							nsSendCache enclosingObject: eo.
  							self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
  
+ 	(self isPureSendAnnotation: annotation) ifTrue:
- 	annotation = IsNSSendCall ifTrue:
  		[self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:entryPoint :cacheTag :tagCouldBeObj | | cacheTagMarked |
- 			 self assert: annotation ~= IsNSSendCall.
  			 cacheTagMarked := tagCouldBeObj and: [objectRepresentation cacheTagIsMarked: cacheTag].
  			 entryPoint > methodZoneBase
  				ifTrue: "It's a linked send."
  					[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  						[:targetMethod :sendTable| 
  						 (cacheTagMarked not
  						  or: [self markAndTraceOrFreeCogMethod: targetMethod
  								firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger]) ifTrue:
  							["Either the cacheTag is unmarked (e.g. new class) or the target
  							  has been freed (because it is unmarked), so unlink the send."
  							 self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable.
  							 objectRepresentation
  								markAndTraceLiteral: targetMethod selector
  								in: targetMethod
  								at: (self addressOf: targetMethod selector put: [:val| targetMethod selector: val])]]]
  				ifFalse:  "cacheTag is selector"
  					[(objectRepresentation
  							markAndTraceCacheTagLiteral: cacheTag
  							in: cogMethod
  							atpc: mcpc asUnsignedInteger) ifTrue:
  						[codeModified := true]]]].
  
  	^0 "keep scanning"!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>marryFrameCopiesTemps (in category 'frame access') -----
+ marryFrameCopiesTemps
+ 	^ false!

Item was changed:
  ----- Method: StackInterpreter>>extJumpIfNotInstanceOfBehaviorsOrPopBytecode (in category 'sista bytecodes') -----
  extJumpIfNotInstanceOfBehaviorsOrPopBytecode
  	"254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
  	| tosClassTag literal distance |
  	tosClassTag := objectMemory fetchClassTagOf: self internalStackTop.
  	literal := self literal: extA << 8 + self fetchByte.
  	distance := extB << 8 + self fetchByte.
  	extA := 0.
  	extB := 0.
  	(objectMemory isArrayNonImm: literal)
  		ifTrue:
+ 			[0 to: (objectMemory numSlotsOf: literal) asInteger - 1 do: [:i |
+ 				tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal))
+ 					ifTrue: 
+ 						[ self internalPopStack.
+ 						^ self fetchNextBytecode ] ].
+ 			localIP := localIP + distance.
+ 				^ self fetchNextBytecode]
- 			[| i |
- 			 i := (objectMemory numSlotsOf: literal) asInteger.
- 			 [(i := i -1) < 0
- 			  or: [tosClassTag = (objectMemory rawClassTagForClass: (objectMemory fetchPointer: i ofObject: literal))]] whileTrue.
- 			 i < 0 ifTrue:
- 				[localIP := localIP + distance.
- 				^ self fetchNextBytecode]]
  		ifFalse:
  			[tosClassTag ~= (objectMemory rawClassTagForClass: literal) ifTrue:
  				[localIP := localIP + distance.
  				^ self fetchNextBytecode]].
  	self internalPopStack.
  	self fetchNextBytecode!



More information about the Vm-dev mailing list