[Vm-dev] VM Maker: VMMaker.gdb-bgs.2746.mcz

commits at source.squeak.org commits at source.squeak.org
Sun May 24 21:25:21 UTC 2020


Boris G. Shingarov uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.gdb-bgs.2746.mcz

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

Name: VMMaker.gdb-bgs.2746
Author: bgs
Time: 24 May 2020, 5:25:08.761978 pm
UUID: 82a9306d-0574-4158-88b8-c2c24ed4d481
Ancestors: VMMaker.gdb-bgs.2745

Work in progress.  Reaches reader prompt on unmodified Intel.

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

Item was changed:
  ----- Method: CoInterpreterStackPages>>initializeStack:numSlots:pageSize: (in category 'initialization') -----
  initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage
  	"Initialize the stack pages.  In the C VM theStackPages will be alloca'ed memory to hold the
  	 stack pages on the C stack.  In the simulator they are housed in the memory between the
  	 cogMethodZone and the heap."
  
  	<var: #theStackPages type: #'char *'>
  	<returnTypeC: #void>
  	| numPages page structStackPageSize pageStructBase count |
  	<var: #page type: #'StackPage *'>
  	<var: #pageStructBase type: #'char *'>
  	self cCode: []
  		inSmalltalk:
  			[self assert: objectMemory startOfMemory - coInterpreter effectiveCogCodeSize - Cogit guardPageSize - coInterpreter methodCacheSize - coInterpreter primTraceLogSize - coInterpreter rumpCStackSize
  					= (stackSlots * objectMemory wordSize roundUpTo: objectMemory allocationUnit)].
  	structStackPageSize := coInterpreter sizeof: CogStackPage.
  	bytesPerPage := slotsPerPage * objectMemory wordSize.
  	numPages := coInterpreter numStkPages.
  
  	"Because stack pages grow down baseAddress is at the top of a stack page and so to avoid
  	 subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply
  	 push the stackPage array up one word to avoid the overlap.  This word is extraStackBytes."
  	pageStructBase := theStackPages + (numPages * bytesPerPage) + objectMemory wordSize.
  	pages := self cCode: [self cCoerceSimple: pageStructBase to: #'StackPage *']
  				  inSmalltalk:
  					[pageMap := Dictionary new.
  					 ((0 to: numPages - 1) collect:
  						[:i|
  						 CogStackPage surrogateClass new
  							address: pageStructBase + (i * structStackPageSize)
  							simulator: coInterpreter
  							zoneBase: coInterpreter stackZoneBase
  							zoneLimit: objectMemory startOfMemory])
  						do: [:pageSurrogate|
  							pageMap at: pageSurrogate address put: pageSurrogate];
  						yourself].
  	"make sure there's enough headroom"
  	self assert: coInterpreter stackPageByteSize - coInterpreter stackLimitBytes - coInterpreter stackLimitOffset
  				>= coInterpreter stackPageHeadroom.
  	0 to: numPages - 1 do:
  		[:index|
  		 page := self stackPageAt: index.
  		 page
  			lastAddress: theStackPages + (index * bytesPerPage);
  			baseAddress: page lastAddress + bytesPerPage;
  			stackLimit: page baseAddress - coInterpreter stackLimitBytes;
  			realStackLimit: page stackLimit;
  			baseFP: 0;
  			nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1]));
  			prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))].
  
  	"Now compute stackBasePlus1 so that the pageIndexFor: call maps all addresses from
  	 aPage baseAddress to aBase limitAddress + 1 to the same index (stacks grow down)"
  	stackBasePlus1 := (self cCoerceSimple: theStackPages to: #'char *') + 1.
  	self cCode: []
  		inSmalltalk:
  			[minStackAddress := theStackPages.
  			 maxStackAddress := theStackPages + (numPages * bytesPerPage) + objectMemory wordSize - 1].
  
  	"The overflow limit is the amount of stack to retain when moving frames from an overflowing
  	 stack to reduce thrashing.  See stackOverflowOrEvent:mayContextSwitch:"
  	page := self stackPageAt: 0.
  	overflowLimit := page baseAddress - page realStackLimit * 3 // 5.
  	0 to: numPages - 1 do:
  		[:index|
  		 page := self stackPageAt: index.
  		 self assert: (self pageIndexFor: page baseAddress) == index.
  		 self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * objectMemory wordSize)) == index.
  		 self assert: (self stackPageFor: page baseAddress) == page.
  		 self assert: (self stackPageFor: page stackLimit) == page.
  		 self cCode: []
  			inSmalltalk:
  				[| memIndex |
  				 memIndex := index * slotsPerPage + 1. "this is memIndex in the block above"
  				 self assert: (self memIndexFor: (self oopForPointer: page baseAddress))
  							== (memIndex + slotsPerPage - 1).
  				 index < (numPages - 1) ifTrue:
  					[self assert: (self stackPageFor: page baseAddress + objectMemory wordSize) == (self stackPageAt: index + 1)]].
  		coInterpreter initializePageTraceToInvalid: page].
  
  	mostRecentlyUsedPage := self stackPageAt: 0.
  	page := mostRecentlyUsedPage.
  	count := 0.
  	[| theIndex |
  	 count := count + 1.
  	 theIndex := self pageIndexFor: page baseAddress.
  	 self assert: (self stackPageAt: theIndex) == page.
  	 self assert: (self pageIndexFor: page baseAddress) == theIndex.
  	 self assert: (self pageIndexFor: page stackLimit) == theIndex.
  	 self assert: (self pageIndexFor: page lastAddress + 1) == theIndex.
  	 (page := page nextPage) ~= mostRecentlyUsedPage] whileTrue.
  	self assert: count == numPages.
  	self assert: self pageListIsWellFormed!

