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

commits at source.squeak.org commits at source.squeak.org
Fri Oct 25 17:54:01 UTC 2013


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

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

Name: VMMaker.oscog-eem.476
Author: eem
Time: 25 October 2013, 10:50:52.165 am
UUID: b85d6f3c-f210-480d-883f-fbcc1be321d5
Ancestors: VMMaker.oscog-eem.475

Fix cascades to structs.  Can't copy a struct and update the copy.
Must take the address of the struct and indirect through it.  This
was causing C not to update the first segment's segStart.

Fix SpurMemoryManager>>startOfMemory for C regime.

Make a few methods non-inline for C-level debugging, etc.

Make the primitive table creation code filter-out option: primitives
with the wrong option:.

Fix renaming of declarations and hence don't remove methods
with declarations from the inlinable methods.

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

Item was changed:
  ----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
  
  	| swapBytes headerStart headerSize dataSize oldBaseAddr
  	  minimumMemory heapSize bytesRead bytesToShift
  	  hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize firstSegSize |
  	<var: #f type: 'sqImageFile '>
  	<var: #memStart type: 'usqInt'>
  	<var: #desiredHeapSize type: 'usqInt'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #dataSize type: 'size_t '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
  	metaclassNumSlots := 6.	"guess Metaclass instSize"
+ 	classNameIndex := 6.		"guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B.  not used."
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags			:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory		:= self getLongFromFile: f swap: swapBytes. "N.B.  not used."
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default.  Can be changed via vmParameterAt: 43 put: n.
  	 Can be set as a preference (Info.plist, VM.ini, command line etc).
  	 If desiredNumStackPages is already non-zero then it has been
  	 set as a preference.  Ignore (but preserve) the header's default."
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
  	hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
  	cogCodeSize := desiredCogCodeSize ~= 0
  						ifTrue: [desiredCogCodeSize]
  						ifFalse:
  							[hdrCogCodeSize = 0
  									ifTrue: [self defaultCogCodeSize]
  									ifFalse: [hdrCogCodeSize]].
  	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to other VMs."
  	the2ndUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	firstSegSize := self getLongFromFile: f swap: swapBytes.
  	objectMemory firstSegmentSize: firstSegSize.
  
  	"compare memory requirements with availability"
  	minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ dataSize
  						+ objectMemory newSpaceBytes
  						+ self interpreterAllocationReserveBytes.
  	heapSize             :=  cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ desiredHeapSize
  						"+ edenBytes" "don't include edenBytes; this is part of the heap and so part of desiredHeapSize"
  						+ self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize) asUnsignedInteger.
  	
  	objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
  	heapBase := objectMemory memory + cogCodeSize.
  	self assert: objectMemory startOfMemory = heapBase.
  	objectMemory
  		setHeapBase: heapBase
  		memoryLimit: objectMemory memory + heapSize - 24  "decrease memoryLimit a tad for safety (?!!?!!? eem eem 10/9/2013 15:15)"
  		endOfMemory: heapBase + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	self initializeCodeGenerator.
  	^dataSize!

Item was changed:
  ----- Method: ObjectMemory>>followForwardedObjectFields:toDepth: (in category 'spur compatibility') -----
  followForwardedObjectFields: objOop toDepth: depth
+ 	<inline: false>
  	self shouldNotImplement!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>startOfMemory (in category 'accessing') -----
+ startOfMemory
+ 	"Return the start of object memory.  This is immediately after the native code zone.
+ 	 N.B. the stack zone is alloca'ed. Use a macro so as not to punish the debug VM."
+ 	<cmacro: '() heapBase'>
+ 	<returnTypeC: #usqInt>
+ 	^coInterpreter heapBase!

Item was changed:
  ----- Method: SpurMemoryManager>>startOfMemory (in category 'accessing') -----
  startOfMemory
+ 	"Return the start of object memory. Use a macro so as not to punish the debug VM."
+ 	<cmacro: '() memory'>
- 	"Return the start of object memory.  This is immediately after the native code zone."
  	<returnTypeC: #usqInt>
+ 	^0!
- 	<cmacro: '() GIV(startOfMemory)'>
- 	^startOfMemory ifNil: [0]!

