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

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Sun Jun 27 01:06:51 UTC 2010


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://www.squeaksource.com/VMMaker/VMMaker-oscog.17.mcz

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

Name: VMMaker-oscog.17
Author: eem
Time: 26 June 2010, 4:01:09 am
UUID: b0ce2f1b-0e18-48d8-a490-4b8ca8476ec7
Ancestors: VMMaker-oscog.16

CogVM:
	Fix off-by-one error in assigning inst vars of contexts
	via primitiveInstVarAtPut (!!).  Fixes Seaside continuation
	tests.

	Add printCallStackOfContext:.

	Add missing markAndTracePrimTraceLog for stack simulation.

	Add evaluation of atEachStepBlock to stack simulator run methods

=============== Diff against VMMaker-oscog.14 ===============

Item was changed:
(excessive method size, no diff calculated)

Item was changed:
(excessive method size, no diff calculated)

Item was changed:
  ----- Method: CoInterpreter>>printLogEntryAt: (in category 'debug support') -----
  printLogEntryAt: i
  	<inline: false>
  	| intOrClass selectorOrMethod source |
  	intOrClass := traceLog at: i.
  	selectorOrMethod := traceLog at: i + 1.
  	source := traceLog at: i + 2.
  	source <= TraceIsFromInterpreter ifTrue:
  		[self print: (traceSources at: source); space].
  	(self isIntegerObject: intOrClass)
  		ifTrue:
  			[intOrClass = TraceContextSwitch ifTrue:
  				[self print: 'context switch'].
  			 intOrClass = TraceBlockActivation ifTrue:
  				[self print: ' [] in '; printHex: selectorOrMethod].
  			 intOrClass = TraceBlockCreation ifTrue:
  				[self print: 'create [] '; printHex: selectorOrMethod].
  			 intOrClass = TraceIncrementalGC ifTrue:
  				[self print: 'incrementalGC'].
  			 intOrClass = TraceFullGC ifTrue:
  				[self print: 'fullGC'].
  			 intOrClass = TraceCodeCompaction ifTrue:
  				[self print: 'compactCode']]
  		ifFalse:
+ 			[self space; printNameOfClass: intOrClass count: 5; print: '>>'; safePrintStringOf: selectorOrMethod].
- 			[self space; printNameOfClass: intOrClass count: 5; print: '>>'; printStringOf: selectorOrMethod].
  	source > TraceIsFromInterpreter ifTrue:
  		[self space; print: (traceSources at: source)].
  	self cr!

Item was changed:
  ----- Method: NewObjectMemory>>become:with:twoWay:copyHash: (in category 'become') -----
  become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
  	"All references to each object in array1 are swapped with all references to the corresponding object in array2. That is, all pointers to one object are replaced with with pointers to the other. The arguments must be arrays of the same length. 
  	Returns PrimNoErr if the primitive succeeds."
  	"Implementation: Uses forwarding blocks to update references as done in compaction."
  	| start |
+ 	self leakCheckBecome ifTrue:
+ 		[self runLeakCheckerForFullGC: true].
  	(self isArray: array1) ifFalse:
  		[^PrimErrBadReceiver].
  	((self isArray: array2)
  	 and: [(self lastPointerOf: array1) = (self lastPointerOf: array2)]) ifFalse:
  		[^PrimErrBadArgument].
  	twoWayFlag
  		ifTrue: [(self containOnlyOops: array1 and: array2) ifFalse: [^PrimErrInappropriate]]
  		ifFalse: [(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate]].
  
  	(self prepareForwardingTableForBecoming: array1 with: array2 twoWay: twoWayFlag) ifFalse:
  		[^PrimErrNoMemory]. "fail; not enough space for forwarding table"
  
  	(self allYoung: array1 and: array2)
  		ifTrue: [start := youngStart"sweep only the young objects plus the roots"]
  		ifFalse: [start := self startOfMemory"sweep all objects"].
  	self mapPointersInObjectsFrom: start to: endOfMemory.
  	twoWayFlag
  		ifTrue: [self restoreHeadersAfterBecoming: array1 with: array2]
  		ifFalse: [self restoreHeadersAfterForwardBecome: copyHashFlag].
  
  	self initializeMemoryFirstFree: freeStart. "re-initialize memory used for forwarding table"
+ 	self leakCheckBecome ifTrue:
+ 		[self runLeakCheckerForFullGC: true].
- 	
  	self forceInterruptCheck. "pretty much guaranteed to take a long time, so check for timers etc ASAP"
  
  	^PrimNoErr "success"!

Item was changed:
  ----- Method: CoInterpreter>>mapTraceLog (in category 'debug support') -----
  mapTraceLog
  	"The trace log is a circular buffer of pairs of entries. If there is
  	 an entry at traceLogIndex - 3 \\ TraceBufferSize it has entries.
  	 If there is something at traceLogIndex it has wrapped."
  	<inline: false>
  	| limit |
+ 	limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
+ 	(traceLog at: limit) = 0 ifTrue: [^nil].
+ 	(traceLog at: traceLogIndex) ~= 0 ifTrue:
+ 		[limit := TraceBufferSize - 3].
- 	(traceLog at: traceLogIndex - 3 \\ TraceBufferSize) = 0 ifTrue: [^nil].
- 	limit := (traceLog at: traceLogIndex) = 0
- 				ifTrue: [traceLogIndex - 3 \\ TraceBufferSize]
- 				ifFalse: [TraceBufferSize - 3].
  	0 to: limit by: 3 do:
  		[:i| | intOrClass selectorOrMethod |
  		intOrClass := traceLog at: i.
  		(self isIntegerObject: intOrClass) ifFalse:
  			[traceLog at: i put: (self remap: intOrClass)].
  		selectorOrMethod := traceLog at: i + 1.
  		(self isIntegerObject: selectorOrMethod) ifFalse:
  			[traceLog at: i + 1 put: (self remap: selectorOrMethod)]]!

Item was changed:
  ----- Method: CoInterpreter>>slowPrimitiveResponse (in category 'primitive support') -----
  slowPrimitiveResponse
  	"Called under the assumption that primFunctionPtr has been preloaded"
  	| nArgs savedFramePointer savedStackPointer |
  	<inline: true>
  	<asmLabel: false>
  	<var: #savedFramePointer type: #'char *'>
  	<var: #savedStackPointer type: #'char *'>
  	cogit recordPrimTrace ifTrue:
+ 		[self fastLogPrim: messageSelector].
- 		[self fastLogPrim: messageSelector.
- 		 self traceInterpreterPrim].
  	FailImbalancedPrimitives ifTrue:
  		[nArgs := argumentCount.
  		 savedStackPointer := stackPointer.
  		 savedFramePointer := framePointer].
  	self initPrimCall.
  	self dispatchFunctionPointer: primitiveFunctionPointer.
  	FailImbalancedPrimitives ifTrue:
  		[(self successful
  		  and: [framePointer = savedFramePointer
  		  and: [(self isMachineCodeFrame: framePointer) not]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
  			[stackPointer ~= (savedStackPointer + (nArgs * BytesPerWord)) ifTrue:
  				"Soon make this a message send of e.g. unbalancedPrimitive to the current process or context"
  				[stackPointer := savedStackPointer. "This is necessary but insufficient; the result may still have been written to the stack."
  				 self failUnbalancedPrimitive]]].
  	"If we are profiling, take accurate primitive measures"
  	nextProfileTick > 0 ifTrue:
  		[self checkProfileTick: newMethod].
  	^self successful!

Item was changed:
  StackInterpreter subclass: #StackInterpreterSimulator
+ 	instanceVariableNames: 'byteCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries inputSem quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock'
- 	instanceVariableNames: 'byteCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries inputSem quitBlock transcript displayView logging printFrameAtEachStep printBytecodeAtEachStep startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-InterpreterSimulation'!
  
  !StackInterpreterSimulator commentStamp: '<historical>' prior: 0!
  This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
  
  To see the thing actually run, you could (after backing up this image and changes), execute
  
  	(StackInterpreterSimulator new openOn: Smalltalk imageName) test
  
  and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be.  We usually do this with a small and simple benchmark image. You will probably have more luck using InterpreteSimulatorLSB or InterpreterSimulatorMSB as befits your machine.!

Item was changed:
  ----- Method: StackInterpreter>>primitiveInstVarAtPut (in category 'object access primitives') -----
  primitiveInstVarAtPut
  	| newValue index rcvr hdr fmt totalLength fixedFields |
  	newValue := self stackTop.
  	index := self stackIntegerValue: 1.
  	rcvr := self stackValue: 2.
  	self successful ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	hdr := self baseHeader: rcvr.
  	fmt := self formatOfHeader: hdr.
  	totalLength := self lengthOf: rcvr baseHeader: hdr format: fmt.
  	fixedFields := self fixedFieldsOf: rcvr format: fmt length: totalLength.
  	(index >= 1 and: [index <= fixedFields]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
  	(fmt = 3
  	 and: [(self isContextHeader: hdr)
  	 and: [self isMarriedOrWidowedContext: rcvr]])
+ 		ifTrue: [self externalInstVar: index - 1 ofContext: rcvr put: newValue]
- 		ifTrue: [self externalInstVar: index ofContext: rcvr put: newValue]
  		ifFalse: [self subscript: rcvr with: index storing: newValue format: fmt].
  	self pop: argumentCount + 1 thenPush: newValue!

Item was changed:
  ----- Method: CoInterpreter>>markAndTraceTraceLog (in category 'object memory support') -----
  markAndTraceTraceLog
  	"The trace log is a circular buffer of pairs of entries. If there is an entry at
  	 traceLogIndex - 3 \\ TraceBufferSize it has entries.  If there is something at
  	 traceLogIndex it has wrapped."
  	<inline: false>
  	| limit |
+ 	limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
+ 	(traceLog at: limit) = 0 ifTrue: [^nil].
+ 	(traceLog at: traceLogIndex) ~= 0 ifTrue:
+ 		[limit := TraceBufferSize - 3].
- 	(traceLog at: traceLogIndex - 3 \\ TraceBufferSize) = 0 ifTrue: [^nil].
- 	limit := (traceLog at: traceLogIndex) = 0
- 				ifTrue: [traceLogIndex - 3 \\ TraceBufferSize]
- 				ifFalse: [TraceBufferSize - 3].
  	0 to: limit by: 3 do:
  		[:i| | oop |
  		oop := traceLog at: i.
  		(self isIntegerObject: oop) ifFalse:
  			[self markAndTrace: oop].
  		oop := traceLog at: i + 1.
  		(self isIntegerObject: oop) ifFalse:
  			[self markAndTrace: oop]]!

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 vmHeaderContents |
- 	| cg interpreterClass interpreterClasses vmHeaderContents structClasses |
  	self needsToRegenerateInterpreterFile ifFalse: [^nil].
+ 	cg := self buildCodeGeneratorForInterpreter.
- 	cg := self createCodeGenerator.
- 
- 	cg vmClass: (interpreterClass := self interpreterClass).
- 	interpreterClasses := OrderedCollection new.
- 	[interpreterClasses addFirst: interpreterClass.
- 	 interpreterClass ~~ ObjectMemory
- 	 and: [interpreterClass inheritsFrom: ObjectMemory]] whileTrue:
- 		[interpreterClass := interpreterClass superclass].
- 
- 	interpreterClasses addAllLast: self interpreterClass ancilliaryClasses.
- 	structClasses := Set new.
- 	interpreterClasses do: [:class| structClasses addAll: class ancilliaryStructClasses].
- 	(ChangeSet superclassOrder: structClasses asArray) do:
- 		[:structClass|
- 		structClass initialize.
- 		cg addStructClass: structClass].
- 
- 	interpreterClasses
- 		do: [:ic| ic == ObjectMemory
- 				ifTrue: [ic initializeWithBytesToWord: self bytesPerWord]
- 				ifFalse: [ic initialize]].
- 
- 	interpreterClasses do: [:ic| cg addClass: ic].
  	cg removeUnneededBuiltins.
  	self interpreterClass preGenerationHook: cg.
  
  	vmHeaderContents := cg vmHeaderContentsWithBytesPerWord: self bytesPerWord.
  	(cg needToGenerateHeader: self interpreterHeaderName file: self interpreterHeaderPath contents: vmHeaderContents) ifTrue:
  		[cg storeHeaderOnFile: self interpreterHeaderPath contents: vmHeaderContents].
  	cg storeCodeOnFile: (self sourceFilePathFor: self interpreterClass sourceFileName) doInlining: self doInlining.
  	self interpreterClass additionalHeadersDo:
  		[:headerName :headerContents| | filePath |
  		 filePath := self coreVMDirectory fullNameFor: headerName.
  		 (self 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)].
  	(Gnuifier on: self coreVMDirectory)
  		interpreterFilename: self interpreterFilename;
  		gnuify.!

Item was changed:
  ----- Method: CoInterpreter>>commenceCogCompiledCodeCompaction (in category 'process primitive support') -----
  commenceCogCompiledCodeCompaction
  	| startTime |
  	<var: #startTime type: #usqLong>
  	cogCompiledCodeCompactionCalledFor := false.
+ 	cogit recordEventTrace ifTrue:
- 	cogit recordTrace ifTrue:
  		[self recordTrace: TraceCodeCompaction thing: TraceCodeCompaction source: 0].
  	startTime := self ioUTCMicrosecondsNow.
  
  	"This can be called in a number of circumstances.  The instructionPointer
  	 may contain a native pc that must be relocated.  There may already be a
  	 pushed instructionPointer on stack.  Clients ensure that instructionPointer
  	 is 0 if it should not be pushed and/or relocated.  Pushing twice is a mistake
  	 because only the top one will be relocated."
  	instructionPointer ~= 0 ifTrue:
  		[self push: instructionPointer.
  		 self externalWriteBackHeadStackPointer].
  	cogit compactCogCompiledCode.
  	instructionPointer ~= 0 ifTrue:
  		[instructionPointer := self popStack.
  		 self externalWriteBackHeadStackPointer].
  
  	statCodeCompactionCount := statCodeCompactionCount + 1.
  	statCodeCompactionUsecs := statCodeCompactionUsecs + (self ioUTCMicrosecondsNow - startTime).
  
  	checkForLeaks ~= 0 ifTrue:
  		[self clearLeakMapAndMapAccessibleObjects.
  		 self assert: (self checkCodeIntegrity: false)]!

Item was added:
+ ----- Method: Cogit>>recordEventTrace (in category 'debugging') -----
+ recordEventTrace
+ 	<api>
+ 	<cmacro: '() (traceLinkedSends & 4)'>
+ 	^(traceLinkedSends bitAnd: 4) ~= 0!

Item was changed:
  ----- Method: NewObjectMemory>>setCheckForLeaks: (in category 'debug support') -----
  setCheckForLeaks: anInteger
  	"0 = do nothing.
  	 1 = check for leaks on fullGC.
  	 2 = check for leaks on incrementalGC.
+ 	 4 = check for leaks on become
+ 	 7 = check for leaks on all three."
- 	 3 = check for leaks on both."
  	checkForLeaks := anInteger!

Item was changed:
  ----- Method: CoInterpreter>>recordContextSwitchFrom: (in category 'debug support') -----
  recordContextSwitchFrom: sourceCode
+ 	cogit recordEventTrace ifTrue:
- 	cogit recordTrace ifTrue:
  		[self recordTrace: TraceContextSwitch thing: TraceContextSwitch source: sourceCode]!

Item was changed:
  ----- Method: CoInterpreter>>mapPrimTraceLog (in category 'debug support') -----
  mapPrimTraceLog
  	"The prim trace log is a circular buffer of selectors. If there is
  	 an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
  	 If there is something at primTraceLogIndex it has wrapped."
  	<inline: false>
  	| limit |
+ 	limit := self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize.
+ 	(primTraceLog at: limit) = 0 ifTrue: [^nil].
+ 	(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
+ 		[limit := PrimTraceLogSize - 1].
- 	(primTraceLog at: primTraceLogIndex - 1 \\ PrimTraceLogSize) = 0 ifTrue: [^nil].
- 	limit := (primTraceLog at: primTraceLogIndex) = 0
- 				ifTrue: [primTraceLogIndex - 1 \\ PrimTraceLogSize]
- 				ifFalse: [PrimTraceLogSize - 1].
  	0 to: limit do:
  		[:i| | selector |
  		selector := primTraceLog at: i.
  		(self isIntegerObject: selector) ifFalse:
  			[primTraceLog at: i put: (self remap: selector)]]!

Item was changed:
  ----- Method: CogMethodSurrogate>>= (in category 'comparing') -----
+ = aCogMethodOrAddressOrNil
+ 	^address = (aCogMethodOrAddressOrNil
+ 					ifNil: [0]
+ 					ifNotNil: [aCogMethodOrAddressOrNil asInteger])!
- = aCogMethodOrAddress
- 	^address = aCogMethodOrAddress asInteger!

Item was changed:
  ----- Method: CCodeGenerator>>generateAt:on:indent: (in category 'C translation') -----
  generateAt: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
  	self emitCExpression: msgNode receiver on: aStream.
+ 	aStream nextPut: $[.
+ 	msgNode args first emitCCodeAsExpressionOn: aStream level: level + 1 generator: self.
+ 	aStream nextPut: $]!
- 	aStream nextPutAll: '['.
- 	msgNode args first emitCCodeOn: aStream level: level generator: self.
- 	aStream nextPutAll: ']'.!

Item was changed:
  ----- Method: StackInterpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
  markAndTraceInterpreterOops: fullGCFlag
  	"Mark and trace all oops in the interpreter's state."
  	"Assume: All traced variables contain valid oops."
  	| oop |
  	"Must mark stack pages first to initialize the per-page trace
  	 flags for full garbage collect before any subsequent tracing."
  	self markAndTraceStackPages: fullGCFlag.
+ 	self markAndTraceTraceLog.
+ 	self markAndTracePrimTraceLog.
  	self markAndTrace: specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
  	(self isIntegerObject: messageSelector) ifFalse:
  		[self markAndTrace: messageSelector].
  	self markAndTrace: newMethod.
  	self markAndTrace: lkupClass.
  	self traceProfileState.
  	primResult = 0 ifFalse:[self markAndTrace: primResult].
  
  	1 to: remapBufferCount do: [:i | 
  			oop := remapBuffer at: i.
  			(self isIntegerObject: oop) ifFalse: [self markAndTrace: oop]].
  
  	"Callback support - trace suspended callback list"
  	1 to: jmpDepth do:[:i|
  		oop := suspendedCallbacks at: i.
  		(self isIntegerObject: oop) ifFalse:[self markAndTrace: oop].
  		oop := suspendedMethods at: i.
  		(self isIntegerObject: oop) ifFalse:[self markAndTrace: oop].
+ 	]!
- 	].
- 	self markAndTraceTraceLog!

Item was added:
+ ----- Method: CogVMSimulator>>tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom:to:returnValue: (in category 'return bytecodes') -----
+ tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom to: contextToReturnTo returnValue: returnValue
+ 	self halt.
+ 	^super tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom to: contextToReturnTo returnValue: returnValue!

Item was changed:
  ----- Method: CoInterpreter>>dumpTraceLog (in category 'debug support') -----
  dumpTraceLog
  	<api>
  	"The trace log is a circular buffer of pairs of entries. If there is
  	 an entry at traceLogIndex - 3 \\ TraceBufferSize it has entries.
  	 If there is something at traceLogIndex it has wrapped."
  	<inline: false>
+ 	(traceLog at: (self safe: traceLogIndex - 3 mod: TraceBufferSize)) = 0 ifTrue: [^nil].
- 	(traceLog at: traceLogIndex - 3 \\ TraceBufferSize) = 0 ifTrue: [^nil].
  	(traceLog at: traceLogIndex) ~= 0 ifTrue:
  		[traceLogIndex to: TraceBufferSize - 3 by: 3 do:
+ 			[:i| self printLogEntryAt: i]].
- 			[:i|
- 			self printLogEntryAt: i]].
  
  	0 to: traceLogIndex - 3 by: 3 do:
  		[:i| self printLogEntryAt: i]!

Item was changed:
  ----- Method: CCodeGenerator>>generateAtPut:on:indent: (in category 'C translation') -----
  generateAtPut: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
  	self emitCExpression: msgNode receiver on: aStream.
+ 	aStream nextPut: $[.
+ 	msgNode args first emitCCodeAsExpressionOn: aStream level: level + 1 generator: self.
- 	aStream nextPutAll: '['.
- 	msgNode args first emitCCodeOn: aStream level: level generator: self.
  	aStream nextPutAll: '] = '.
+ 	self emitCExpression: msgNode args last on: aStream!
- 	self emitCExpression: msgNode args last on: aStream.!

Item was added:
+ ----- Method: NewObjectMemory>>leakCheckBecome (in category 'debug support') -----
+ leakCheckBecome
+ 	<api>
+ 	^(checkForLeaks bitAnd: 4) ~= 0!

Item was added:
+ ----- Method: VMClass>>safe:mod: (in category 'arithmetic') -----
+ safe: signedInteger mod: positiveModulus
+ 	<inline>
+ 	| remainder |
+ 	^(remainder := signedInteger \\ positiveModulus) < 0
+ 		ifTrue: [remainder + positiveModulus]
+ 		ifFalse: [remainder]!

Item was changed:
  ----- Method: CoInterpreter>>clearTraceLog (in category 'debug support') -----
  clearTraceLog
  	<api>
  	traceLogIndex := 0.
- 	(traceLog at: traceLogIndex - 3 \\ TraceBufferSize) = 0 ifTrue: [^nil].
  	0 to: TraceBufferSize - 1 do:
  		[:i|
  		traceLog at: i put: 0]!

Item was added:
+ ----- Method: StackInterpreter>>markAndTracePrimTraceLog (in category 'object memory support') -----
+ markAndTracePrimTraceLog
+ 	"This is a no-op in the StackVM"!

Item was added:
+ ----- Method: StackInterpreter>>printCallStackOfContext: (in category 'debug printing') -----
+ printCallStackOfContext: aContext
+ 	<api>
+ 	| context |
+ 	<inline: false>
+ 	<var: #theFP type: #'char *'>
+ 	context := aContext.
+ 	[context = nilObj] whileFalse:
+ 		[(self isMarriedOrWidowedContext: context)
+ 			ifTrue:
+ 				[(self checkIsStillMarriedContext: context currentFP: framePointer) ifFalse:
+ 					[self shortPrintContext: context.
+ 					 ^nil].
+ 				 context := self shortReversePrintFrameAndCallers: (self frameOfMarriedContext: context)]
+ 			ifFalse:
+ 				[context := self printContextCallStackOf: context]]!

Item was changed:
  ----- Method: VMMaker>>generateCogitFile (in category 'generate sources') -----
  generateCogitFile
  	"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 cogitClass |
- 	| cg cogitClass cogitClasses structClasses |
  	self interpreterClass needsCogit ifFalse: [^nil].
  	self needsToRegenerateCogitFile ifFalse: [^nil].
+ 	cg := self buildCodeGeneratorForCogit.
+ 	cogitClass := self interpreterClass cogitClass.
- 	cg := self createCogitCodeGenerator.
- 
- 	cg vmClass: (cogitClass := self interpreterClass cogitClass).
- 	cogitClasses := OrderedCollection new.
- 	[cogitClasses addFirst: cogitClass.
- 	 cogitClass ~~ Cogit
- 	 and: [cogitClass inheritsFrom: Cogit]] whileTrue:
- 		[cogitClass := cogitClass superclass].
- 	
- 	cogitClasses addAllLast: self interpreterClass cogitClass ancilliaryClasses.
- 	cogitClasses, { self interpreterClass }  do: [:cgc| cgc initialize].
- 	cogitClasses do: [:cgc| cg addClass: cgc].
- 	structClasses := Set new.
- 	cogitClasses do: [:class| structClasses addAll: class ancilliaryStructClasses].
- 	(ChangeSet superclassOrder: structClasses asArray) do:
- 		[:structClasss| cg addStructClass: structClasss].
- 
  	cg removeUnneededBuiltins.
  	cg vmClass preGenerationHook: cg.
  	cg storeCodeOnFile: (self sourceFilePathFor: cogitClass sourceFileName) doInlining: cogitClass doInlining.
  	cg vmClass additionalHeadersDo:
  		[:headerName :headerContents| | filePath |
  		 filePath := self coreVMDirectory fullNameFor: headerName.
  		 (cg needToGenerateHeader: headerName file: filePath contents: headerContents) ifTrue:
  			 [cg storeHeaderOnFile: filePath contents: headerContents]].
  	cogitClass apiExportHeaderName ifNotNil:
  		[cg storeAPIExportHeader: cogitClass apiExportHeaderName
  			OnFile: (self sourceFilePathFor: cogitClass apiExportHeaderName)]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>run (in category 'testing') -----
  run
  	"Just run"
  	quitBlock := [^self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
+ 		 atEachStepBlock value. "N.B. may be nil"
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount].
  	localIP := localIP - 1.
  	"undo the pre-increment of IP before returning"
  	self externalizeIPandSP!

Item was changed:
  ----- Method: NewObjectMemory>>safePrintStringOf: (in category 'debug printing') -----
  safePrintStringOf: oop
  	"Version of printStringOf: that copes with forwarding during garbage collection."
  	| fmt header cnt i |
  	<inline: false>
  	(self isIntegerObject: oop) ifTrue:
  		[^nil].
  	(oop between: self startOfMemory and: freeStart) ifFalse:
  		[^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[^nil].
  	header := self headerWhileForwardingOf: oop.
  	fmt := self formatOfHeader: header.
  	fmt < 8 ifTrue: [ ^nil ].
  
  	cnt := 100 min: (self lengthOf: oop baseHeader: header format: fmt).
  	i := 0.
  
  	[i < cnt] whileTrue:
  		[self printChar: (self fetchByte: i ofObject: oop).
  		 i := i + 1].
+ 	self flush.
+ 	^oop!
- 	self flush!

Item was changed:
  ----- Method: CoInterpreter>>dumpPrimTraceLog (in category 'debug support') -----
  dumpPrimTraceLog
  	<api>
  	"The prim trace log is a circular buffer of entries. If there is
  	 an entry at primTraceLogIndex \\ PrimTraceLogSize it has entries.
  	 If there is something at primTraceLogIndex it has wrapped."
  	<inline: false>
+ 	(primTraceLog at: (self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize)) = 0 ifTrue: [^nil].
- 	(primTraceLog at: primTraceLogIndex - 1 \\ PrimTraceLogSize) = 0 ifTrue: [^nil].
  	(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
  		[primTraceLogIndex to: PrimTraceLogSize - 1 do:
  			[:i| self safePrintStringOf: (primTraceLog at: i); cr]].
  
  	0 to: primTraceLogIndex - 1 do:
  		[:i| self safePrintStringOf: (primTraceLog at: i); cr]!

Item was changed:
  ----- Method: VMClass>>pointerForOop: (in category 'translation support') -----
  pointerForOop: oop
  	"This gets implemented by Macros in C, where its types will also be checked.
  	 oop is the width of a machine word, and pointer is a raw address."
+ 	<doNotGenerate>
  
  	^oop!

Item was changed:
  ----- Method: CoInterpreter>>preGCAction: (in category 'object memory support') -----
  preGCAction: fullGCFlag
  	"Need to write back the frame pointers unless all pages are free (as in snapshot).
  	 Need to set inFullGC flag (to avoid passing the flag through a lot of the updating code)"
  	stackPage ~= 0 ifTrue:
  		[self externalWriteBackHeadFramePointers].
  
  	inFullGC := fullGCFlag.
  
+ 	cogit recordEventTrace ifTrue:
- 	cogit recordTrace ifTrue:
  		[| traceType |
  		traceType := fullGCFlag ifTrue: [TraceFullGC] ifFalse: [TraceIncrementalGC].
  		self recordTrace: traceType thing: traceType source: 0]!

Item was added:
+ ----- Method: VMMaker>>buildCodeGeneratorForInterpreter (in category 'generate sources') -----
+ buildCodeGeneratorForInterpreter
+ 	"Answer the code generator for translating the interpreter."
+ 
+ 	| cg interpreterClass interpreterClasses structClasses |
+ 	interpreterClasses := OrderedCollection new.
+ 
+ 	(cg := self createCodeGenerator) vmClass: (interpreterClass := self interpreterClass).
+ 
+ 	[interpreterClass ~~ VMClass] whileTrue:
+ 		[interpreterClasses addFirst: interpreterClass.
+ 		 interpreterClass := interpreterClass superclass].
+ 	
+ 	cg vmClass objectMemoryClass ifNotNil:
+ 		[:objectMemoryClass|
+ 		interpreterClass := objectMemoryClass.
+ 		[interpreterClass ~~ VMClass] whileTrue:
+ 			[interpreterClasses addFirst: interpreterClass.
+ 			 interpreterClass := interpreterClass superclass]].
+ 
+ 	interpreterClasses addFirst: VMClass.
+ 	interpreterClasses addAllLast: (self interpreterClass ancilliaryClasses copyWithout: cg vmClass objectMemoryClass).
+ 	structClasses := Set new.
+ 	interpreterClasses do: [:class| structClasses addAll: class ancilliaryStructClasses].
+ 	(ChangeSet superclassOrder: structClasses asArray) do:
+ 		[:structClass|
+ 		structClass initialize.
+ 		cg addStructClass: structClass].
+ 
+ 	interpreterClasses do:
+ 		[:ic|
+ 		(ic class includesSelector: #initializeWithBytesToWord:)
+ 			ifTrue: [ic initializeWithBytesToWord: self bytesPerWord]
+ 			ifFalse: [ic initialize]].
+ 
+ 	interpreterClasses do: [:ic| cg addClass: ic].
+ 	^cg!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintContext: (in category 'debug printing') -----
  shortPrintContext: aContext
  	| home |
  	<inline: false>
+ 	(self isContext: aContext) ifFalse:
+ 		[self printHex: aContext; print: ' is not a context'; cr.
+ 		^nil].
  	home := self findHomeForContext: aContext.
  	self printNum: aContext.
  	(self isMarriedOrWidowedContext: aContext)
  		ifTrue: [((self checkIsStillMarriedContext: aContext currentFP: framePointer)
  				and: [self isMachineCodeFrame: (self frameOfMarriedContext: aContext)])
  					ifTrue: [self print: ' m ']
  					ifFalse: [self print: ' i ']]
  		ifFalse: [self print: ' s '].
  	self printActivationNameFor: (self fetchPointer: MethodIndex ofObject: home)
  		receiver: (self fetchPointer: ReceiverIndex ofObject: home)
  		isBlock: home ~= aContext
+ 		firstTemporary: (self fetchPointer: 0 + CtxtTempFrameStart ofObject: home).
- 		firstTemporary: (self fetchPointer: 0 + TempFrameStart ofObject: home).
  	self cr!

Item was changed:
  ----- Method: ObjectMemory>>safePrintStringOf: (in category 'debug printing') -----
  safePrintStringOf: oop
  	"Version of printStringOf: that copes with forwarding during garbage collection."
  	| fmt header cnt i |
  	<inline: false>
  	(self isIntegerObject: oop) ifTrue:
  		[^nil].
  	(oop between: self startOfMemory and: freeBlock) ifFalse:
  		[^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[^nil].
  	header := self headerWhileForwardingOf: oop.
  	fmt := self formatOfHeader: header.
  	fmt < 8 ifTrue: [ ^nil ].
  
  	cnt := 100 min: (self lengthOf: oop baseHeader: header format: fmt).
  	i := 0.
  
  	[i < cnt] whileTrue:
  		[self printChar: (self fetchByte: i ofObject: oop).
  		 i := i + 1].
+ 	self flush.
+ 	^oop!
- 	self flush!

Item was added:
+ ----- Method: CoInterpreter>>markAndTracePrimTraceLog (in category 'debug support') -----
+ markAndTracePrimTraceLog
+ 	"The prim trace log is a circular buffer of selectors. If there is
+ 	 an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
+ 	 If there is something at primTraceLogIndex it has wrapped."
+ 	<inline: false>
+ 	| limit |
+ 	limit := self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize.
+ 	(primTraceLog at: limit) = 0 ifTrue: [^nil].
+ 	(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
+ 		[limit := PrimTraceLogSize - 1].
+ 	0 to: limit do:
+ 		[:i| | selector |
+ 		selector := primTraceLog at: i.
+ 		(self isIntegerObject: selector) ifFalse:
+ 			[self markAndTrace: selector]]!

Item was changed:
  ----- Method: CoInterpreter>>checkLogIntegrity (in category 'object memory support') -----
  checkLogIntegrity
  	"Check the log for leaks.  The trace log is a circular buffer of pairs of entries.
  	 If there is an entry at traceLogIndex - 3 \\ TraceBufferSize it has entries.  If
  	 there is something at traceLogIndex it has wrapped."
  	| limit ok |
+ 	limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
+ 	(traceLog at: limit) = 0 ifTrue: [^nil].
+ 	(traceLog at: traceLogIndex) ~= 0 ifTrue:
+ 		[limit := TraceBufferSize - 3].
- 	(traceLog at: traceLogIndex - 3 \\ TraceBufferSize) = 0 ifTrue: [^true].
- 	limit := (traceLog at: traceLogIndex) = 0
- 				ifTrue: [traceLogIndex - 3 \\ TraceBufferSize]
- 				ifFalse: [TraceBufferSize - 3].
  	ok := true.
  	0 to: limit by: 3 do:
  		[:i| | oop |
  		oop := traceLog at: i.
  		(self isIntegerObject: oop) ifFalse:
  			[(self checkOopIntegrity: oop named: 'traceLog' index: i) ifFalse:
  				[ok := false]].
  		oop := traceLog at: i + 1.
  		(self isIntegerObject: oop) ifFalse:
  			[(self checkOopIntegrity: oop named: 'traceLog' index: i + 1) ifFalse:
  				[ok := false]]].
  	^ok!

Item was changed:
  ----- Method: CogVMSimulator>>interpret (in category 'interpreter shell') -----
  interpret
  	"This is the main interpreter loop. It normally loops forever, fetching and executing bytecodes.
  	 When running in the context of a web browser plugin VM, however, it must return control to the
  	 web browser periodically. This should done only when the state of the currently running Squeak
  	 thread is safely stored in the object heap. Since this is the case at the moment that a check for
  	 interrupts is performed, that is when we return to the browser if it is time to do so.  Interrupt
  	 checks happen quite frequently.
  
  	Override for simulation to insert bytecode breakpoint support."
  
  	<inline: false>
  	"If stacklimit is zero then the stack pages have not been initialized."
  	stackLimit = 0 ifTrue:
  		[^self initStackPagesAndInterpret].
  	"record entry time when running as a browser plug-in"
  	self browserPluginInitialiseIfNeeded.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
+ 		 atEachStepBlock value. "N.B. may be nil"
- 		 atEachStepBlock ifNotNil:
- 			[atEachStepBlock value].
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount].
  	localIP := localIP - 1.  "undo the pre-increment of IP before returning"
  	self externalizeIPandSP.
  	^nil
  !

Item was added:
+ ----- Method: VMMaker>>buildCodeGeneratorForCogit (in category 'generate sources') -----
+ buildCodeGeneratorForCogit
+ 	"Answer the code generator for translating the cogit."
+ 
+ 	| cg cogitClass cogitClasses |
+ 	cg := self createCogitCodeGenerator.
+ 
+ 	cg vmClass: (cogitClass := self interpreterClass cogitClass).
+ 	cogitClasses := OrderedCollection new.
+ 	[cogitClasses addFirst: cogitClass.
+ 	 cogitClass ~~ Cogit
+ 	 and: [cogitClass inheritsFrom: Cogit]] whileTrue:
+ 		[cogitClass := cogitClass superclass].
+ 	cogitClasses addFirst: VMClass.
+ 	cogitClasses addAllLast: self interpreterClass cogitClass ancilliaryClasses.
+ 	cogitClasses, { self interpreterClass }  do: [:cgc| cgc initialize].
+ 	cogitClasses do: [:cgc| cg addClass: cgc].
+ 	(cg structClassesForTranslationClasses: cogitClasses) do:
+ 		[:structClasss| cg addStructClass: structClasss].
+ 
+ 	^cg!

Item was added:
+ ----- Method: VMClass class>>objectMemoryClass (in category 'accessing class hierarchy') -----
+ objectMemoryClass
+ 	"Default for all-in-one VMs where the interpreter inherits from the object memory."
+ 	^nil!

Item was removed:
- ----- Method: VMMakerWithFileCopying>>processFilesForExternalPlugin: (in category 'copying files') -----
- processFilesForExternalPlugin: plugin 
- 	"See comment in VMMaker>processFileForExternalPlugin: first.
- 	When using a copying version of VMMaker, copy any files relating to the external plugin from the crossPlatform & platformDirectory subdir 'plugins'"
- 
- 	super processFilesForExternalPlugin: plugin.
- 
- 	"This version of the method has to actually copy files around"
- 	self copyCrossPlatformFilesFor: plugin internal: false;
- 		copyPlatformFilesFor: plugin internal: false!

Item was removed:
- ----- Method: VMMakerWithFileCopying>>processAssortedFiles (in category 'copying files') -----
- processAssortedFiles
- 	"See the comment in VMMaker> processAssortedFiles first.
- 	This version of the method will copy any miscellaneous files/dirs from the cross-platformDirectory -  readme files etc, then from the platform specific directory - makefiles, utils etc. "
- 	 
- 	| srcDir |
- 	"Is there a crossPlatformDirectory subdirectory called 'misc'?"
- 	(self crossPlatformDirectory directoryExists: 'misc')
- 		ifTrue: [srcDir := self crossPlatformDirectory directoryNamed: 'misc'.
- 			self copyFilesFromSourceDirectory: srcDir toTargetDirectory: self sourceDirectory].
- 	"Is there a platformDirectory subdirectory called 'misc'?"
- 	(self platformDirectory directoryExists: 'misc')
- 		ifTrue: [srcDir := self platformDirectory directoryNamed: 'misc'.
- 			self copyFilesFromSourceDirectory: srcDir toTargetDirectory: self sourceDirectory].
- 
- 	"Now copy any files that are always copied for all platforms"
- 	super processAssortedFiles
- !

Item was removed:
- ----- Method: Cogit>>recordTrace (in category 'debugging') -----
- recordTrace
- 	<api>
- 	<cmacro: '() (traceLinkedSends & 3)'>
- 	"Answer if either tracing all sends & block activations or tracing interpreter primitives.
- 	 If so the interpreter wil trace code compactions & process switches."
- 	^(traceLinkedSends bitAnd: 3) ~= 0!

Item was removed:
- ----- Method: CogVMSimulator>>traceInterpreterPrim (in category 'debug support') -----
- traceInterpreterPrim
- 	cogit printOnTrace ifTrue:
- 		[transcript print: byteCount; nextPut: $/; print: (sendCount := sendCount + 1); space].
- 	super traceInterpreterPrim!

Item was removed:
- ----- Method: CoInterpreter>>traceInterpreterPrim (in category 'debug support') -----
- traceInterpreterPrim
- 	<inline: false>
- 	self recordTrace: (self fetchClassOf: (self stackValue: argumentCount)) thing: messageSelector source: TraceIsFromInterpreter.
- 	cogit printOnTrace ifTrue:
- 		[self printActivationNameFor: newMethod
- 			receiver: (self stackValue: argumentCount)
- 			isBlock: false
- 			firstTemporary: nil;
- 			cr].
- 	self sendBreak: messageSelector + BaseHeaderSize
- 		point: (self lengthOf: messageSelector)
- 		receiver: (self stackValue: argumentCount)!

Item was removed:
- ----- Method: VMMakerWithFileCopying>>copyPlatformFilesFor:internal: (in category 'copying files') -----
- copyPlatformFilesFor: plugin internal: aBoolean
- 	| srcDir targetDir |
- 	[srcDir := self platformPluginsDirectory directoryNamed: plugin moduleName.
- 	targetDir := aBoolean ifTrue:[self internalPluginsDirectoryFor: plugin]
- 					ifFalse:[self externalPluginsDirectoryFor: plugin].
- 	logger show: 'Copy any platform files from: ' , srcDir printString , ' to ' , targetDir printString; cr.
- 	self copyFilesFromSourceDirectory: srcDir toTargetDirectory: targetDir]
- 		on: FileStreamException
- 		do: ["If any file related exceptions get here, we've had some problem, probably path of permissions. Raise the general exception"
- 			^ self couldNotFindPlatformFilesFor: plugin]!

Item was removed:
- ----- Method: CogVMSimulator>>ceTraceInterpreterPrim: (in category 'debug support') -----
- ceTraceInterpreterPrim: theReceiver
- 	cogit printOnTrace ifTrue:
- 		[transcript print: byteCount; nextPut: $/; print: (sendCount := sendCount + 1); space].
- 	cogit assertCStackWellAligned.
- 	super ceTraceInterpreterPrim: theReceiver.
- 	^#continue!

Item was removed:
- ----- Method: CoInterpreter>>ceTraceInterpreterPrim: (in category 'debug support') -----
- ceTraceInterpreterPrim: theReceiver
- 	| cogMethod |
- 	<api>
- 	<var: #cogMethod type: #'CogMethod *'>
- 	cogMethod := self cogMethodOf: newMethod.
- 	self recordTrace: (self fetchClassOf: theReceiver) thing: cogMethod selector source: TraceIsFromMachineCode.
- 	cogit printOnTrace ifTrue:
- 		[self printActivationNameFor: cogMethod methodObject
- 			receiver: theReceiver
- 			isBlock: false
- 			firstTemporary: nil;
- 			cr].
- 	self sendBreak: cogMethod selector + BaseHeaderSize
- 		point: (self lengthOf: cogMethod selector)
- 		receiver: (self stackValue: cogMethod cmNumArgs + 2) "+1 for return pc, + 1 for ceSendTrace call ret pc"!

Item was removed:
- ----- Method: VMMakerWithFileCopying>>processFilesForCoreVM (in category 'copying files') -----
- processFilesForCoreVM
- 	"When using a copying version of VMMaker, copy any cross-platform files from the crossPlatformDir and then copy any files relating to the core vm from the platformDirectory's vm subdirectory."
- 	super processFilesForCoreVM.
- 
- 	"Is there a crossPlatformDirectory subdirectory called 'vmDirName'?"
- 	self copyCrossPlatformVMFiles.
- 
- 	"Is there a platformDirectory subdirectory called 'vmDirName'?"
- 	self copyPlatformVMFiles
- !

Item was removed:
- ----- Method: VMMakerWithFileCopying>>copyPlatformVMFiles (in category 'copying files') -----
- copyPlatformVMFiles
- 	| srcDir targetDir vmDirName |
- 	vmDirName := self class coreVMDirName.
- 
- 	"Is there a platformDirectory subdirectory called 'vmDirName'?"
- 	(self platformDirectory directoryExists: vmDirName)
- 		ifTrue: [srcDir := self platformDirectory directoryNamed: vmDirName.
- 			targetDir := self coreVMDirectory.
- 			self copyFilesFromSourceDirectory: srcDir toTargetDirectory: targetDir]!

Item was removed:
- ----- Method: VMMakerWithFileCopying>>copyCrossPlatformFilesFor:internal: (in category 'copying files') -----
- copyCrossPlatformFilesFor: plugin internal: aBoolean
- 	| srcDir targetDir |
- 	[srcDir := self crossPlatformPluginsDirectory directoryNamed: plugin moduleName.
- 	targetDir := aBoolean ifTrue:[self internalPluginsDirectoryFor: plugin]
- 					ifFalse:[self externalPluginsDirectoryFor: plugin].
- 	logger show: 'Copy any cross platform files from: ' , srcDir printString , ' to ' , targetDir printString; cr.
- 	self copyFilesFromSourceDirectory: srcDir toTargetDirectory: targetDir]
- 		on: FileStreamException
- 		do: ["If any file related exceptions get here, we've had some problem, probably path of permissions. Raise the general exception"
- 			^ self couldNotFindPlatformFilesFor: plugin]!

Item was removed:
- ----- Method: VMMaker>>copyFilesFromSourceDirectory:toTargetDirectory:recursively: (in category 'private - copying files') -----
- copyFilesFromSourceDirectory: srcDir toTargetDirectory: dstDir recursively: recurseBoolean
- 	"copy all files and subdirectories from srcDir to dstDir, optionally recursing down the tree.
- 	It is assumed that both directories already exist and have appropriate 
- 	permissions - proper error handling ought to be provided sometime. 
- 	Note how nice it would be if the file system classes already did this; 
- 	why, they could even defer to an improved file plugin for some of 
- 	these things."
- 	"copy all the files"
- 	| dirList  |
- 	srcDir localName = 'CVS' ifTrue:[logger show: 'CVS files NOT copied by VMMaker'; cr. ^self].
- 	srcDir localName = '.svn' ifTrue:[logger show: 'SVN files NOT copied by VMMaker'; cr. ^self].
- 
- 	self copyFilesFrom: srcDir to: dstDir.
- 
- 	recurseBoolean ifFalse:[^self].
- 	"If we are recursing create the subdirectories of srcDir in dstDir, and then copy that 
- 	subtree "
- 	dirList := srcDir directoryNames copyWithout: 'CVS'.
- 	dirList := srcDir directoryNames copyWithout: '.svn'.
- 	dirList do: 
- 		[:newDstDir | 
- 		(dstDir directoryExists: newDstDir)
- 			ifFalse: [dstDir createDirectory: newDstDir].
- 		self copyFilesFromSourceDirectory: (srcDir directoryNamed: newDstDir)
- 			toTargetDirectory: (dstDir directoryNamed: newDstDir)
- 			recursively: true]!

Item was removed:
- ----- Method: VMMaker>>copyAssortedFiles (in category 'copying files') -----
- copyAssortedFiles
- 	"copy any miscellaneous files/dirs from the cross-platformDirectory/misc/ToCopy -  
- 	general readme files etc, then from the platform specific directory/misc/ToCopy - makefiles, 
- 	utils etc that have to be copied."
- 	| srcDir |
- 	"Is there a crossPlatformDirectory subdirectory called 'misc'?"
- 	(self crossPlatformDirectory directoryExists: 'misc')
- 		ifTrue: [srcDir := self crossPlatformDirectory directoryNamed: 'misc'.
- 			"Is there a subdirectory called 'ToCopy' ?"
- 			(srcDir directoryExists: 'ToCopy') ifTrue:[
- 				srcDir := srcDir directoryNamed: 'ToCopy'.
- 				self copyFilesFromSourceDirectory: srcDir toTargetDirectory: self sourceDirectory]].
- 	"Is there a platformDirectory subdirectory called 'misc'?"
- 	(self platformDirectory directoryExists: 'misc')
- 		ifTrue: [srcDir := self platformDirectory directoryNamed: 'misc'.
- 			"Is there a subdirectory called 'ToCopy' ?"
- 			(srcDir directoryExists: 'ToCopy') ifTrue:[
- 				srcDir := srcDir directoryNamed: 'ToCopy'.
- 				self copyFilesFromSourceDirectory: srcDir toTargetDirectory: self sourceDirectory]]!

Item was removed:
- ----- Method: VMMaker>>copyFilesFromSourceDirectory:toTargetDirectory: (in category 'private - copying files') -----
- copyFilesFromSourceDirectory: srcDir toTargetDirectory: dstDir 
- 	"copy all the files and directories from srcDir to dstDir, recursively"	
- 	self copyFilesFromSourceDirectory: srcDir
- 			toTargetDirectory: dstDir
- 			recursively: true!

Item was removed:
- ----- Method: VMMakerWithFileCopying>>copyCrossPlatformVMFiles (in category 'copying files') -----
- copyCrossPlatformVMFiles
- 	| srcDir targetDir vmDirName |
- 	vmDirName := self class coreVMDirName.
- 
- 	"Is there a crossPlatformDirectory subdirectory called 'vmDirName'?"
- 	(self crossPlatformDirectory directoryExists: vmDirName)
- 		ifTrue: [srcDir := self crossPlatformDirectory directoryNamed: vmDirName.
- 			targetDir := self coreVMDirectory.
- 			self copyFilesFromSourceDirectory: srcDir toTargetDirectory: targetDir]!

Item was removed:
- ----- Method: VMMaker>>copyFilesFrom:to: (in category 'private - copying files') -----
- copyFilesFrom: srcDir to: dstDir
- "This really ought to be a facility in file system. The major annoyance here is that file types and permissions are not handled by current Squeak code"
- 	[srcDir fileNames do: [:filenm | 
- 		self copyFileNamed: (srcDir fullNameFor: filenm) to: (dstDir fullNameFor: filenm)]] on: InvalidDirectoryError do:["do nothing if the directory is invalid"]
- !

Item was removed:
- ----- Method: VMMakerWithFileCopying>>processFilesForInternalPlugin: (in category 'copying files') -----
- processFilesForInternalPlugin: plugin 
- 	"See comment in VMMaker>processFileForInternalPlugin: first.
- 	When using a copying version of VMMaker, copy any files relating to the internal plugin from the crossPlatform & platformDirectory subdir 'plugins'"
- 
- 	super processFilesForInternalPlugin: plugin.
- 
- 	"This version of the method has to actually copy files around"
- 	self copyCrossPlatformFilesFor: plugin internal: true;
- 		copyPlatformFilesFor: plugin internal: true!

Item was removed:
- VMMaker subclass: #VMMakerWithFileCopying
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'VMMaker-Building'!
- 
- !VMMakerWithFileCopying commentStamp: '<historical>' prior: 0!
- This subclass of VMMaker is a hopefully temporary way to provide the copying of files from platforms/{Cross|foo} to src/ until all platforms are able to do their compiling with the platforms tree in place.
- 
- The default class will NOT do the file copies and gradually the platform specific classes can be removed as they all catch up.!



More information about the Vm-dev mailing list