Item was changed:
  ----- Method: CogAbstractInstruction>>outputMachineCodeAt: (in category 'generate machine code') -----
  outputMachineCodeAt: targetAddress
  	"By default move machine code a byte at a time
  	  Subclasses with coarser granularity can override as desired."
  	<inline: true>
  	0 to: machineCodeSize - 1 do:
  		[:j|
  		objectMemory byteAt: targetAddress + j put: (machineCode at: j)]!

Item was changed:
  ----- Method: CogStackPageSurrogate32>>baseAddress (in category 'accessing generated') -----
  baseAddress
  	^memory unsignedLongAt: address + 17!

Item was changed:
  ----- Method: CogStackPageSurrogate32>>baseAddress: (in category 'accessing generated') -----
  baseAddress: aValue
  	self assert: (address + 16 >= zoneBase and: [address + 19 < zoneLimit]).
  	^memory unsignedLongAt: address + 17 put: aValue!

Item was changed:
  ----- Method: CogVMSimulator>>ioShow:D:i:s:p:l:a:y: (in category 'I/O primitives') -----
  ioShow: destBits D: w i: h s: d p: left l: right a: top y: bottom
  	"This is the simulator's implementation of ioShowDisplay."
  	| raster pixPerWord simDisp realDisp rect |
+ 	nil "displayForm" ifNil: [^self].
- 	displayForm ifNil: [^self].
  	displayBits = 0 ifTrue: [^self].
  	pixPerWord := 32 // d.
  	raster := displayForm width + (pixPerWord - 1) // pixPerWord.
  	simDisp := Form new hackBits: objectMemory memory.
  	displayForm unhibernate.
  	realDisp := Form new hackBits: displayForm bits.
  	realDisp
  		copy: (0 @ (top * raster) extent: 4 @ (bottom - top * raster))
  		from: 0 @ (destBits // 4 + (top * raster))
  		in: simDisp
  		rule: Form over.
  	displayView ifNotNil: [^displayView changed].
  	
  	"If running without a view, just blat the bits onto the screen..."
  	rect := 0 @ top corner: displayForm width @ bottom.
  	Display
  		copy: (rect translateBy: self displayLocation)
  		from: rect topLeft
  		in: displayForm
  		rule: Form over!

Item was changed:
  ----- Method: CogVMSimulator>>openOn:extraMemory: (in category 'initialization') -----
  openOn: fileName extraMemory: extraBytes
  	"CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
  
  	| f version headerSize dataSize count oldBaseAddr bytesToShift swapBytes
  	  headerFlags firstSegSize heapSize
  	  hdrNumStackPages hdrEdenBytes hdrMaxExtSemTabSize hdrCogCodeSize
  	  stackZoneSize methodCacheSize primTraceLogSize allocationReserve |
  	"open image file and read the header"
  
  	(f := self openImageFileNamed: fileName) ifNil: [^self].
  
  	"Set the image name and the first argument; there are
  	 no arguments during simulation unless set explicitly."
  	systemAttributes at: 1 put: fileName.
  
  	["begin ensure block..."
  	imageName := f fullName.
  	f binary.
  
  	version := self getWord32FromFile: f swap: false.  "current version: 16r1968 (=6504) vive la revolucion!!"
  	(self readableFormat: version)
  		ifTrue: [swapBytes := false]
  		ifFalse: [(version := version byteSwap32) = self imageFormatVersion
  					ifTrue: [swapBytes := true]
  					ifFalse: [self error: 'incomaptible image format']].
  	headerSize := self getWord32FromFile: f swap: swapBytes.
  	dataSize := self getLongFromFile: f swap: swapBytes.  "length of heap in file"
  	oldBaseAddr := self getLongFromFile: f swap: swapBytes.  "object memory base address of image"
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes).  "Should be loaded from, and saved to the image header"
  
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags		:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory	:= self getWord32FromFile: 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"
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	stackZoneSize := self computeStackZoneSize.
  	"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: [cogit defaultCogCodeSize]
  									ifFalse: [hdrCogCodeSize]].
  	desiredCogCodeSize := hdrCogCodeSize.
  	self assert: f position = (objectMemory wordSize = 4 ifTrue: [40] ifFalse: [64]).
  	hdrEdenBytes	:= self getWord32FromFile: 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.
  	self assert: f position = (objectMemory wordSize = 4 ifTrue: [48] ifFalse: [72]).
  	firstSegSize := self getLongFromFile: f swap: swapBytes.
  	objectMemory firstSegmentSize: firstSegSize.
  	"For Open PICs to be able to probe the method cache during
  	 simulation the methodCache must be relocated to memory."
  	methodCacheSize := methodCache size * objectMemory wordSize.
  	primTraceLogSize := primTraceLog size * objectMemory wordSize.
  
  	"To cope with modern OSs that disallow executing code in writable memory we dual-map
  	 the code zone, one mapping with read/write permissions and the other with read/execute
  	 permissions. In simulation all we can do is use memory, so if we're simulating dual mapping
  	 we use double the memory and simulate the memory sharing in the Cogit's backEnd."
  	effectiveCogCodeSize := (InitializationOptions at: #DUAL_MAPPED_CODE_ZONE ifAbsent: [false])
  								ifTrue: [cogCodeSize * 2]
  								ifFalse: [cogCodeSize].
  
  	"allocate interpreter memory. This list is in address order, low to high.
  	 In the actual VM the stack zone exists on the C stack."
  	heapBase := (Cogit guardPageSize
  				+ effectiveCogCodeSize
  				+ stackZoneSize
  				+ methodCacheSize
  				+ primTraceLogSize
  				+ self rumpCStackSize) roundUpTo: objectMemory allocationUnit.
  	"compare memory requirements with availability"
  	allocationReserve := self interpreterAllocationReserveBytes.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[| freeOldSpaceInImage headroom |
  			 freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes.
  			 headroom := objectMemory
  							initialHeadroom: extraVMMemory
  							givenFreeOldSpaceInImage: freeOldSpaceInImage.
  			 heapSize := objectMemory roundUpHeapSize:
  						   dataSize
  						+ headroom
  						+ objectMemory newSpaceBytes
  						+ (headroom > allocationReserve
  							ifTrue: [0]
  							ifFalse: [allocationReserve])]
  		ifFalse:
  			[heapSize :=  dataSize
  						+ extraBytes
  						+ objectMemory newSpaceBytes
  						+ (extraBytes > allocationReserve
  							ifTrue: [0]
  							ifFalse: [allocationReserve])].
  	heapBase := objectMemory
  					setHeapBase: heapBase
  					memoryLimit:  heapBase + heapSize
  					endOfMemory: heapBase + dataSize.
  
  	self assert: cogCodeSize \\ 4 = 0.
  	self assert: objectMemory memoryLimit \\ 4 = 0.
  	self assert: self rumpCStackSize \\ 4 = 0.
  	objectMemory allocateMemoryOfSize: objectMemory memoryLimit.
  	"read in the image in bulk, then swap the bytes if necessary"
  	f position: headerSize.
  	count := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  	count ~= dataSize ifTrue: [self halt]]
  		ensure: [f close].
  	self moveMethodCacheToMemoryAt: objectMemory cogCodeBase + effectiveCogCodeSize + stackZoneSize.
  	self movePrimTraceLogToMemoryAt: objectMemory cogCodeBase + effectiveCogCodeSize + stackZoneSize + methodCacheSize.
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.  "adjust pointers for zero base address"
  	UIManager default
  		informUser: 'Relocating object pointers...'
  		during: [self initializeInterpreter: bytesToShift].
  	self initializeCodeGenerator!