Item was changed:
  ----- Method: SpurSegmentManager>>adjustSegmentSwizzlesBy: (in category 'snapshot') -----
  adjustSegmentSwizzlesBy: firstSegmentShift
+ 	"Adjust swizzles by firstSegmentShift.  Also computes segStarts as
+ 	 they were in the image when it was written, so that oops' segments
+ 	 can be determined and hence oops correctly swizzled."
+ 	<inline: false>
- 	"Adjust swizzles by firstSegmentShift."
  	<var: 'segInfo' type: 'SpurSegmentInfo *'>
  	| oldBaseAddr |
  	oldBaseAddr := manager memoryBaseForImageRead - firstSegmentShift.
  	0 to: numSegments - 1 do:
  		[:i| | segInfo |
  		 segInfo := self addressOf: (segments at: i).
  		 segInfo
  			segStart: segInfo segStart + oldBaseAddr;
  			swizzle: segInfo swizzle - oldBaseAddr].
  	canSwizzle := true!

Item was changed:
  ----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') -----
  collapseSegmentsPostSwizzle
+ 	"The image has been loaded, old segments reconstructed, and the heap
+ 	 swizzled into a single contiguous segment.  Collapse the segments into one."
+ 	<inline: false>
- 	"The image has been loaded, old segments reconstructed, and the
- 	  loaded image swizzled into a single contiguous segment.  Collapse
- 	  the segments intio one."
  	| bridge |
  	canSwizzle := false.
  	firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image"
+ 		[^nil].
- 		[^self].
  
  	numSegments := 1.
  	(segments at: 0)
  		segStart: manager newSpaceLimit;
  		segSize: manager endOfMemory - manager newSpaceLimit.
  	"finally plant a bridge at the end of the coalesced segment and cut back the
  	 manager's notion of the end of memory to immediately before the bridge."
  	bridge := manager endOfMemory - manager bridgeSize.
  	self assert: bridge = ((segments at: 0) segStart
  						  + (segments at: 0) segSize
+ 						  -  manager bridgeSize).
- 						  -  (manager bridgeSize)).
  	manager
  		initSegmentBridgeWithBytes: manager bridgeSize at: bridge;
  		setEndOfMemory: bridge!

Item was changed:
  ----- Method: SpurSegmentManager>>readHeapFromImageFile:dataBytes: (in category 'snapshot') -----
  readHeapFromImageFile: f dataBytes: numBytes
  	"Read numBytes of image data from f into memory at memoryBaseForImageRead.
  	 Answer the number of bytes written.  In addition, read each segment, build up the
  	 segment info, while eliminating the bridge objects that end each segment and
  	 give the size of the subsequent segment."
+ 	<inline: false>
  	| bytesRead totalBytesRead bridge nextSegmentSize oldBase newBase segInfo bridgeSpan |
  	<var: 'segInfo' type: 'SpurSegmentInfo *'>
  	self allocateOrExtendSegmentInfos.
  
  	"segment sizes include the two-header-word bridge at the end of each segment."
  	numSegments := totalBytesRead := 0.
  	oldBase := 0. "N.B. still must be adjusted by oldBaseAddr."
  	newBase := manager newSpaceLimit.
  	nextSegmentSize := firstSegmentSize.
  	bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
  	[segInfo := self addressOf: (segments at: numSegments).
  	 segInfo
  		segStart: oldBase;					"N.B. still must be adjusted by oldBaseAddr."
  		segSize: nextSegmentSize;
  		swizzle: newBase - oldBase.	"N.B. still must be adjusted by oldBaseAddr."
  	 bytesRead := self readHeapFrom: f at: newBase dataBytes: nextSegmentSize.
  	 bytesRead > 0 ifTrue:
  			[totalBytesRead := totalBytesRead + bytesRead].
  	 bytesRead ~= nextSegmentSize ifTrue:
  		[^totalBytesRead].
  	 numSegments := numSegments + 1.
  	 bridgeSpan := manager bytesPerSlot * (manager rawOverflowSlotsOf: bridge).
  	 oldBase := oldBase + nextSegmentSize + bridgeSpan.
  	 newBase := newBase + nextSegmentSize - manager bridgeSize.
  	 nextSegmentSize := manager longLongAt: bridge.
  	 nextSegmentSize ~= 0] whileTrue:
  		[bridge := bridge - manager bridgeSize + nextSegmentSize].
  	"newBase should point just past the last bridge. all others should have been eliminated."
  	self assert: newBase - manager newSpaceLimit
  				= (totalBytesRead - (numSegments * manager bridgeSize)).
  	"set freeOldSpaceStart now for adjustAllOopsBy:"
  	manager setFreeOldSpaceStart: newBase.
  	^totalBytesRead!

Item was changed:
  ----- Method: StackInterpreter class>>table:from: (in category 'initialization') -----
  table: anArray from: specArray 
  	"SpecArray is an array of one of (index selector) or (index1 
  	 index2 selector) or (index nil) or (index1 index2 nil).  If selector
  	 then the entry is the selector, but if nil the entry is the index."
  	| contiguous |
  	contiguous := 0.
  	specArray do:
  		[:spec | 
  		(spec at: 1) = contiguous ifFalse:
  			[self error: 'Non-contiguous table entry'].
  		spec size = 2
  			ifTrue:
  				[anArray
  					at: (spec at: 1) + 1
  					put: ((spec at: 2) ifNil: [spec at: 1] ifNotNil: [:sym| sym]).
  				 contiguous := contiguous + 1]
  			ifFalse:
  				[(spec at: 1) to: (spec at: 2) do:
  					[:i | anArray at: i + 1 put: ((spec at: 3) ifNil: [i] ifNotNil: [:sym| sym])].
+ 				 contiguous := contiguous + ((spec at: 2) - (spec at: 1)) + 1]].
+ 	anArray doWithIndex:
+ 		[:entry :index|
+ 		(self whichClassIncludesSelector: entry) ifNotNil:
+ 			[:c| | m |
+ 			m := c >> entry.
+ 			(m pragmaAt: #option:) ifNotNil:
+ 				[:pragma|
+ 				(initializationOptions at: (pragma arguments first) ifAbsent: [true]) ifFalse:
+ 					[anArray at: index put: 0]]]]!
- 				 contiguous := contiguous + ((spec at: 2) - (spec at: 1)) + 1]]!

Item was changed:
  ----- Method: StackInterpreter>>checkImageVersionFrom:startingAt: (in category 'image save/restore') -----
  checkImageVersionFrom: f startingAt: imageOffset
  	"Read and verify the image file version number and return true if the the given image file needs to be byte-swapped. As a side effect, position the file stream just after the version number of the image header. This code prints a warning and does a hard-exit if it cannot find a valid version number."
  	"This code is based on C code by Ian Piumarta."
  
+ 	<inline: false>
  	| version firstVersion |
  	<var: #f type: 'sqImageFile '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
  	"check the version number"
  	self sqImageFile: f Seek: imageOffset.
  	version := firstVersion := self getLongFromFile: f swap: false.
  	(self readableFormat: version) ifTrue: [^ false].
  
  	"try with bytes reversed"
  	self sqImageFile: f Seek: imageOffset.
  	version := self getLongFromFile: f swap: true.
  	(self readableFormat: version) ifTrue: [^ true].
  
  	"Note: The following is only meaningful if not reading an embedded image"
  	imageOffset = 0 ifTrue:[
  		"try skipping the first 512 bytes (prepended by certain Mac file transfer utilities)"
  		self sqImageFile: f Seek: 512.
  		version := self getLongFromFile: f swap: false.
  		(self readableFormat: version) ifTrue: [^ false].
  
  		"try skipping the first 512 bytes with bytes reversed"
  		self sqImageFile: f Seek: 512.
  		version := self getLongFromFile: f swap: true.
  		(self readableFormat: version) ifTrue: [^ true]].
  
  	"hard failure; abort"
  	self print: 'This interpreter (vers. '.
  	self printNum: self imageFormatVersion.
  	self print: ') cannot read image file (vers. '.
  	self printNum: firstVersion.
  	self print: ').'.
  	self cr.
  	self print: 'Press CR to quit...'.
  	self getchar.
  	self ioExitWithErrorCode: 1.
  	^false!