Item was changed:
  ----- Method: Cogit class>>guardPageSize (in category 'accessing') -----
  guardPageSize
+ 	^16r20000!
- 	^1024!

Item was changed:
  ----- Method: Cogit class>>initializeMiscConstants (in category 'class initialization') -----
  initializeMiscConstants
  	super initializeMiscConstants.
  	Debug := InitializationOptions at: #Debug ifAbsent: [false].
  	(InitializationOptions includesKey: #EagerInstructionDecoration)
  		ifTrue:
  			[EagerInstructionDecoration := InitializationOptions at: #EagerInstructionDecoration]
  		ifFalse:
  			[EagerInstructionDecoration ifNil:
  				[EagerInstructionDecoration := false]]. "speeds up single stepping but could lose fidelity"
  
  	ProcessorClass := (InitializationOptions at: #ISA ifAbsentPut: [self objectMemoryClass defaultISA]) caseOf: {
  							[#X64] 	->	[BochsX64Alien].
+ 							[#IA32] 	->	["BochsIA32Alien" TargetAwareX86 ].
- 							[#IA32] 	->	[BochsIA32Alien].
  							[#ARMv5]	->	[GdbARMAlien].
  							[#ARMv8]	->	[GdbARMv8Alien].
  							[#MIPSEL]	->	[MIPSELSimulator] }.
  	CogCompilerClass := self activeCompilerClass.
  	CogAbstractInstruction initializeAbstractRegisters.
  
  	self objectMemoryClass objectRepresentationClass initializeMiscConstants.
  	"Our criterion for which methods to JIT is literal count.  The default value is 60 literals or less."
  	MaxLiteralCountForCompile := InitializationOptions at: #MaxLiteralCountForCompile ifAbsent: [60].
  	"we special-case 0, 1 & 2 argument sends, N is numArgs >= 3"
  	NumSendTrampolines := 4.
  	"Currently not even the ceImplicitReceiverTrampoline contains object references."
  	NumObjRefsInRuntime := 0.
  	"6 is a fine number for the max number of PCI entries.  8 is too large."
  	MaxCPICCases := 6.
  
  	"One variable defines whether in a block and whether in a vanilla or full block."
  	InVanillaBlock := 1.
  	InFullBlock := 2.
  
  	NSCSelectorIndex := (NSSendCache instVarNames indexOf: #selector) - 1.
  	NSCNumArgsIndex := (NSSendCache instVarNames indexOf: #numArgs) - 1.
  	NSCClassTagIndex := (NSSendCache instVarNames indexOf: #classTag) - 1.
  	NSCEnclosingObjectIndex := (NSSendCache instVarNames indexOf: #enclosingObject) - 1.
  	NSCTargetIndex := (NSSendCache instVarNames indexOf: #target) - 1.
  	NumOopsPerNSC := NSSendCache instVarNames size.
  
  	"Max size to alloca when compiling.
  	 Mac OS X 10.6.8 segfaults approaching 8Mb.
  	 Linux 2.6.9 segfaults above 11Mb.
  	 WIndows XP segfaults approaching 2Mb."
  	MaxStackAllocSize := 1024 * 1024 * 3 / 2 !

Item was changed:
  ----- Method: Cogit>>generateCaptureCStackPointers: (in category 'initialization') -----
  generateCaptureCStackPointers: captureFramePointer
  	"Generate the routine that writes the current values of the C frame and stack pointers into
  	 variables.  These are used to establish the C stack in trampolines back into the C run-time.
  	 This routine assumes the system's frame pointer is the same as that used in generated code."
  	| startAddress callerSavedReg pushedVarBaseReg |
  	<inline: #never>
+ 
  	self allocateOpcodes: 32 bytecodes: 0.
  	startAddress := methodZoneBase.
  	 "Must happen first; value may be used in accessing any of the following addresses"
  	callerSavedReg := 0.
  	pushedVarBaseReg := false.
  	backEnd hasVarBaseRegister ifTrue:
  		[(self isCallerSavedReg: VarBaseReg) ifFalse:
  			["VarBaseReg is not caller-saved; must save and restore it, either by using an available caller-saved reg or push/pop."
  			 callerSavedReg := self availableRegisterOrNoneIn: (ABICallerSavedRegisterMask bitClear: 1 << TempReg). "TempReg used below"
  			 callerSavedReg = NoReg
  				ifTrue: [self NativePushR: VarBaseReg. pushedVarBaseReg := true]
  				ifFalse: [self MoveR: VarBaseReg R: callerSavedReg]].
  		 self MoveCq: self varBaseAddress R: VarBaseReg].
  	captureFramePointer ifTrue:
  		[self MoveR: FPReg Aw: self cFramePointerAddress].
  	"Capture the stack pointer prior to the call.  If we've pushed VarBaseReg take that into account."
  	(backEnd leafCallStackPointerDelta ~= 0 or: [pushedVarBaseReg])
  		ifTrue:
  			[self LoadEffectiveAddressMw:
  					(pushedVarBaseReg
  						ifTrue: [backEnd leafCallStackPointerDelta + objectMemory wordSize]
  						ifFalse: [backEnd leafCallStackPointerDelta])
  				r: NativeSPReg
  				R: TempReg.
  			 self MoveR: TempReg Aw: self cStackPointerAddress]
  		ifFalse:
  			[self MoveR: NativeSPReg Aw: self cStackPointerAddress].
  	backEnd hasVarBaseRegister ifTrue:
  		[(self isCallerSavedReg: VarBaseReg) ifFalse:
  			[pushedVarBaseReg
  				ifTrue: [self NativePopR: VarBaseReg]
  				ifFalse: [self MoveR: callerSavedReg R: VarBaseReg]]].
  	self NativeRetN: 0.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	"This also implicitly flushes the read/write mapped dual zone to the read/execute zone."
  	backEnd flushICacheFrom: startAddress asUnsignedInteger to: methodZoneBase asUnsignedInteger.
  	self recordGeneratedRunTime: 'ceCaptureCStackPointers' address: startAddress.
  	ceCaptureCStackPointers := self cCoerceSimple: startAddress to: #'void (*)(void)'!

Item was changed:
  ----- Method: Cogit>>generateStackPointerCapture (in category 'initialization') -----
  generateStackPointerCapture
  	"Generate a routine ceCaptureCStackPointers that will capture the C stack pointer,
  	 and, if it is in use, the C frame pointer.  These are used in trampolines to call
  	 run-time routines in the interpreter from machine-code."
  
  	| oldMethodZoneBase oldTrampolineTableIndex |
  	cFramePointerInUse := false. "For the benefit of the following assert, assume the minimum at first."
  	self assertCStackWellAligned.
  	oldMethodZoneBase := methodZoneBase.
  	oldTrampolineTableIndex := trampolineTableIndex.
  	self generateCaptureCStackPointers: true.
  	self perform: #ceCaptureCStackPointers.
  	(cFramePointerInUse := coInterpreter checkIfCFramePointerInUse) ifFalse:
  		[methodZoneBase := oldMethodZoneBase.
  		 trampolineTableIndex := oldTrampolineTableIndex.
  		 self generateCaptureCStackPointers: false].
  	self assertCStackWellAligned!

Item was changed:
  ----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
  handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
  	<doNotGenerate>
  	| evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount leaf retpc |
+ self halt.
  	evaluable := simulatedTrampolines
  					at: aProcessorSimulationTrap address
  					ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
  								in: simulatedTrampolines].
  	function := evaluable isBlock
  					ifTrue: ['aBlock; probably some plugin primitive']
  					ifFalse:
  						[evaluable receiver == backEnd ifTrue:
  							[^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
  						 evaluable selector].
  	function ~~ #ceBaseFrameReturn: ifTrue:
  		[coInterpreter assertValidExternalStackPointers].
  	(backEnd wantsNearAddressFor: function) ifTrue:
  		[^self perform: function with: aProcessorSimulationTrap].
  	memory := coInterpreter memory.
  	aProcessorSimulationTrap type == #call
  		ifTrue:
  			[(leaf := coInterpreter mcprims includes: function)
  				ifTrue:
  					[processor
  						simulateLeafCallOf: aProcessorSimulationTrap address
  						nextpc: aProcessorSimulationTrap nextpc
  						memory: memory.
  					 retpc := processor leafRetpcIn: memory]
  				ifFalse:
  					[processor
  						simulateCallOf: aProcessorSimulationTrap address
  						nextpc: aProcessorSimulationTrap nextpc
  						memory: memory.
  					 retpc := processor retpcIn: memory].
  			 self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}]
  		ifFalse:
  			[leaf := false.
  			 processor
  				simulateJumpCallOf: aProcessorSimulationTrap address
  				memory: memory.
  			 retpc := processor retpcIn: memory. "sideways call; the primitive has pushed a return address."
  			 self recordInstruction: {'(simulated jump to '. aProcessorSimulationTrap address. '/'. function. ')'}].
  	function == #interpret ifTrue: "i.e. we're here via ceInvokeInterpret and should discard all state back to enterSmalltalkExecutiveImplementation"
  		[coInterpreter reenterInterpreter].
  	savedFramePointer := coInterpreter framePointer.
  	savedStackPointer := coInterpreter stackPointer.
  	savedArgumentCount := coInterpreter argumentCount.
  	result := ["self halt: evaluable selector."
  		   	   clickConfirm ifTrue:
  			 	[(self confirm: 'skip run-time call?') ifFalse:
  					[clickConfirm := false. self halt]].
  			   evaluable valueWithArguments: (processor
  												postCallArgumentsNumArgs: evaluable numArgs
  												in: memory)]
  				on: ReenterMachineCode
  				do: [:ex| ex return: ex returnValue].
  			
  	coInterpreter assertValidExternalStackPointers.
  	"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
  	 not called something that has built a frame, such as closure value or evaluate method, or
  	 switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
  	(function beginsWith: 'primitive') ifTrue:
  		[coInterpreter primFailCode = 0
  			ifTrue: [(#(	primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch
  						primitiveFullClosureValue primitiveFullClosureValueWithArgs primitiveFullClosureValueNoContextSwitch
  						primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveYield
  						primitiveExecuteMethodArgsArray primitiveExecuteMethod
  						primitivePerform primitivePerformWithArgs primitivePerformInSuperclass
  						primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs)
  							includes: function) ifFalse:
  						["This is a rare case (e.g. in Scorch where a married context's sender is set to nil on trapTrpped and hence the stack layout is altered."
  						 (function == #primitiveSlotAtPut and: [objectMemory isContext: (coInterpreter frameReceiver: coInterpreter framePointer)]) ifFalse:
  							[self assert: savedFramePointer = coInterpreter framePointer.
  							 self assert: savedStackPointer + (savedArgumentCount * objectMemory wordSize)
  									= coInterpreter stackPointer]]]
  			ifFalse:
  				[self assert: savedFramePointer = coInterpreter framePointer.
  				 self assert: savedStackPointer = coInterpreter stackPointer]].
  	result ~~ #continueNoReturn ifTrue:
  		[self recordInstruction: {'(simulated return to '. processor retpcIn: memory. ')'}.
  		 leaf
  			ifTrue: [processor simulateLeafReturnIn: memory]
  			ifFalse: [processor simulateReturnIn: memory].
  		 self assert: processor pc = retpc.
  		 processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize in: memory].
  	self assert: (result isInteger "an oop result"
  			or: [result == coInterpreter
  			or: [result == objectMemory
  			or: [#(nil continue continueNoReturn) includes: result]]]).
  	processor cResultRegister: (result
  							ifNil: [0]
  							ifNotNil: [result isInteger
  										ifTrue: [result]
  										ifFalse: [16rF00BA222]])
  
  	"coInterpreter cr.
  	 processor sp + 32 to: processor sp - 32 by: -4 do:
  		[:sp|
  		 sp = processor sp
  			ifTrue: [coInterpreter print: 'sp->'; tab]
  			ifFalse: [coInterpreter printHex: sp].
  		 coInterpreter tab; printHex: (coInterpreter longAt: sp); cr]"!

Item was added:
+ ----- Method: Cogit>>handleTransferSimulationTrap: (in category 'simulation only') -----
+ handleTransferSimulationTrap: aProcessorSimulationTrap
+ 	<doNotGenerate>
+ 	| evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount |
+ 
+ 	evaluable := simulatedTrampolines
+ 					at: aProcessorSimulationTrap address
+ 					ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
+ 								in: simulatedTrampolines].
+ 	function := evaluable isBlock
+ 					ifTrue: ['aBlock; probably some plugin primitive']
+ 					ifFalse:
+ 						[evaluable receiver == backEnd ifTrue:
+ 							[^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
+ 						 evaluable selector].
+ 	function ~~ #ceBaseFrameReturn: ifTrue:
+ 		[coInterpreter assertValidExternalStackPointers].
+ 	(backEnd wantsNearAddressFor: function) ifTrue:
+ 		[^self perform: function with: aProcessorSimulationTrap].
+ 	memory := coInterpreter memory.
+ 	processor simulateBuildFrameIn: memory for: evaluable.
+ 	function == #interpret ifTrue: "i.e. we're here via ceInvokeInterpret and should discard all state back to enterSmalltalkExecutiveImplementation"
+ 		[coInterpreter reenterInterpreter].
+ 	
+ 	savedFramePointer := coInterpreter framePointer.
+ 	savedStackPointer := coInterpreter stackPointer.
+ 	savedArgumentCount := coInterpreter argumentCount.
+ 	result := ["self halt: evaluable selector."
+ 		   	   clickConfirm ifTrue:
+ 			 	[(self confirm: 'skip run-time call?') ifFalse:
+ 					[clickConfirm := false. self halt]].
+ 			   evaluable valueWithArguments: (processor
+ 												postCallArgumentsNumArgs: evaluable numArgs
+ 												in: memory)]
+ 				on: ReenterMachineCode
+ 				do: [:ex| ex return: #continueNoReturn].
+ 			
+ 	coInterpreter assertValidExternalStackPointers.
+ 	"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
+ 	 not called something that has built a frame, such as closure value or evaluate method, or
+ 	 switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
+ 	(function beginsWith: 'primitive') ifTrue:
+ 		[coInterpreter primFailCode = 0
+ 			ifTrue: [(#(	primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch
+ 						primitiveFullClosureValue primitiveFullClosureValueWithArgs primitiveFullClosureValueNoContextSwitch
+ 						primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveYield
+ 						primitiveExecuteMethodArgsArray primitiveExecuteMethod
+ 						primitivePerform primitivePerformWithArgs primitivePerformInSuperclass
+ 						primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs)
+ 							includes: function) ifFalse:
+ 						["This is a rare case (e.g. in Scorch where a married context's sender is set to nil on trapTrpped and hence the stack layout is altered."
+ 						 (function == #primitiveSlotAtPut and: [objectMemory isContext: (coInterpreter frameReceiver: coInterpreter framePointer)]) ifFalse:
+ 							[self assert: savedFramePointer = coInterpreter framePointer.
+ 							 self assert: savedStackPointer + (savedArgumentCount * objectMemory wordSize)
+ 									= coInterpreter stackPointer]]]
+ 			ifFalse:
+ 				[self assert: savedFramePointer = coInterpreter framePointer.
+ 				 self assert: savedStackPointer = coInterpreter stackPointer]].
+ 	result ~~ #continueNoReturn ifTrue:
+ 		[self recordInstruction: {'(simulated return to '. processor retpcIn: memory. ')'}.
+ 			processor simulateReturnIn: memory.
+ 		 processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize in: memory].
+ 	self assert: (result isInteger "an oop result"
+ 			or: [result == coInterpreter
+ 			or: [result == objectMemory
+ 			or: [#(nil continue continueNoReturn) includes: result]]]).
+ 	processor cResultRegister: (result
+ 							ifNil: [0]
+ 							ifNotNil: [result isInteger
+ 										ifTrue: [result]
+ 										ifFalse: [16rF00BA222]])
+ 
+ 	"coInterpreter cr.
+ 	 processor sp + 32 to: processor sp - 32 by: -4 do:
+ 		[:sp|
+ 		 sp = processor sp
+ 			ifTrue: [coInterpreter print: 'sp->'; tab]
+ 			ifFalse: [coInterpreter printHex: sp].
+ 		 coInterpreter tab; printHex: (coInterpreter longAt: sp); cr]"!

Item was changed:
  ----- Method: Cogit>>handleWriteSimulationTrap: (in category 'simulation only') -----
  handleWriteSimulationTrap: aProcessorSimulationTrap 
  	<doNotGenerate>
  	| variableValue |
  	(self addressIsInCodeZone: aProcessorSimulationTrap address) ifTrue:
  		[self error: 'attempt to write to code space'].
  	variableValue := processor perform: aProcessorSimulationTrap registerAccessor.
  	(simulatedVariableSetters
  			at: aProcessorSimulationTrap address
  			ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
  						in: simulatedVariableSetters])
  		value: variableValue.
  	processor pc: aProcessorSimulationTrap nextpc!

Item was changed:
  ----- Method: Cogit>>initializeCodeZoneFrom:upTo: (in category 'initialization') -----
  initializeCodeZoneFrom: startAddress upTo: endAddress
  	<api>
  	self initializeBackend.
  	self sqMakeMemoryExecutableFrom: startAddress
  		To: endAddress
  		CodeToDataDelta: (self cppIf: #DUAL_MAPPED_CODE_ZONE
  								ifTrue: [self addressOf: codeToDataDelta put: [:v| codeToDataDelta := v]]
  								ifFalse: [nil]).
  	backEnd stopsFrom: startAddress to: endAddress - 1.
  	self cCode: '' inSmalltalk:
  		[self initializeProcessor.
+ 	"	 backEnd stopsFrom: 0 to: guardPageSize - 1 "  ].
- 		 backEnd stopsFrom: 0 to: guardPageSize - 1].
  	codeBase := methodZoneBase := startAddress.
  	minValidCallAddress := (codeBase min: coInterpreter interpretAddress)
  								min: coInterpreter primitiveFailAddress.
  	methodZone manageFrom: methodZoneBase to: endAddress.
  	self assertValidDualZone.
  	self maybeGenerateCheckFeatures.
  	self maybeGenerateCheckLZCNT.
  	self maybeGenerateCacheFlush.
  	self generateVMOwnerLockFunctions.
  	self genGetLeafCallStackPointers.
  	self generateStackPointerCapture.
  	self generateTrampolines.
  	self computeEntryOffsets.
  	self computeFullBlockEntryOffsets.
  	self generateClosedPICPrototype.
  	self alignMethodZoneBase.
  
  	"None of the above is executed beyond ceCheckFeatures & ceCheckLZCNTFunction,
  	 so a bulk flush now is the leanest thing to do."
  	self maybeFlushWritableZoneFrom: startAddress to: methodZoneBase asUnsignedInteger.
  	"repeat so that now the methodZone ignores the generated run-time"
  	methodZone manageFrom: methodZoneBase to: endAddress.
  	"N.B. this is assumed to be the last thing done in initialization; see Cogit>>initialized"
  	self generateOpenPICPrototype!

Item was changed:
  ----- Method: Cogit>>recordProcessing (in category 'simulation only') -----
  recordProcessing
+ "	| eip x |
+ 	eip := processor eip.
+ 	eip printOn: Transcript base: 16 length: 8 padded: true.
+ 	Transcript nextPutAll: '  '.
+ 	x := coInterpreter memory longAt: eip + 1.
+ 	x  printOn: Transcript base: 16 length: 8 padded: true.
+ 	Transcript cr."!
- 	| inst |
- 	self recordRegisters.
- 	inst := self recordLastInstruction.
- 	"Set RRRName ito the selector that accesses ReceiverResultReg (RRR) to alter instruction printing to add the value of RRR as a suffix
- 		(RRRName := #rdx)
- 		(RRRName := #edx)
- 		(RRRName := nil)"
- 	printRegisters ifTrue:
- 		[RRRName ifNil: [processor printRegistersOn: coInterpreter transcript].
- 		 printInstructions ifFalse:
- 			[coInterpreter transcript cr]].
- 	printInstructions ifTrue:
- 		[printRegisters ifTrue:
- 			[coInterpreter transcript cr].
- 		 coInterpreter transcript nextPutAll: inst.
- 		 RRRName ifNotNil:
- 			[coInterpreter transcript space; nextPutAll: RRRName; space.
- 			 (processor perform: RRRName) printOn: coInterpreter transcript base: 16 length: 8 padded: false].
- 		 coInterpreter transcript cr; flush]!

Item was changed:
  ----- Method: Cogit>>simulateCogCodeAt: (in category 'simulation only') -----
  simulateCogCodeAt: address "<Integer>"
  	<doNotGenerate>
  	| stackZoneBase |
+ "self halt.
+ singleStep := true."
  	stackZoneBase := coInterpreter stackZoneBase.
  	processor pc: address.
  	[[[singleStep
  		ifTrue:
  			[[processor sp < stackZoneBase ifTrue: [self halt].
  			  self recordProcessing.
  			  self maybeBreakAt: processor pc] value. "So that the Debugger's Over steps over all this"
  			  processor
  					singleStepIn: coInterpreter memory
  					minimumAddress: guardPageSize
  					readOnlyBelow: methodZone zoneEnd]
  		ifFalse:
  			[processor
  					runInMemory: coInterpreter memory
  					minimumAddress: guardPageSize
  					readOnlyBelow: methodZone zoneEnd].
  	   "((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
  	 	[(self confirm: 'continue?') ifFalse:
  			[clickConfirm := false. self halt]]."
  	   true] whileTrue]
  		on: ProcessorSimulationTrap
  		do: [:ex|
  			ex type == #read ifTrue:
  				[self handleReadSimulationTrap: ex. ex resume: processor].
  			ex type == #write ifTrue:
  		 		[self handleWriteSimulationTrap: ex. ex resume: processor].
+ 			self handleTransferSimulationTrap: ex].
- 			self handleCallOrJumpSimulationTrap: ex].
  	 true] whileTrue!

Item was changed:
  ----- Method: Cogit>>simulateEnilopmart:numArgs: (in category 'simulation only') -----
  simulateEnilopmart: enilopmartAddress numArgs: n
  	<doNotGenerate>
  	"Enter Cog code, popping the class reg and receiver from the stack
  	 and then returning to the address beneath them.
  	 In the actual VM the enilopmart is a function pointer and so senders
  	 of this method end up calling the enilopmart to enter machine code.
  	 In simulation we either need to start simulating execution (if we're in
  	 the interpreter) or return to the simulation (if we're in the run-time
  	 called from machine code. We should also smash the register state
  	 since, being an abnormal entry, no saved registers will be restored."
  	self assert: (coInterpreter isOnRumpCStack: processor sp).
  	self assert: (n = 0 or: [(coInterpreter stackValue: n) between: guardPageSize and: methodZone freeStart - 1]).
  	(printInstructions or: [printRegisters]) ifTrue:
  		[coInterpreter printExternalHeadFrame].
  	processor
  		smashRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize;
  		simulateLeafCallOf: enilopmartAddress
  		nextpc: 16rBADF00D
  		memory: coInterpreter memory.
  	"If we're already simulating in the context of machine code then
  	 this will take us back to handleCallSimulationTrap:.  Otherwise
  	 start executing machine code in the simulator."
+ 	ReenterMachineCode new signal.
- 	(ReenterMachineCode new returnValue: #continueNoReturn) signal.
  	self simulateCogCodeAt: enilopmartAddress.
  	"We should either longjmp back to the interpreter or
  	 stay in machine code so control should not reach here."
  	self assert: false!

Item was changed:
  ----- Method: Cogit>>simulateLeafCallOf: (in category 'simulation only') -----
  simulateLeafCallOf: someFunction
  	"Simulate execution of machine code that leaf-calls someFunction,
  	 answering the result returned by someFunction."
  	"CogProcessorAlienInspector openFor: coInterpreter"
  	<doNotGenerate>
  	| priorSP priorPC priorLR spOnEntry bogusRetPC |
  	self recordRegisters.
  	priorSP := processor sp.
  	priorPC := processor pc.
  	priorLR := backEnd hasLinkRegister ifTrue: [processor lr].
  	processor
  		setFramePointer: coInterpreter getCFramePointer stackPointer: coInterpreter getCStackPointer;
  		simulateLeafCallOf: someFunction
  		nextpc: (bogusRetPC := 16rBADF00D5 roundTo: backEnd codeGranularity)
  		memory: coInterpreter memory.
  	spOnEntry := processor sp.
  	self recordInstruction: {'(simulated call of '. someFunction. ')'}.
  	[[processor pc between: 0 and: methodZone zoneEnd] whileTrue:
  		[[singleStep
+ 			ifTrue: [
+ 					self recordProcessing.
- 			ifTrue: [self recordProcessing.
  					self maybeBreakAt: processor pc.
  					processor
  						singleStepIn: coInterpreter memory
  						minimumAddress: guardPageSize
  						readOnlyBelow: methodZone zoneEnd]
  			ifFalse: [processor
  						runInMemory: coInterpreter memory
  						minimumAddress: guardPageSize
  						readOnlyBelow: methodZone zoneEnd]]
  			on: ProcessorSimulationTrap, Error
  			do: [:ex| | retpc |
  				processor pc = bogusRetPC ifTrue:
  					[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}.
  					 ^processor cResultRegister].
  				ex class == ProcessorSimulationTrap ifTrue:
  					[ex type == #read ifTrue:
  						[self handleReadSimulationTrap: ex. ex resume: processor].
  					 ex type == #write ifTrue:
  		 				[self handleWriteSimulationTrap: ex. ex resume: processor].
  					 ex type == #return ifTrue:
  						[retpc := processor leafRetpcIn: coInterpreter memory.
  						 self assert: retpc = bogusRetPC.
  						 processor simulateLeafReturnIn: coInterpreter memory.
  						 self recordInstruction: {'(simulated return to '. retpc. ')'}.
  						 ^processor cResultRegister]].
  				ex pass]].
  	processor pc = bogusRetPC ifTrue:
  		[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}].
  	^processor cResultRegister]
  		ensure:
  			[processor sp: priorSP.
  			 processor pc: priorPC.
  			 priorLR ifNotNil: [:lr| processor lr: lr]]!

Item was added:
+ ----- Method: Integer>>byteSwap16 (in category '*VMMaker-bit manipulation') -----
+ byteSwap16
+ 	"swap the bytes of a 16 bit unsigned integer"
+ 	"16rAABB byteSwap16"
+ 	
+ 	^(self bitAnd: 16rFF) << 8 bitOr: (self bitAnd: 16rFF00) >> 8!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>long64At: (in category 'memory access') -----
  long64At: byteAddress
+ 	^memory unsignedLong64AtAddr: byteAddress!
- 	"memory is a Bitmap, a 32-bit indexable array of bits"
- 	| hiWord loWord |
- 	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
- 	loWord := memory at: byteAddress // 4 + 1.
- 	hiWord := memory at: byteAddress // 4 + 2.
- 	^hiWord = 0
- 		ifTrue: [loWord]
- 		ifFalse: [(hiWord bitShift: 32) + loWord]!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>longAt: (in category 'memory access') -----
  longAt: byteAddress
  	"Note: Adjusted for Smalltalk's 1-based array indexing."
  	byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ 	^"memory at: byteAddress // 4 + 1" memory unsignedLongAtAddr: byteAddress bigEndian: false!
- 	^memory at: byteAddress // 4 + 1!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>longAt:put: (in category 'memory access') -----
  longAt: byteAddress put: a32BitValue
  	"Note: Adjusted for Smalltalk's 1-based array indexing."
  	"(byteAddress = 16r101348 and: [a32BitValue = 16r53]) ifTrue:
  		[self halt]."
  	"((byteAddress between: 16rda8ac and: 16rda8c0)
  	 or: [byteAddress between: 16r8eb98 and: 16r8ebb0]) ifTrue:
  		[self halt]."
  	byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ 	^memory longAtAddr: byteAddress put: a32BitValue bigEndian: false!
- 	^memory at: byteAddress // 4 + 1 put: a32BitValue!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>memoryClass (in category 'simulation') -----
  memoryClass
  	<doNotGenerate>
+ 	| choices |
+ 	choices := #(LittleEndianBitmap Gem5SharedRAM).
+ 	^Smalltalk at: (choices at: (UIManager default chooseFrom: choices)).
+ 	
+ 	"^self endianness == #little
- 	^self endianness == #little
  		ifTrue: [LittleEndianBitmap]
+ 		ifFalse: [Bitmap]"
+ 	
+ 	
+ 
+ 
+ !
- 		ifFalse: [Bitmap]!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateMemoryOfSize: (in category 'testing') -----
  allocateMemoryOfSize: memoryBytes
  	<doNotGenerate>
  	| bytesPerElement |
+ 	bytesPerElement := self memoryClass bytesPerElement.
- 	bytesPerElement := (self memoryClass basicNew: 0) bytesPerElement.
  	memory := self memoryClass new: memoryBytes + bytesPerElement - 1 // bytesPerElement!

Item was changed:
  ----- Method: SpurMemoryManager>>memmove:_:_: (in category 'simulation') -----
  memmove: destAddress _: sourceAddress _: bytes
  	"Emulate the c library memmove function"
  	<doNotGenerate>
  	| dst src  |
  	dst := destAddress asInteger.
  	src := sourceAddress asInteger.
  	self assert: bytes \\ 8 + (dst \\ 8) + (src \\ 8) = 0.
+ 	"memory bytesPerElement = 8"
+ 	1 = 1 
- 	memory bytesPerElement = 8
  		ifTrue:
  			[destAddress > sourceAddress
  				ifTrue:
  					[bytes - 8 to: 0 by: -8 do:
  						[:i| self long64At: dst + i put: (self long64At: src + i)]]
  				ifFalse:
  					[0 to: bytes - 8 by: 8 do:
  						[:i| self long64At: dst + i put: (self long64At: src + i)]]]
  		ifFalse:
  			[destAddress > sourceAddress
  				ifTrue:
  					[bytes - 4 to: 0 by: -4 do:
  						[:i| self long32At: dst + i put: (self long32At: src + i)]]
  				ifFalse:
  					[0 to: bytes - 4 by: 4 do:
  						[:i| self long32At: dst + i put: (self long32At: src + i)]]]!

Item was changed:
  ----- Method: SpurSegmentManager>>readHeapFrom:at:dataBytes: (in category 'private') -----
  readHeapFrom: f at: location dataBytes: numBytes
  	"Read numBytes from f into mmory at location.  Answer the number of bytes read."
  	<inline: true>
  	^self cCode:
  			[self
  				sq: (self pointerForOop: location)
  				Image: (self sizeof: #char)
  				File: numBytes
  				Read: f]
  		inSmalltalk:
+ 			[
+ 			 "| bytesPerElement |  
+ 			 bytesPerElement := manager memory class bytesPerElement.
- 			[| bytesPerElement |
- 			 bytesPerElement := manager memory bytesPerElement.
  			 (f	readInto: manager memory
  				startingAt: location // bytesPerElement + 1
  				count: numBytes // bytesPerElement)
+ 			  * bytesPerElement."
+ 			
+ 			
+ 			manager memory
+ 			fillFromStream: f startingAt: location count: numBytes
+ 						
+ 			
+ 			]!
- 			  * bytesPerElement]!

Item was changed:
  ----- Method: StackInterpreter>>initStackPages (in category 'initialization') -----
  initStackPages
  	"Initialize the stackPages.  This version is only for simulation
  	 because Slang refuses to inline it, which makes the alloca invalid."
  	| stackPageBytes stackPagesBytes theStackMemory |
  	stackPageBytes := self stackPageByteSize.
  	stackPagesBytes := self computeStackZoneSize.
  	theStackMemory := self
  							cCode: [self alloca: stackPagesBytes]
  							inSmalltalk: [stackPages initializeWithByteSize: stackPagesBytes for: self].
  	self cCode: [self memset: theStackMemory _: 0 _: stackPagesBytes].
  	stackPages
  		initializeStack: theStackMemory
  		numSlots: stackPagesBytes / objectMemory wordSize
  		pageSize: stackPageBytes / objectMemory wordSize!

Item was changed:
  ----- Method: StackInterpreter>>initializePageTraceToInvalid: (in category 'stack pages') -----
  initializePageTraceToInvalid: aPage
  	<var: #aPage type: #'StackPage *'>
+ 	aPage trace: 16rffffffff "for assert checking of the page tracing flags"!
- 	aPage trace: StackPageTraceInvalid "for assert checking of the page tracing flags"!




More information about the Vm-dev mailing list