Item was changed:
  ----- Method: StackInterpreter>>handleForwardedSelectorFaultFor: (in category 'message sending') -----
  handleForwardedSelectorFaultFor: selectorOop
  	"Handle a send fault that is due to a send using a forwarded selector.
  	 Unforward the selector and follow the current method and special
  	 selectors array to unforward the source of the forwarded selector."
+ 	<inline: false>
  	self assert: (objectMemory isOopForwarded: selectorOop).
  
  	objectMemory
  		followForwardedObjectFields: method
  			toDepth: 0;
  		followForwardedObjectFields: (objectMemory splObj: SpecialSelectors)
  			toDepth: 0.
  	^objectMemory followForwarded: selectorOop!

Item was changed:
  ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
  longPrintOop: oop
  	<api>
+ 	| fmt lastIndex startIP bytecodesPerLine column |
- 	| class fmt lastIndex startIP bytecodesPerLine column |
  	((objectMemory isImmediate: oop)
  	 or: [(objectMemory addressCouldBeObj: oop) not
  	 or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  	 or: [(objectMemory isFreeObject: oop)
  	 or: [objectMemory isForwarded: oop]]]]) ifTrue:
  		[^self printOop: oop].
+ 	self printHex: oop.
+ 	(objectMemory fetchClassOfNonImm: oop)
+ 		ifNil: [self print: ' has a nil class!!!!']
+ 		ifNotNil: [:class|
+ 			self print: ': a(n) '; printNameOfClass: class count: 5;
+ 				print: ' ('; printHex: class; print: ')'].
- 	class := objectMemory fetchClassOfNonImm: oop.
- 	self printHex: oop;
- 		print: ': a(n) '; printNameOfClass: class count: 5;
- 		print: ' ('; printHex: class; print: ')'.
  	fmt := objectMemory formatOf: oop.
  	self print: ' format '; printHexnp: fmt.
  	fmt > objectMemory lastPointerFormat
  		ifTrue: [self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)]
  		ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
  					[| len |
  					len := objectMemory lengthOf: oop.
  					self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
  	objectMemory printHeaderTypeOf: oop.
  	self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop).
  	self cr.
  	(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  		[^self].
  	"this is nonsense.  apologies."
  	startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
  	lastIndex := 256 min: startIP.
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:i| | fieldOop |
  			fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
  			self space; printNum: i - 1; space; printHex: fieldOop; space.
  			(i = 1 and: [objectMemory isCompiledMethod: oop])
  				ifTrue: [self printMethodHeaderOop: fieldOop]
  				ifFalse: [self cCode: [self printOopShort: fieldOop]
  							inSmalltalk: [self print: (self shortPrint: fieldOop)]].
  			self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * BytesPerWord + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
  					[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
  						inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", byte,byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
  
  	| swapBytes headerStart headerSize dataSize oldBaseAddr hdrNumStackPages
  	  minimumMemory heapBase bytesRead bytesToShift heapSize hdrEdenBytes
  	  headerFlags hdrMaxExtSemTabSize firstSegSize |
  	<var: #f type: 'sqImageFile '>
  	<var: #heapBase type: 'usqInt'>
  	<var: #desiredHeapSize type: 'usqInt'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #dataSize type: 'size_t '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
  	metaclassNumSlots := 6.	"guess Metaclass instSize"
+ 	classNameIndex := 6.		"guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B.  not used."
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags		:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory	:= self getLongFromFile: f swap: swapBytes.
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default.  Can be changed via vmParameterAt: 43 put: n.
  	 Can be set as a preference (Info.plist, VM.ini, command line etc).
  	 If desiredNumStackPages is already non-zero then it has been
  	 set as a preference.  Ignore (but preserve) the header's default."
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 It is used for the cog code size in Cog.  Preserve it to be polite to other VMs."
  	theUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to other VMs."
  	the2ndUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	firstSegSize := self getLongFromFile: f swap: swapBytes.
  	objectMemory firstSegmentSize: firstSegSize.
  	"decrease Squeak object heap to leave extra memory for the VM"
  	heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
  
  	"compare memory requirements with availability".
  	minimumMemory := dataSize + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap"
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize) asUnsignedInteger.
  	objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
  
+ 	heapBase := objectMemory memory.
- 	heapBase := objectMemory startOfMemory.
  	objectMemory
  		setHeapBase: heapBase
  		memoryLimit: (heapBase + heapSize) - 24  "decrease memoryLimit a tad for safety"
  		endOfMemory: heapBase + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	^dataSize!

Item was changed:
  ----- Method: StackInterpreterSimulator>>shortPrint: (in category 'debug support') -----
  shortPrint: oop
  	| name classOop |
  	(objectMemory isImmediate: oop) ifTrue:
  		[(objectMemory isImmediateCharacter: oop) ifTrue:
  			[^ '=$' , (objectMemory characterValueOf: oop) printString , 
  			' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')'].
  		(objectMemory isIntegerObject: oop) ifTrue:
  			[^ '=' , (objectMemory integerValueOf: oop) printString , 
  			' (' , (objectMemory integerValueOf: oop) hex , ')'].
  		^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  			ifTrue: [' is misaligned']
  			ifFalse: [' is not on the heap']].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
  	(objectMemory isForwarded: oop) ifTrue:
  		[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
  			' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
  	classOop := objectMemory fetchClassOfNonImm: oop.
+ 	classOop ifNil: [^' has a nil class!!!!'].
  	(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
  		[^'class ' , (self nameOfClass: oop)].
  	name := self nameOfClass: classOop.
  	name size = 0 ifTrue: [name := '??'].
  	name = 'String' ifTrue: [^ (self stringOf: oop) printString].
  	name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
  	name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
  	name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
  	name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
  		[^ '=' , (Character value: (objectMemory integerValueOf: 
  				(objectMemory fetchPointer: 0 ofObject: oop))) printString].
  	name = 'UndefinedObject' ifTrue: [^ 'nil'].
  	name = 'False' ifTrue: [^ 'false'].
  	name = 'True' ifTrue: [^ 'true'].
  	name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
  	(#('Association' 'ReadOnlyVariableBinding' 'VariableBinding') includes: name) ifTrue:
  		[^ '(' ,
  		(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
  		' -> ' ,
  		(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
  	^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!

Item was added:
+ ----- Method: String>>indexOfWord: (in category '*VMMaker-translation support') -----
+ indexOfWord: aSubString
+ 	^self indexOfWord: aSubString startingAt: 1!

Item was added:
+ ----- Method: String>>indexOfWord:startingAt: (in category '*VMMaker-translation support') -----
+ indexOfWord: aSubString startingAt: startIndex
+ 	| index |
+ 	index := startIndex.
+ 	[index <= self size] whileTrue:
+ 		[index := self indexOfSubCollection: aSubString startingAt: index ifAbsent: [^0].
+ 		 ((index = 1 or: [(self at: index - 1) isLetter not])
+ 		  and: [index + aSubString size > self size
+ 				or: [(self at: index + aSubString size) isAlphaNumeric not]]) ifTrue:
+ 			[^index].
+ 		 index := index + 1].
+ 	^0!

Item was added:
+ ----- Method: TAssignmentNode>>setExpression: (in category 'accessing') -----
+ setExpression: expressionNode
+ 
+ 	expression := expressionNode!

Item was changed:
  ----- Method: TMethod>>hasUnrenamableCCode (in category 'utilities') -----
  hasUnrenamableCCode
+ 	"Answer true if the receiver uses inlined C which
+ 	 is not currently renamed properly by the the inliner."
- 	"Answer true if the receiver uses inlined C or complex C declarations,
- 	 which are not currently renamed properly by the the inliner."
  
+ 	^parseTree anySatisfy:
+ 		[:node| node isNonNullCCode]!
- 	declarations keysAndValuesDo:
- 		[:name :value|
- 		((value endsWith: name)
- 		 or: [value == #implicit]) ifFalse: 
- 			[^true]].
- 
- 	parseTree nodesDo:
- 		[:node|
- 		(node isSend
- 		 and: [node isNonNullCCode]) ifTrue:
- 			[^true]].
- 	^false!

Item was changed:
  ----- Method: TMethod>>newCascadeTempFor: (in category 'initialization') -----
  newCascadeTempFor: aTParseNode
+ 	| varName varNode |
+ 	varName := self extraVariableName: 'cascade'.
+ 	varNode := TVariableNode new setName: varName.
- 	| varNode |
- 	varNode := TVariableNode new setName: (self extraVariableName: 'cascade').
  	aTParseNode isLeaf ifFalse:
  		[declarations
+ 			at: varName
+ 			put: [:tm :cg| | type |
+ 				type := tm determineTypeFor: aTParseNode in: cg.
+ 				(VMStructType structTargetKindForType: type) == #struct ifTrue:
+ 					["can't copy structs into cascade temps; the struct is not updated.
+ 					  must change to a pointer."
+ 					type := type, ' *'.
+ 					parseTree nodesDo:
+ 						[:node|
+ 						(node isAssignment
+ 						 and: [node variable name = varName]) ifTrue:
+ 							[node setExpression: (TSendNode new
+ 													setSelector: #addressOf:
+ 													receiver: (TVariableNode new setName: 'self')
+ 													arguments: {node expression})]]].
+ 				type]].
- 			at: varNode name
- 			put: [:tm :cg| tm determineTypeFor: aTParseNode in: cg]].
  	^varNode!

Item was changed:
  ----- Method: TMethod>>renameVariablesUsing: (in category 'inlining support') -----
  renameVariablesUsing: aDictionary
  	"Rename all variables according to old->new mappings of the given dictionary."
  
  	| newDecls |
  	"map args and locals"
  	args := args collect: [ :arg | aDictionary at: arg ifAbsent: [ arg ]].
  	locals := locals collect: [ :v | aDictionary at: v ifAbsent: [ v ]].
  
  	"map declarations"
  	newDecls := declarations species new.
  	declarations keysAndValuesDo:
+ 		[:oldName :decl|
- 		[ :oldName :decl|
  		(aDictionary at: oldName ifAbsent: nil)
+ 			ifNotNil:
+ 				[:newName| | index |
+ 				index := decl indexOfWord: oldName.
+ 				 newDecls
+ 					at: newName
+ 					put: (index ~= 0
+ 							ifTrue: [decl copyReplaceFrom: index to: index + oldName size - 1 with: newName]
+ 							ifFalse: [decl])]
+ 			ifNil: [newDecls at: oldName put: decl]].
- 			ifNotNil: [:newName|
- 					newDecls
- 						at: newName
- 						put: ((decl endsWith: oldName)
- 								ifTrue: [(decl allButLast: oldName size), newName]
- 								ifFalse:
- 									[Transcript cr; show: 'suspicious renaming ', oldName, ' -> ', newName, ' ', decl, ' in ', selector.
- 									 decl])]
- 			ifNil: [ newDecls at: oldName put: decl ]].
  	self newDeclarations: newDecls.
  
  	"map variable names in parse tree"
+ 	parseTree nodesDo:
+ 		[ :node |
- 	parseTree nodesDo: [ :node |
  		(node isVariable
  		and: [aDictionary includesKey: node name]) ifTrue:
  			[node setName: (aDictionary at: node name)].
  		(node isStmtList and: [node args size > 0]) ifTrue:
  			[node setArguments: (node args collect: [ :arg | aDictionary at: arg ifAbsent: [ arg ]])]]!

Item was added:
+ ----- Method: TParseNode>>isNonNullCCode (in category 'testing') -----
+ isNonNullCCode
+ 	"overridden in TSendNode"
+ 	^false!

Item was changed:
  ----- Method: VMStructType class>>structTargetKindForType: (in category 'translation') -----
  structTargetKindForType: type
- 	| index |
  	StructTypeNameCache ifNil:
  		[StructTypeNameCache := Set new.
  		 self allSubclassesDo:
  			[:sc| StructTypeNameCache add: sc name; add: sc structTypeName ]].
  	^(type notNil
  	   and: [StructTypeNameCache anySatisfy:
  			[:structType|
  			(type beginsWith: structType)
+ 			and: [type size = structType size
+ 				or: [(type at: structType size + 1) isAlphaNumeric not]]]]) ifTrue:
+ 		[(type includes: $*)
- 			and: [index > structType size]]]) ifTrue:
- 		[(index := type indexOf: $*) > 0
  			ifTrue: [#pointer]
  			ifFalse: [#struct]]!



More information about the Vm-dev mailing list