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

commits at source.squeak.org commits at source.squeak.org
Fri Feb 13 11:17:06 UTC 2015


Esteban Lorenzano uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-EstebanLorenzano.1061.mcz

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

Name: VMMaker.oscog-EstebanLorenzano.1061
Author: EstebanLorenzano
Time: 13 February 2015, 12:14:43.362602 pm
UUID: fc599a22-0090-45e5-b306-08a55d1a46ae
Ancestors: VMMaker.oscog-EstebanLorenzano.1058, VMMaker.oscog-eem.1060

empty log message

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

Item was changed:
+ SystemOrganization addCategory: #VMMaker!
+ SystemOrganization addCategory: 'VMMaker-Building'!
+ SystemOrganization addCategory: 'VMMaker-Interpreter'!
+ SystemOrganization addCategory: 'VMMaker-InterpreterSimulation'!
+ SystemOrganization addCategory: 'VMMaker-InterpreterSimulation-Morphic'!
+ SystemOrganization addCategory: 'VMMaker-JIT'!
+ SystemOrganization addCategory: 'VMMaker-JITSimulation'!
+ SystemOrganization addCategory: 'VMMaker-Multithreading'!
+ SystemOrganization addCategory: 'VMMaker-Plugins'!
+ SystemOrganization addCategory: 'VMMaker-Plugins-Alien'!
+ SystemOrganization addCategory: 'VMMaker-Plugins-IOS'!
+ SystemOrganization addCategory: 'VMMaker-PostProcessing'!
+ SystemOrganization addCategory: 'VMMaker-SmartSyntaxPlugins'!
+ SystemOrganization addCategory: 'VMMaker-SpurMemoryManager'!
+ SystemOrganization addCategory: 'VMMaker-SpurMemoryManagerSimulation'!
+ SystemOrganization addCategory: 'VMMaker-Support'!
+ SystemOrganization addCategory: 'VMMaker-Tests'!
+ SystemOrganization addCategory: 'VMMaker-Translation to C'!
- SystemOrganization addCategory: #'VMMaker-Building'!
- SystemOrganization addCategory: #'VMMaker-Interpreter'!
- SystemOrganization addCategory: #'VMMaker-InterpreterSimulation'!
- SystemOrganization addCategory: #'VMMaker-InterpreterSimulation-Morphic'!
- SystemOrganization addCategory: #'VMMaker-JIT'!
- SystemOrganization addCategory: #'VMMaker-JITSimulation'!
- SystemOrganization addCategory: #'VMMaker-Multithreading'!
- SystemOrganization addCategory: #'VMMaker-Plugins'!
- SystemOrganization addCategory: #'VMMaker-Plugins-Alien'!
- SystemOrganization addCategory: #'VMMaker-Plugins-IOS'!
- SystemOrganization addCategory: #'VMMaker-PostProcessing'!
- SystemOrganization addCategory: #'VMMaker-SmartSyntaxPlugins'!
- SystemOrganization addCategory: #'VMMaker-SpurMemoryManager'!
- SystemOrganization addCategory: #'VMMaker-SpurMemoryManagerSimulation'!
- SystemOrganization addCategory: #'VMMaker-Support'!
- SystemOrganization addCategory: #'VMMaker-Tests'!
- SystemOrganization addCategory: #'VMMaker-Translation to C'!

Item was changed:
  TestCase subclass: #AbstractInstructionTests
  	instanceVariableNames: 'processor opcodes'
  	classVariableNames: ''
  	poolDictionaries: 'CogRTLOpcodes'
  	category: 'VMMaker-Tests'!
+ 
+ !AbstractInstructionTests commentStamp: 'BenjaminVanRyseghem 9/27/2011 14:04' prior: 0!
+ Use for a test: ClosureCompilerTest>>#closureCases!

Item was changed:
  ----- Method: CCodeGenerator>>emitCFunctionPrototypes:on: (in category 'C code generator') -----
  emitCFunctionPrototypes: methodList on: aStream 
  	"Store prototype declarations for all non-inlined methods on the given stream."
  	| exporting |
  	aStream cr; nextPutAll: '/*** Function Prototypes ***/'; cr.
  	"Hmm, this should be in the sqConfig.h files.  For now put it here..."
  	"Feel free to add equivalents for other compilers"
  	vmClass notNil ifTrue:
  		[NoRegParmsInAssertVMs ifTrue:
+ 			[aStream nextPutAll: '\\#if !!PRODUCTION && defined(__GNUC__) && !!(defined(__MINGW32__) || defined(__MINGW64__)) && !!defined(NoDbgRegParms)\# define NoDbgRegParms __attribute__ ((regparm (0)))\#endif' withCRs.
- 			[aStream nextPutAll: '\\#if !!PRODUCTION && defined(__GNUC__) && !!defined(NoDbgRegParms)\# define NoDbgRegParms __attribute__ ((regparm (0)))\#endif' withCRs.
  			 aStream nextPutAll: '\\#if !!defined(NoDbgRegParms)\# define NoDbgRegParms /*empty*/\#endif\\' withCRs].
  		 aStream nextPutAll: '\\#if defined(__GNUC__) && !!defined(NeverInline)\# define NeverInline __attribute__ ((noinline))\#endif' withCRs.
  		 aStream nextPutAll: '\\#if !!defined(NeverInline)\# define NeverInline /*empty*/\#endif\\' withCRs].
  	exporting := false.
  	(methodList select: [:m| m isRealMethod
  							 and: [self shouldGenerateMethod: m]]) do:
  		[:m |
  		self emitExportPragma ifTrue:
  			[m export
  				ifTrue: [exporting ifFalse: 
  							[aStream nextPutAll: '#pragma export on'; cr.
  							exporting := true]]
  				ifFalse: [exporting ifTrue: 
  							[aStream nextPutAll: '#pragma export off'; cr.
  							exporting := false]]].
  		m emitCFunctionPrototype: aStream generator: self.
  		(NoRegParmsInAssertVMs and: [vmClass notNil and: [m export not and: [m isStatic and: [m args notEmpty]]]]) ifTrue:
  			[aStream nextPutAll: ' NoDbgRegParms'].
  		(vmClass notNil and: [m inline == #never]) ifTrue:
  			[aStream nextPutAll: ' NeverInline'].
  		aStream nextPut: $; ; cr].
  	exporting ifTrue: [aStream nextPutAll: '#pragma export off'; cr].
  	aStream cr!

Item was changed:
  ----- Method: CCodeGenerator>>emitGlobalCVariablesOn: (in category 'C code generator') -----
  emitGlobalCVariablesOn: aStream
  	"Store the global variable declarations on the given stream."
  
  	aStream cr; nextPutAll: '/*** Global Variables ***/'; cr.
+ 	
  	(self sortStrings: (variables select: [:v| vmClass mustBeGlobal: v])) do:
  		[:var | | varString decl |
  		varString := var asString.
  		decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString].
  		decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack"
  			ifTrue:
  				[aStream nextPutAll: decl; cr]
  			ifFalse:
+ 				[
+ 				((decl includesSubString: ' private ')
+ 				  or: [decl beginsWith: 'static']) ifFalse: "work-around hack to prevent localization of variables only referenced once."
+ 					[
+ 					aStream nextPutAll: 'VM_EXPORT '.
+ 
+ 					(decl includes: $=) ifTrue:
- 				[((decl includesSubString: ' private ')
- 				  "or: [decl beginsWith: 'static']") ifFalse: "work-around hack to prevent localization of variables only referenced once."
- 					[(decl includes: $=) ifTrue:
  						[decl := decl copyFrom: 1 to: (decl indexOf: $=) - 1].
  					aStream
  						nextPutAll: decl;
  						nextPut: $;;
  						cr]]].
  	aStream cr!

Item was added:
+ ----- Method: CCodeGenerator>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion
+ 	| memoryManagerVersion |
+ 	memoryManagerVersion := (self options at: #ObjectMemory ifAbsent: [ #ObjectMemory ]) asClass memoryManagerVersion.
+ 	^ self vmClass interpreterVersion, '[', memoryManagerVersion,']'!

Item was added:
+ ----- Method: CCodeGenerator>>isThreadedVM (in category 'testing') -----
+ isThreadedVM
+ 	^ self vmClass isThreadedVM!

Item was changed:
  ----- Method: CCodeGenerator>>nonStructClassesForTranslationClasses: (in category 'utilities') -----
  nonStructClassesForTranslationClasses: classes
  	"Answer in superclass order (any superclass precedes any subclass)
  	 the ancilliaryClasses that are not struct classes for all the given classes."
  	| nonStructClasses |
  	nonStructClasses := OrderedCollection new.
  	classes do:
  		[:aTranslationClass|
  		([aTranslationClass ancilliaryClasses: self options]
  				on: MessageNotUnderstood
  				do: [:ex|
  					ex message selector == #ancilliaryClasses:
  						ifTrue: [#()]
  						ifFalse: [ex pass]]) do:
  			[:class|
  			(vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class]) ifTrue:
  				[(class isStructClass
  				 or: [(nonStructClasses includes: class)
  				 or: [classes includes: class]]) ifFalse:
  					[nonStructClasses addLast: class]]]].
+ 	^Class superclassOrder: nonStructClasses!
- 	^ChangeSet superclassOrder: nonStructClasses!

Item was changed:
  ----- Method: CCodeGenerator>>storeAPIExportHeader:OnFile: (in category 'public') -----
  storeAPIExportHeader: headerName OnFile: fullHeaderPath
  	"Store C header code on the given file. Evaluate
  	 aBlock with the stream to generate its contents."
  
  	| header |
  	header := String streamContents:
  				[:s|
+ 				 "s nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr."
- 				 s nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr.
  				 self emitCAPIExportHeaderOn: s].
  	(self needToGenerateHeader: headerName file: fullHeaderPath contents: header) ifTrue:
  		[self storeHeaderOnFile: fullHeaderPath contents: header]!

Item was changed:
  ----- Method: CCodeGenerator>>storeHeaderOnFile:contents: (in category 'public') -----
  storeHeaderOnFile: fileName contents: contents
  	"Store C header code on the given file. Evaluate
  	 aBlock with the stream to generate its contents."
  
  	| aStream |
  	aStream := VMMaker forceNewFileNamed: fileName.
  	aStream ifNil: [Error signal: 'Could not open C header file: ', fileName].
+ 	["(contents beginsWith: '/* Automatic') ifFalse:
+ 		[aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr]".
- 	[(contents beginsWith: '/* Automatic') ifFalse:
- 		[aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr].
  	 aStream nextPutAll: contents]
  		ensure: [aStream close]!

Item was changed:
  ----- Method: CCodeGenerator>>structClassesForTranslationClasses: (in category 'utilities') -----
  structClassesForTranslationClasses: classes
  	"Answer in superclass order (any superclass precedes any subclass)
  	 the ancilliaryClasses that are struct classes for all the given classes."
  	| theStructClasses |
  	theStructClasses := OrderedCollection new.
  	classes do:
  		[:aTranslationClass|
  		([aTranslationClass ancilliaryClasses: self options]
  				on: MessageNotUnderstood
  				do: [:ex|
  					ex message selector == #ancilliaryClasses:
  						ifTrue: [#()]
  						ifFalse: [ex pass]]) do:
  			[:class|
  			(class isStructClass
  			 and: [(vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class])
  			 and: [(theStructClasses includes: class) not]]) ifTrue:
  				[theStructClasses addLast: class]]].
  	^ChangeSet superclassOrder: theStructClasses!

Item was changed:
  ----- Method: CoInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	"Override to avoid repeating StackInterpreter's declarations and add our own extensions"
+ 	
- 	| threaded |
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
- 	threaded := aCCodeGenerator vmClass isThreadedVM.
  	aCCodeGenerator
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"cogmethod.h"';
+ 		addHeaderFile: (aCCodeGenerator isThreadedVM 
+ 			ifTrue: ['"cointerpmt.h"'] 
+ 			ifFalse: ['"cointerp.h"']);
- 		addHeaderFile: (threaded ifTrue: ['"cointerpmt.h"'] ifFalse: ['"cointerp.h"']);
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator vmClass
  		declareInterpreterVersionIn: aCCodeGenerator
+ 		defaultName: aCCodeGenerator interpreterVersion.
- 		defaultName: (threaded ifTrue: ['Cog MT'] ifFalse: ['Cog']).
  	aCCodeGenerator
  		var: #heapBase type: #usqInt;
  		var: #statCodeCompactionUsecs type: #usqLong;
  		var: #maxLiteralCountForCompile
  			declareC: 'sqInt maxLiteralCountForCompile = MaxLiteralCountForCompile /* ', MaxLiteralCountForCompile printString, ' */';
  		var: #minBackwardJumpCountForCompile
  			declareC: 'sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* ', MinBackwardJumpCountForCompile printString, ' */'.
  	aCCodeGenerator
  		var: #reenterInterpreter
  		declareC: 'jmp_buf reenterInterpreter; /* private export */'.
  	aCCodeGenerator
  		var: #primTraceLogIndex type: #'unsigned char';
  		var: #primTraceLog declareC: 'sqInt primTraceLog[256]';
  		var: #traceLog
  		declareC: 'sqInt traceLog[TraceBufferSize /* ', TraceBufferSize printString, ' */]';
  		var: #traceSources type: #'char *' array: TraceSources!

Item was added:
+ ----- Method: CoInterpreter class>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion 
+ 	^ 'Cog'!

Item was changed:
  ----- Method: CoInterpreter>>initStackPagesAndInterpret (in category 'initialization') -----
  initStackPagesAndInterpret
  	"Initialize the stack pages and enter interpret. Use alloca'ed memory so that when
  	 we have a JIT its stack pointer will be on the native stack since alloca allocates
  	 memory on the stack. Certain thread systems use the native stack pointer as the
  	 frame ID so putting the stack anywhere else can confuse the thread system."
  
  	"Override to establish the setjmp/longjmp handler for reentering the interpreter
  	 from machine code, and disable executablity on the heap and stack pages."
  
  	"This should be in its own initStackPages method but Slang can't inline
  	 C code strings."
  	| stackPageBytes stackPagesBytes theStackMemory |
  	<var: #theStackMemory type: #'char *'>
  	stackPageBytes := self stackPageByteSize.
  	stackPagesBytes := self computeStackZoneSize.
  	theStackMemory := self
  							cCode: [self alloca: stackPagesBytes]
  							inSmalltalk: [stackPages initializeWithByteSize: stackPagesBytes for: self].
  	self cCode: [self me: theStackMemory ms: 0 et: stackPagesBytes].
+ 	self cppIf: #SPUR_USE_EXECUTABLE_MEMORY 
+ 		ifTrue:  [
+ 			self 
+ 				sqMakeMemoryExecutableFrom: objectMemory startOfMemory asUnsignedInteger
+ 				To: objectMemory memoryLimit asUnsignedInteger ]
+ 		ifFalse: [ 
+ 			self 
+ 				sqMakeMemoryNotExecutableFrom: objectMemory startOfMemory asUnsignedInteger
+ 				To: objectMemory memoryLimit asUnsignedInteger ].
+ 	self 
+ 		sqMakeMemoryNotExecutableFrom: theStackMemory asUnsignedInteger
- 	self sqMakeMemoryNotExecutableFrom: objectMemory startOfMemory asUnsignedInteger
- 		To: objectMemory memoryLimit asUnsignedInteger.
- 	self sqMakeMemoryNotExecutableFrom: theStackMemory asUnsignedInteger
  		To: theStackMemory asUnsignedInteger + stackPagesBytes.
+ 	
  	stackPages
  		initializeStack: theStackMemory
  		numSlots: stackPagesBytes / objectMemory wordSize
  		pageSize: stackPageBytes / objectMemory wordSize.
  	self assert: self minimumUnusedHeadroom = stackPageBytes.
  
  	"Once the stack pages are initialized we can continue to bootstrap the system."
  	self loadInitialContext.
  	"We're ready for the heartbeat (poll interrupt)"
  	self ioInitHeartbeat.
  	self initialEnterSmalltalkExecutive.
  	^nil!

Item was added:
+ ----- Method: CoInterpreterMT class>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion 
+ 	^ 'Cog MT'!

Item was changed:
  ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
  	"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct."
  	"{CogAbstractInstruction. CogIA32Compiler. CogARMCompiler} do:
  		[:c| Transcript print: c; cr. c printTypedefOn: Transcript]"
  	| machineCodeBytes |
  	machineCodeBytes := self ==  CogAbstractInstruction
  								ifTrue: [0]
  								ifFalse: [self basicNew machineCodeBytes].
  	(self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do:
  		[:ivn|
  		ivn ~= 'bcpc' ifTrue:
  			[aBinaryBlock
  				value: ivn
  				value: (ivn caseOf: {
  							['address']			-> ['unsigned long'].
  							['machineCode']	-> [{'unsigned char'. '[', machineCodeBytes printString, ']'}].
+ 							['operands']		-> [{'unsigned long'. '[', NumOperands printString, ']'}].
- 							['operands']		-> [{'unsigned long'. '[', NumOperands, ']'}].
  							['dependent']		-> ['struct _AbstractInstruction *']}
  						otherwise:
  							[#char])]]!

Item was changed:
  ----- Method: CogMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
  alignedByteSize
  	^20 + self baseHeaderSize!

Item was changed:
  ----- Method: CogMethodSurrogate64 class>>alignedByteSize (in category 'accessing') -----
  alignedByteSize
  	^32 + self baseHeaderSize!

Item was changed:
  CoInterpreterMT subclass: #CogVMSimulator
  	instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends traceOn myBitBlt displayForm imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JITSimulation'!
  
+ !CogVMSimulator commentStamp: 'EstebanLorenzano 10/15/2014 11:45' prior: 0!
- !CogVMSimulator commentStamp: 'eem 9/3/2013 11:16' prior: 0!
  This class defines basic memory access and primitive simulation so that the CoInterpreter 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.  Remember that you can test the Cogit using its class-side in-image compilation facilities.
  
  To see the thing actually run, you could (after backing up this image and changes), execute
  
  	(CogVMSimulator 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.
  
  Here's an example to launch the simulator in a window.  The bottom-right window has a menu packed with useful stuff:
  
  (CogVMSimulator newWithOptions: #(Cogit StackToRegisterMappingCogit))
  	desiredNumStackPages: 8;
  	openOn: '/Users/eliot/Cog/startreader.image';
  	openAsMorph;
  	run
  
  Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out.
  
  | cos proc opts |
  CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)).
- CogVMSimulator chooseAndInitCogitClassWithOpts: opts.
  cos := CogVMSimulator new.
  "cos initializeThreadSupport." "to test the multi-threaded VM"
  cos desiredNumStackPages: 8. "to set the size of the stack zone"
  "cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone"
  cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image"
  "cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector"
  proc := cos cogit processor.
  "cos cogit sendTrace: 7." "turn on tracing"
  "set a complex breakpoint at a specific point in machine code"
  "cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg|  cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1".
  "[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit"
  "cos cogit setBreakMethod: 16rB38880."
  cos
  	openAsMorph;
  	"toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window"
  	halt;
  	run!

Item was changed:
  ----- Method: CogVMSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
  ioRelinquishProcessorForMicroseconds: microseconds
  	"In the simulator give an indication that we're idling and check for input.
  	 If called from machine code then increment the byte count since the clock
  	 is derived from it and the clock will not advance otherwise.
  	 If we're simulating threading we're in difficulties.  We need a UI process
  	 (to run activities such as fill-in-the-blanks) but we also need an independent
  	 thread of control to run this VM thread.  So we need to fork a new UI process."
  	Display reverse: (0 at 0 extent: 16 at 16).
  	Sensor peekEvent ifNotNil:
  		[self forceInterruptCheck].
+ 	Processor activeProcess == UIManager default uiProcess ifTrue:
- 	Processor activeProcess == Project uiProcess ifTrue:
  		[World doOneCycle].
  	microseconds >= 1000
  		ifTrue: [self isThreadedVM ifTrue:
  					[self forceInterruptCheckFromHeartbeat].
  				(Delay forMilliseconds: microseconds + 999 // 1000) wait]
  		ifFalse: [Processor yield].
  	byteCount := byteCount + microseconds - 1.
  	self incrementByteCount!

Item was changed:
  ----- Method: CogVMSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
+ 	| localImageName borderWidth theWindow |
+ 	localImageName := imageName asFileReference basename.
+ 	theWindow := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
- 	| localImageName borderWidth window |
- 	localImageName := imageName
- 							ifNotNil: [FileDirectory default localNameFor: imageName]
- 							ifNil: [' synthetic image'].
- 	window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
  
+ 	theWindow addMorph: (displayView := ImageMorph new image: displayForm)
- 	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.8).
  
+ 	transcript := ThreadSafeTranscript new.
+ 	theWindow addMorph: (PluggableTextMorph
- 	transcript := TranscriptStream on: (String new: 10000).
- 	window addMorph: (PluggableTextMorph
  							on: transcript text: nil accept: nil
  							readSelection: nil menu: #codePaneMenu:shifted:)
  			frame: (0 at 0.8 corner: 0.7 at 1).
+ 	theWindow addMorph: (PluggableTextMorph on: self
- 	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil
  						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  			frame: (0.7 at 0.8 corner: 1 at 1).
  
  	borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
  						on: MessageNotUnderstood
  						do: [:ex| 0]. "3.8"
+ 	borderWidth := borderWidth + theWindow borderWidth.
+ 	theWindow openInWorldExtent: (self desiredDisplayExtent
- 	borderWidth := borderWidth + window borderWidth.
- 	window openInWorldExtent: (self desiredDisplayExtent
  								+ (2 * borderWidth)
+ 								+ (0 at theWindow labelHeight)
+ 								* (1@(1/0.8))) rounded!
- 								+ (0 at window labelHeight)
- 								* (1@(1/0.8))) rounded.
- 	^window!

Item was changed:
  ----- Method: CogVMSimulator>>openAsMorphNoTranscript (in category 'UI') -----
  openAsMorphNoTranscript
  	"Open a morphic view on this simulation."
+ 	| localImageName theWindow |
+ 	localImageName := imageName asFileReference basename.
+ 	theWindow := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
- 	| localImageName borderWidth window |
- 	localImageName := FileDirectory default localNameFor: imageName.
- 	window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
  
+ 	theWindow addMorph: (displayView := ImageMorph new image: displayForm)
- 	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.95).
  
+ 	theWindow addMorph: (PluggableTextMorph on: self
- 	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil
  						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  		frame: (0 at 0.95 corner: 1 at 1).
  
+ 	theWindow openInWorldExtent: (self desiredDisplayExtent
+ 								+ (2 * theWindow borderWidth)
+ 								+ (0 at theWindow labelHeight)
- 	borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
- 						on: MessageNotUnderstood
- 						do: [:ex| 0]. "3.8"
- 	borderWidth := borderWidth + window borderWidth.
- 	window openInWorldExtent: (self desiredDisplayExtent
- 								+ (2 * borderWidth)
- 								+ (0 at window labelHeight)
  								* (1@(1/0.95))) rounded!

Item was changed:
  ----- Method: CogVMSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
  primitiveDirectoryEntry
  	| name pathName array result |
  	name := self stringOf: self stackTop.
  	pathName := self stringOf: (self stackValue: 1).
  	
  	self successful ifFalse:
  		[^self primitiveFail].
  
+ 	array := FileSystem workingDirectory primLookupEntryIn: pathName name: name.
- 	array := FileDirectory default primLookupEntryIn: pathName name: name.
  	array == nil ifTrue:
  		[self pop: 3 thenPush: objectMemory nilObject.
  		^array].
  	array == #badDirectoryPath ifTrue:
  		[self halt.
  		^self primitiveFail].
  
+ 	result := self makeDirEntryName: (array at: 1) 
+ 		size: (array at: 1) size
+ 		createDate: (array at: 2) 
+ 		modDate: (array at: 3)
+ 		isDir: (array at: 4)  
+ 		fileSize: (array at: 5)
+ 		posixPermissions: (array at: 6)
+ 		isSymlink: (array at: 7).
+ 	
- 	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- 				createDate: (array at: 2) modDate: (array at: 3)
- 				isDir: (array at: 4)  fileSize: (array at: 5).
  	self pop: 3.
  	self push: result!

Item was changed:
  ----- Method: CogVMSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
  primitiveDirectoryLookup
  	| index pathName array result |
  	index := self stackIntegerValue: 0.
  	pathName := (self stringOf: (self stackValue: 1)).
  	
  	self successful ifFalse:
  		[^self primitiveFail].
  
+ 	array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
- 	array := FileDirectory default primLookupEntryIn: pathName index: index.
  
  	array == nil ifTrue:
  		[self pop: 3 thenPush: objectMemory nilObject.
  		^array].
  	array == #badDirectoryPath ifTrue:
  		["self halt."
  		^self primitiveFail].
  
+ 	result := self makeDirEntryName: (array at: 1) 
+ 		size: (array at: 1) size
+ 		createDate: (array at: 2) 
+ 		modDate: (array at: 3)
+ 		isDir: (array at: 4)  
+ 		fileSize: (array at: 5)
+ 		posixPermissions: (array at: 6)
+ 		isSymlink: (array at: 7).
- 	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- 				createDate: (array at: 2) modDate: (array at: 3)
- 				isDir: (array at: 4)  fileSize: (array at: 5).
  	self pop: 3 thenPush: result!

Item was changed:
  ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	#(	'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  		'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass'
  		'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  		'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
  		'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
  			[:simulationVariableNotNeededForRealVM|
  			aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
  	NewspeakVM ifFalse:
  		[#(	'dynSuperEntry' 'dynSuperEntryAlignment' 'dynamicSuperSendTrampolines'
  			'ceImplicitReceiverTrampoline' 'ceEnclosingObjectTrampoline' 'cmDynSuperEntryOffset'
  			'numIRCs' 'indexOfIRC' 'theIRCs') do:
  				[:variableNotNeededInNormalVM|
  				aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
  	aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
+ 		addHeaderFile:'<setjmp.h>';
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"dispdbg.h"'; "must preceed cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
  		addHeaderFile:'"cogmethod.h"';
  		addHeaderFile:'#if COGMTVM';
  		addHeaderFile:'"cointerpmt.h"';
  		addHeaderFile:'#else';
  		addHeaderFile:'"cointerp.h"';
  		addHeaderFile:'#endif';
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator
  		var: #ceGetSP
  			declareC: 'unsigned long (*ceGetSP)(void)';
  		var: #ceCaptureCStackPointers
  			declareC: 'void (*ceCaptureCStackPointers)(void)';
  		var: #ceEnterCogCodePopReceiverReg
  			declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
  		var: #realCEEnterCogCodePopReceiverReg
  			declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverReg
  			declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
  		var: #realCECallCogCodePopReceiverReg
  			declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
  		var: #realCECallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
  		var: #ceFlushICache
  			declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
  		var: #ceCheckFeaturesFunction
  			declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
  		var: #ceTryLockVMOwner
  			declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
  		var: #ceUnlockVMOwner
  			declareC: 'void (*ceUnlockVMOwner)(void)';
  		var: #postCompileHook
  			declareC: 'void (*postCompileHook)(CogMethod *, void *)';
  		var: #openPICList declareC: 'CogMethod *openPICList = 0';
  		var: #maxMethodBefore type: #'CogBlockMethod *'.
  	aCCodeGenerator
  		declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
  		var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
  		var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel';
  		var: #primInvokeLabel type: #'AbstractInstruction *'.
  	self declareC: #(abstractOpcodes stackCheckLabel
  					blockEntryLabel blockEntryNoContextSwitch
  					stackOverflowCall sendMiss entry noCheckEntry dynSuperEntry
  					picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1)
  			as: #'AbstractInstruction *'
  				in: aCCodeGenerator.
  	aCCodeGenerator
  		declareVar: #annotations type: #'InstructionAnnotation *';
  		declareVar: #blockStarts type: #'BlockStart *';
  		declareVar: #fixups type: #'BytecodeFixup *'.
  	aCCodeGenerator
  		var: #sendTrampolines
  			declareC: 'sqInt sendTrampolines[NumSendTrampolines]';
  		var: #superSendTrampolines
  			declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
  		var: #dynamicSuperSendTrampolines
  			declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  		var: #trampolineAddresses
  			declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  		var: #objectReferencesInRuntime
  			declareC: 'static sqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
  		var: #labelCounter
  			type: #int;
  		var: #traceFlags
  			declareC: 'int traceFlags = 8 /* prim trace log on by default */';
  		var: #cStackAlignment
  			declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
  	aCCodeGenerator
  		declareVar: #CFramePointer type: #'void *';
  		declareVar: #CStackPointer type: #'void *';
  		declareVar: #minValidCallAddress type: #'unsigned long';
  		declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
  	aCCodeGenerator vmClass generatorTable ifNotNil:
  		[:bytecodeGenTable|
  		aCCodeGenerator
  			var: #generatorTable
+ 				declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']',
- 				declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']',
  							(self tableInitializerFor: bytecodeGenTable
  								in: aCCodeGenerator);
  			var: #primitiveGeneratorTable
  				declareC: 'static PrimitiveDescriptor primitiveGeneratorTable[MaxCompiledPrimitiveIndex+1]',
  							(self tableInitializerFor: aCCodeGenerator vmClass primitiveTable
  								in: aCCodeGenerator)].
  	"In C the abstract opcode names clash with the Smalltak generator syntactic sugar.
  	 Most of the syntactic sugar is inlined, but alas some remains.  Rename the syntactic
  	 sugar to avoid the clash."
  	(self organization listAtCategoryNamed: #'abstract instructions') do:
  		[:s|
  		aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
  	aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!

Item was changed:
  ----- Method: Cogit>>genCallEnilopmartFor:and:called: (in category 'initialization') -----
  genCallEnilopmartFor: regArg1 and: regArg2 called: trampolineName
  	"An enilopmart (the reverse of a trampoline) is a piece of code that makes
  	 the system-call-like transition from the C runtime into generated machine
  	 code.  This version is for entering code as if from a call.  The desired
  	 arguments and entry-point are pushed on a stackPage's stack, and beneath
  	 them is the call's return address.  The enilopmart pops off the values to be
  	 loaded into registers, and on CISCs then executes a return instruction to pop
  	 off the entry-point and jump to it.  On RISCs the enilopmart pops off the values
  	 to be loaded into registers, pops the entry-point into a scratch register, pops
  	 the return address into the LinkReg and then jumps to the entry point.
  
  						BEFORE				AFTER			(stacks grow down)
  						whatever			stackPointer ->	whatever
  						call return pc
  						target address =>	reg1 = reg1val, etc
  						reg1val				LinkReg = call return pc
  		stackPointer ->	reg2val				pc = target address
  
  	 C.F. genEnilopmartFor:and:and:called:"
  	<returnTypeC: 'void (*genCallEnilopmartForandcalled(sqInt regArg1, sqInt regArg2, char *trampolineName))(void)'>
  	| size endAddress enilopmart |
  	opcodeIndex := 0.
  	backEnd genLoadStackPointers.
  	self PopR: regArg2.
  	self PopR: regArg1.
  	backEnd hasLinkRegister
  		ifTrue:
  			[self PopR: TempReg.
  			 self PopR: LinkReg.
  			 self JumpR: TempReg]
  		ifFalse:
  			[self RetN: 0].
  	self computeMaximumSizes.
  	size := self generateInstructionsAt: methodZoneBase.
  	endAddress := self outputInstructionsAt: methodZoneBase.
  	self assert: methodZoneBase + size = endAddress.
  	enilopmart := methodZoneBase.
  	methodZoneBase := self alignUptoRoutineBoundary: endAddress.
  	backEnd nopsFrom: endAddress to: methodZoneBase - 1.
  	self recordGeneratedRunTime: trampolineName address: enilopmart.
  	^self cCoerceSimple: enilopmart to: #'void (*)(void)'!

Item was changed:
  ----- Method: Cogit>>genCallEnilopmartFor:called: (in category 'initialization') -----
  genCallEnilopmartFor: regArg1 called: trampolineName
  	"An enilopmart (the reverse of a trampoline) is a piece of code that makes
  	 the system-call-like transition from the C runtime into generated machine
  	 code.  This version is for entering code as if from a call.  The desired
  	 arguments and entry-point are pushed on a stackPage's stack, and beneath
  	 them is the call's return address.  The enilopmart pops off the values to be
  	 loaded into registers, and on CISCs then executes a return instruction to pop
  	 off the entry-point and jump to it.  On RISCs the enilopmart pops off the values
  	 to be loaded into registers, pops the entry-point into a scratch register, pops
  	 the return address into the LinkReg and then jumps to the entry point.
  
  						BEFORE				AFTER			(stacks grow down)
  						whatever			stackPointer ->	whatever
  						call return pc		reg1 = reg1val
  						target address =>	LinkReg = call return pc
  		stackPointer ->	reg1val				pc = target address
  
  	 C.F. genEnilopmartFor:and:and:called:"
  	<returnTypeC: 'void (*genCallEnilopmartForcalled(sqInt regArg1, char *trampolineName))(void)'>
  	| size endAddress enilopmart |
  	opcodeIndex := 0.
  	backEnd genLoadStackPointers.
  	self PopR: regArg1.
  	backEnd hasLinkRegister
  		ifTrue:
  			[self PopR: TempReg.
  			 self PopR: LinkReg.
  			 self JumpR: TempReg]
  		ifFalse:
  			[self RetN: 0].
  	self computeMaximumSizes.
  	size := self generateInstructionsAt: methodZoneBase.
  	endAddress := self outputInstructionsAt: methodZoneBase.
  	self assert: methodZoneBase + size = endAddress.
  	enilopmart := methodZoneBase.
  	methodZoneBase := self alignUptoRoutineBoundary: endAddress.
  	backEnd nopsFrom: endAddress to: methodZoneBase - 1.
  	self recordGeneratedRunTime: trampolineName address: enilopmart.
  	^self cCoerceSimple: enilopmart to: #'void (*)(void)'!

Item was changed:
  ----- Method: Cogit>>print: (in category 'printing') -----
  print: aString
+ 	<cmacro: '(aString) printf("%s", aString)'>
- 	<cmacro: '(aString) printf(aString)'>
  	coInterpreter transcript print: aString!

Item was changed:
  ----- Method: CrossPlatformVMMaker>>validatePlugin:in: (in category 'generate sources') -----
  validatePlugin: plName in: listOfPlugins
  	"Check that the class for the plugin exists, and answer that class.
  	 No longer check that if the plugin requires platform files that at least
  	 one platform subdirectory exists, not producing the source is not helpful."
  	| plugin |
  	plName isString
  		ifTrue: [(listOfPlugins includes: plName)
  				ifTrue: [plugin := Smalltalk classNamed: plName]]
  		ifFalse: [((plName isBehavior
  						and: [plName inheritsFrom: InterpreterPlugin])
  					and: [listOfPlugins includes: plName name])
  				ifTrue: [plugin := plName]].
  	plugin ifNil: [^ self couldNotFindPluginClass: plName].
  	plugin shouldBeTranslated ifFalse:
+ 		[self error: 'untranslateable plugin class ', plugin name].
- 		[self error: 'untranslateable plugin class ', plName].
  	^plugin!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation>>compactClassIndexOfClass: (in category 'accessing') -----
  compactClassIndexOfClass: classOop
  	"Ugh, can't reply on the host.  Spur doesn't have compact classes"
  	| aClass |
  	aClass := self objectForOop: classOop.
  	^false
  		ifTrue: [aClass indexIfCompact]
  		ifFalse:
  			[aClass caseOf: {
  				[CompiledMethod]		->	[1].
  				[Array]					->	[3].
  				[LargeNegativeInteger]	->	[4].
  				[LargePositiveInteger]	->	[5].
  				[Float]					->	[6].
  				[Association]			->	[8].
  				[Point]					->	[9].
  				[Rectangle]				->	[10].
  				[ByteString]			->	[11].
+ 				[Context]		->	[14].
- 				[MethodContext]		->	[14].
  				[Bitmap]				->	[16]
  				}
  				otherwise: [0]]!

Item was removed:
- ----- Method: DetailedInstructionPrinter class>>on: (in category 'instance creation') -----
- on: method 
- 	"Answer an instance of me on the argument, method."
- 
- 	^self new method: method pc: method initialPC!

Item was added:
+ SmartSyntaxInterpreterPlugin subclass: #DisplayPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!

Item was removed:
- ----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'directory primitives') -----
- makeDirEntryName: entryName size: entryNameSize
- 	createDate: createDate modDate: modifiedDate
- 	isDir: dirFlag fileSize: fileSize
- 
- 	| modDateOop createDateOop nameString results stringPtr fileSizeOop |
- 	<var: 'entryName' type: 'char *'>
- 	<var: 'stringPtr' type:'char *'>
- 	<var: 'fileSize' type:'squeakFileOffsetType '>
- 
- 	"allocate storage for results, remapping newly allocated
- 	 oops in case GC happens during allocation"
- 	interpreterProxy pushRemappableOop:
- 		(interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 5).
- 	interpreterProxy pushRemappableOop:
- 		(interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
- 	interpreterProxy pushRemappableOop: 
- 		(interpreterProxy positive32BitIntegerFor: createDate).
- 	interpreterProxy pushRemappableOop: 
- 		(interpreterProxy positive32BitIntegerFor: modifiedDate).
- 	interpreterProxy pushRemappableOop:
- 		(interpreterProxy positive64BitIntegerFor: fileSize).
- 
- 	fileSizeOop   := interpreterProxy popRemappableOop.
- 	modDateOop   := interpreterProxy popRemappableOop.
- 	createDateOop := interpreterProxy popRemappableOop.
- 	nameString    := interpreterProxy popRemappableOop.
- 	results         := interpreterProxy popRemappableOop.
- 
- 	"copy name into Smalltalk string"
- 	stringPtr := interpreterProxy firstIndexableField: nameString.
- 	0 to: entryNameSize - 1 do: [ :i |
- 		stringPtr at: i put: (entryName at: i).
- 	].
- 
- 	interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
- 	interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
- 	interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
- 	dirFlag
- 		ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
- 		ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
- 	interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
- 	^ results!

Item was added:
+ ----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'directory primitives') -----
+ makeDirEntryName: entryName 
+ 	size: entryNameSize
+ 	createDate: createDate 
+ 	modDate: modifiedDate
+ 	isDir: dirFlag 
+ 	fileSize: fileSize
+ 	posixPermissions: posixPermissions
+ 	isSymlink: symlinkFlag
+ 
+ 	| modDateOop createDateOop nameString results stringPtr posixPermissionsOop fileSizeOop |
+ 	<var: 'entryName' type: 'char *'>
+ 	<var: 'stringPtr' type: 'char *'>
+ 	<var: 'fileSize' type: 'squeakFileOffsetType '>
+ 
+ 	"allocate storage for results, remapping newly allocated
+ 	 oops in case GC happens during allocation"
+ 	interpreterProxy pushRemappableOop:
+ 		(interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 7).
+ 	interpreterProxy pushRemappableOop:
+ 		(interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
+ 	interpreterProxy pushRemappableOop: 
+ 		(interpreterProxy positive32BitIntegerFor: createDate).
+ 	interpreterProxy pushRemappableOop: 
+ 		(interpreterProxy positive32BitIntegerFor: modifiedDate).
+ 	interpreterProxy pushRemappableOop:
+ 		(interpreterProxy positive64BitIntegerFor: fileSize).
+ 	interpreterProxy pushRemappableOop: 
+ 		(interpreterProxy positive32BitIntegerFor: posixPermissions).
+ 
+ 	posixPermissionsOop := interpreterProxy popRemappableOop.
+ 	fileSizeOop := interpreterProxy popRemappableOop.
+ 	modDateOop := interpreterProxy popRemappableOop.
+ 	createDateOop := interpreterProxy popRemappableOop.
+ 	nameString  := interpreterProxy popRemappableOop.
+ 	results := interpreterProxy popRemappableOop.
+ 
+ 	"copy name into Smalltalk string"
+ 	stringPtr := interpreterProxy firstIndexableField: nameString.
+ 	0 to: entryNameSize - 1 do: [ :i |
+ 		stringPtr at: i put: (entryName at: i).
+ 	].
+ 
+ 	interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
+ 	interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
+ 	interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
+ 	dirFlag
+ 		ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
+ 		ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
+ 	interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
+ 	interpreterProxy storePointer: 5 ofObject: results withValue: posixPermissionsOop.
+ 	symlinkFlag
+ 		ifTrue: [ interpreterProxy storePointer:  6 ofObject: results withValue: interpreterProxy trueObject ]
+ 		ifFalse: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy falseObject ].
+ 	^ results!

Item was changed:
  ----- Method: FilePlugin>>primitiveDirectoryEntry (in category 'directory primitives') -----
  primitiveDirectoryEntry
  
  	"Two arguments - directory path, and simple file name;
   	 returns an array (see primitiveDirectoryLookup) describing the file or directory,
   	 or nil if it does not exist.  
  	 Primitive fails if the outer path does not identify a readable directory.
  	 (This is a lookup-by-name variant of primitiveDirectoryLookup.)"
  
+ 	| requestedName pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag posixPermissions symlinkFlag fileSize okToList reqNameIndex reqNameSize |
- 	| requestedName pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag fileSize okToList reqNameIndex reqNameSize |
  	<var: 'entryName' declareC: 'char entryName[256]'>
  	<var: 'pathNameIndex' type: 'char *'>
  	<var: 'reqNameIndex' type: 'char *'>
  	<var: 'fileSize' type: 'squeakFileOffsetType'>
  	<export: true>
  
  	requestedName := interpreterProxy stackValue: 0.
  	pathName := interpreterProxy stackValue: 1.
  	(interpreterProxy isBytes: pathName)
  		ifFalse: [^interpreterProxy primitiveFail].
  
  	"Outbound string parameters"
  	pathNameIndex := interpreterProxy firstIndexableField: pathName.
  	pathNameSize := interpreterProxy byteSizeOf: pathName.
  
  	reqNameIndex := interpreterProxy firstIndexableField: requestedName.
  	reqNameSize := interpreterProxy byteSizeOf: requestedName.
  
  	"If the security plugin can be loaded, use it to check for permission. 
  	If not, assume it's ok"
  	sCLPfn ~= 0
  		ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)']
  		ifFalse: [okToList := true].
  	okToList
+ 		ifTrue: [status := self cCode: 'dir_EntryLookup(
+ 			pathNameIndex, 
+ 			pathNameSize, 
+ 			reqNameIndex, 
+ 			reqNameSize,										  
+ 			entryName, 
+ 			&entryNameSize, 
+ 			&createDate,
+ 			&modifiedDate, 
+ 			&dirFlag, 
+ 			&fileSize, 
+ 			&posixPermissions,
+ 			&symlinkFlag)']
- 		ifTrue: [status := self cCode: 'dir_EntryLookup(pathNameIndex, pathNameSize, reqNameIndex, reqNameSize,
- 													  entryName, &entryNameSize, &createDate,
- 													  &modifiedDate, &dirFlag, &fileSize)']
  		ifFalse: [status := DirNoMoreEntries].
  
  	interpreterProxy failed
  		ifTrue: [^nil].
  	status = DirNoMoreEntries
  		ifTrue: ["no entry; return nil"
  			interpreterProxy pop: 3 "pop pathName, index, rcvr"
  				thenPush: interpreterProxy nilObject.
  			^nil].
  	status = DirBadPath
  		ifTrue: [^interpreterProxy primitiveFail]."bad path"
  
  	interpreterProxy pop: 3	"pop pathName, fName, rcvr" 
  		thenPush: (self
  				makeDirEntryName: entryName
  				size: entryNameSize
  				createDate: createDate
  				modDate: modifiedDate
  				isDir: dirFlag
+ 				fileSize: fileSize 
+ 				posixPermissions: posixPermissions
+ 				isSymlink: symlinkFlag)!
- 				fileSize: fileSize)!

Item was changed:
  ----- Method: FilePlugin>>primitiveDirectoryLookup (in category 'directory primitives') -----
  primitiveDirectoryLookup
  
+ 	| index pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag symlinkFlag posixPermissions fileSize okToList |
- 	| index pathName pathNameIndex pathNameSize status entryName entryNameSize createDate modifiedDate dirFlag fileSize okToList |
  	<var: 'entryName' declareC: 'char entryName[256]'>
  	<var: 'pathNameIndex' type: 'char *'>
  	<var: 'fileSize' type: 'squeakFileOffsetType'>
  	<export: true>
  
  	index := interpreterProxy stackIntegerValue: 0.
  	pathName := interpreterProxy stackValue: 1.
  	(interpreterProxy isBytes: pathName)
  		ifFalse: [^interpreterProxy primitiveFail].
  	pathNameIndex := interpreterProxy firstIndexableField: pathName.
  	pathNameSize := interpreterProxy byteSizeOf: pathName.
  	"If the security plugin can be loaded, use it to check for permission. 
  	If not, assume it's ok"
  	sCLPfn ~= 0
  		ifTrue: [okToList := self cCode: '((sqInt (*)(char *, sqInt))sCLPfn)(pathNameIndex, pathNameSize)']
  		ifFalse: [okToList := true].
  	okToList
+ 		ifTrue: [status := self cCode: 'dir_Lookup(
+ 			pathNameIndex, 
+ 			pathNameSize, 
+ 			index,
+ 			entryName, 
+ 			&entryNameSize, 
+ 			&createDate,
+ 			&modifiedDate, 
+ 			&dirFlag, 
+ 			&fileSize, 
+ 			&posixPermissions,
+ 			&symlinkFlag)']
- 		ifTrue: [status := self cCode: 'dir_Lookup(pathNameIndex, pathNameSize, index,
- 												entryName, &entryNameSize, &createDate,
- 												&modifiedDate, &dirFlag, &fileSize)']
  		ifFalse: [status := DirNoMoreEntries].
  	interpreterProxy failed
  		ifTrue: [^nil].
  	status = DirNoMoreEntries
  		ifTrue: ["no more entries; return nil"
  			interpreterProxy pop: 3 "pop pathName, index, rcvr"
  				thenPush: interpreterProxy nilObject.
  			^nil].
  	status = DirBadPath
  		ifTrue: [^interpreterProxy primitiveFail]."bad path"
  
  	interpreterProxy pop: 3	"pop pathName, index, rcvr" 
  		thenPush: (self
  				makeDirEntryName: entryName
  				size: entryNameSize
  				createDate: createDate
  				modDate: modifiedDate
  				isDir: dirFlag
+ 				fileSize: fileSize
+ 				posixPermissions: posixPermissions
+ 				isSymlink: symlinkFlag)!
- 				fileSize: fileSize)!

Item was removed:
- ----- Method: FilePluginSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'simulation') -----
- makeDirEntryName: entryName size: entryNameSize
- 	createDate: createDate modDate: modifiedDate
- 	isDir: dirFlag fileSize: fileSize
- 
- 	^interpreterProxy
- 		makeDirEntryName: entryName size: entryNameSize
- 		createDate: createDate modDate: modifiedDate
- 		isDir: dirFlag fileSize: fileSize
- !

Item was added:
+ ----- Method: FilePluginSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'file primitives') -----
+ makeDirEntryName: entryName 
+ 	size: entryNameSize
+ 	createDate: createDate 
+ 	modDate: modifiedDate
+ 	isDir: dirFlag 
+ 	fileSize: fileSize 
+ 	posixPermissions: posixPermissions
+ 	isSymlink: symlinkFlag
+ 	
+ 	^interpreterProxy
+ 		makeDirEntryName: entryName 
+ 		size: entryNameSize
+ 		createDate: createDate 
+ 		modDate: modifiedDate
+ 		isDir: dirFlag 
+ 		fileSize: fileSize
+ 		posixPermissions: posixPermissions
+ 		isSymlink: symlinkFlag
+ !

Item was changed:
  ----- Method: Integer>>asUnsignedInteger (in category '*VMMaker-interpreter simulator') -----
  asUnsignedInteger
  	self assert: self >= 0.
  	^self!

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

Item was changed:
  ----- Method: Interpreter>>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 memStart bytesRead bytesToShift heapSize |
  	<var: #f type: 'sqImageFile '>
  	<var: #desiredHeapSize type: 'usqInt'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #dataSize type: 'size_t '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
  	metaclassSizeBits := 6 * self wordSize.	"guess (Metaclass instSize * BPW)"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - self wordSize.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize				:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr			:= self getLongFromFile: f swap: swapBytes.
  	specialObjectsOop	:= self getLongFromFile: f swap: swapBytes.
  	lastHash			:= self getLongFromFile: f swap: swapBytes.
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	fullScreenFlag		:= self getLongFromFile: f swap: swapBytes.
  	extraVMMemory		:= self getLongFromFile: f swap: swapBytes.
  
  	lastHash = 0 ifTrue: [
  		"lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
  		lastHash := 999].
  
  	"decrease Squeak object heap to leave extra memory for the VM"
  	heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
  
  	"compare memory requirements with availability".
  	minimumMemory := dataSize + 100000.  "need at least 100K of breathing room"
  	heapSize < minimumMemory ifTrue: [
  		self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap"
  	memory := self cCode: 'sqAllocateMemory(minimumMemory, heapSize)'.
  	memory = nil ifTrue: [self insufficientMemoryAvailableError].
  
  	memStart := self startOfMemory.
  	self setMemoryLimit: (memStart + heapSize) - 24.  "decrease memoryLimit a tad for safety"
  	self setEndOfMemory: memStart + 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 := self cCode: 'sqImageFileReadEntireImage(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.		
- 	bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	swapBytes ifTrue: [self reverseBytesInImage].
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := memStart - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	^ dataSize
  !

Item was changed:
  ----- Method: InterpreterPlugin class>>shouldBeTranslated (in category 'translation') -----
  shouldBeTranslated
  "is this class intended to be translated as a plugin? Most subclasses should answer true, but some such as:-
  	TestInterpreterPlugin
  	FlippArrayPlugin2
  	InflatePlugin
  	should answer false for various reasons."
  	^true!

Item was changed:
  ----- Method: InterpreterPlugin class>>shouldBeTranslatedFor: (in category 'translation') -----
  shouldBeTranslatedFor: platformName
  	"Is this class intended to be translated as a plugin, perhaps specific to a platform?
  	 Most subclasses should answer true, but some such as simulation-only versions
  	 should answer false for various reasons."
  	^self shouldBeTranslated!

Item was changed:
  ----- Method: InterpreterPlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
  translateInDirectory: directory doInlining: inlineFlag
  "This is the default method for writing out sources for a plugin. Several classes need special handling, so look at all implementors of this message"
  	| cg fname fstat |
  	 fname := self moduleName, '.c'.
  
  	"don't translate if the file is newer than my timeStamp"
  	fstat := directory entryAt: fname ifAbsent:[nil].
  	fstat ifNotNil:
  		[((self pluginClassesUpTo: self) allSatisfy:
+ 				[:aPluginClass| aPluginClass timeStamp < fstat modificationTime asSeconds ]) ifTrue:
- 				[:aPluginClass| aPluginClass timeStamp < fstat modificationTime]) ifTrue:
  			[^nil]].
  
  	self initialize.
  	cg := self buildCodeGeneratorUpTo: self.
  	cg inferTypesForImplicitlyTypedVariablesAndMethods.
  	self pruneUnusedInterpreterPluginMethodsIn: cg.
  	cg storeCodeOnFile:  (directory fullNameFor: fname) doInlining: inlineFlag.
  	^cg exportedPrimitiveNames asArray!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveGetNextEvent (in category 'I/O primitives') -----
  primitiveGetNextEvent
  	"Primitive. Return the next input event from the VM event queue."
+ 	| evtBuf arg value eventTypeIs |
- 	| evtBuf arg value |
  	<var: #evtBuf declareC:'int evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'>
  	self cCode:'' inSmalltalk:[evtBuf := CArrayAccessor on: (IntegerArray new: 8)].
  	arg := self stackTop.
  	((objectMemory isArray: arg) and:[(objectMemory slotSizeOf: arg) = 8])  ifFalse:[^self primitiveFail].
  
  	self ioGetNextEvent: (self cCoerce: evtBuf to: 'sqInputEvent*').
  	self successful ifFalse:[^nil].
  
  	"Event type"
+ 	eventTypeIs := evtBuf at: 0.
  	self storeInteger: 0 ofObject: arg withValue: (evtBuf at: 0).
  	self successful ifFalse:[^nil].
  
+ 	"Event is Complex, assume evtBuf is populated correctly and return"
+ 	eventTypeIs = 6 
+ 		ifTrue: [ 
+ 			1 to: 7 do: [:i |
+ 				value := evtBuf at: i.
+ 				self storePointer: i ofObject: arg withValue: value]]
+ 	ifFalse: [
+ 		"Event time stamp"
+ 		self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
+ 		self successful ifFalse:[^nil].	
- 	"Event time stamp"
- 	self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
- 	self successful ifFalse:[^nil].
  
+ 		"Event arguments"
+ 		2 to: 7 do:[:i|
+ 			value := evtBuf at: i.
+ 			(objectMemory isIntegerValue: value)
+ 				ifTrue:[self storeInteger: i ofObject: arg withValue: value]
+ 				ifFalse:[
+ 					value := self positive32BitIntegerFor: value.
+ 					objectMemory storePointer: i ofObject: arg withValue: value] ] ].
- 	"Event arguments"
- 	2 to: 7 do:[:i|
- 		value := evtBuf at: i.
- 		(objectMemory isIntegerValue: value)
- 			ifTrue:[self storeInteger: i ofObject: arg withValue: value]
- 			ifFalse:[value := self positive32BitIntegerFor: value.
- 				objectMemory storePointer: i ofObject: arg withValue: value]].
  
  	self successful ifFalse:[^nil].
  	self pop: 1!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveImageFormatVersion (in category 'other primitives') -----
+ primitiveImageFormatVersion
+ 	"Answer an integer identifying the type of image. The image version number may
+ 	identify the format of the image (e.g. 32 or 64-bit word size) or specific requirements
+ 	of the image (e.g. block closure support required).
+ 	
+ 	This is a named (not numbered) primitive in the null module (ie the VM)"
+ 
+ 	<export: true>
+ 	self pop: 1 thenPush: (self positive32BitIntegerFor: self imageFormatVersion)
+ !

Item was changed:
  ----- Method: InterpreterProxy>>callbackLeave: (in category 'callback support') -----
  callbackLeave: cbID
  	"Leave from a previous callback"
+ 	"<var: #callbackID type: #'sqInt *'>"
- 	<var: #callbackID type: #'sqInt *'>
  	^self notYetImplementedError!

Item was changed:
  ----- Method: InterpreterProxy>>isImmediate: (in category 'testing') -----
  isImmediate: anObject
  	<option: #(atLeastVMProxyMajor:minor: 1 13)>
  	^StackInterpreter objectMemoryClass isImmediate: anObject!

Item was changed:
  ----- Method: InterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the InterpreterSimulator when running the interpreter inside
  	Smalltalk. The primary responsibility of this method is to allocate
  	Smalltalk Arrays for variables that will be declared as statically-allocated
  	global arrays in the translated code."
  
  	"Note: we must initialize ConstMinusOne differently for simulation,
  		due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := self integerObjectOf: -1.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	rootTable := Array new: RootTableSize.
  	weakRoots := Array new: RootTableSize + RemapBufferSize + 100.
  	remapBuffer := Array new: RemapBufferSize.
  	gcSemaphoreIndex := 0.
  	semaphoresUseBufferA := true.
  	semaphoresToSignalA := Array new: SemaphoresToSignalSize.
  	semaphoresToSignalB := Array new: SemaphoresToSignalSize.
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	primitiveTable := self class primitiveTable.
  	pluginList := {'' -> self }.
  	mappedPluginEntries := #().
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := 0.
  	sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := "printReturns := printBytecodeAtEachStep :=" false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	headerTypeBytes := CArrayAccessor on: HeaderTypeExtraBytes.
  	transcript := Transcript.
+ 	displayForm := 'Display has not yet been installed' asMorph imageForm.
- 	displayForm := 'Display has not yet been installed' asDisplayText form.
  	!

Item was removed:
- ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
- makeDirEntryName: entryName size: entryNameSize
- 	createDate: createDate modDate: modifiedDate
- 	isDir: dirFlag fileSize: fileSize
- 
- 	| modDateOop createDateOop nameString results |
- 	<var: 'entryName' type: 'char *'>
- 
- 	"allocate storage for results, remapping newly allocated
- 	 oops in case GC happens during allocation"
- 	self pushRemappableOop:
- 		(self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
- 	self pushRemappableOop:
- 		(self instantiateClass: (self splObj: ClassByteString) indexableSize: entryNameSize).
- 	self pushRemappableOop: (self positive32BitIntegerFor: createDate).
- 	self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
- 
- 	modDateOop   := self popRemappableOop.
- 	createDateOop := self popRemappableOop.
- 	nameString    := self popRemappableOop.
- 	results         := self popRemappableOop.
- 
- 	1 to: entryNameSize do: [ :i |
- 		self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
- 	].
- 
- 	self storePointer: 0 ofObject: results withValue: nameString.
- 	self storePointer: 1 ofObject: results withValue: createDateOop.
- 	self storePointer: 2 ofObject: results withValue: modDateOop.
- 	dirFlag
- 		ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
- 		ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
- 	self storePointer: 4 ofObject: results
- 		withValue: (self integerObjectOf: fileSize).
- 	^ results
- !

Item was added:
+ ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName 
+ 	size: entryNameSize
+ 	createDate: createDate 
+ 	modDate: modifiedDate
+ 	isDir: dirFlag 
+ 	fileSize: posixPermissions
+ 	posixPermissions: fileSize
+ 
+ 	| modDateOop createDateOop nameString results |
+ 	<var: 'entryName' type: 'char *'>
+ 
+ 	"allocate storage for results, remapping newly allocated
+ 	 oops in case GC happens during allocation"
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize)..
+ 	self pushRemappableOop: (self positive32BitIntegerFor: createDate).
+ 	self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
+ 
+ 	modDateOop   := self popRemappableOop.
+ 	createDateOop := self popRemappableOop.
+ 	nameString    := self popRemappableOop.
+ 	results         := self popRemappableOop.
+ 
+ 	1 to: entryNameSize do: [ :i |
+ 		self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
+ 	].
+ 
+ 	self storePointer: 0 ofObject: results withValue: nameString.
+ 	self storePointer: 1 ofObject: results withValue: createDateOop.
+ 	self storePointer: 2 ofObject: results withValue: modDateOop.
+ 	dirFlag
+ 		ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
+ 		ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
+ 	self storePointer: 4 
+ 		ofObject: results
+ 		withValue: (self integerObjectOf: fileSize).
+ 	self storePointer: 5 
+ 		ofObject: results
+ 		withValue: (self integerObjectOf: posixPermissions).
+ 
+ 	^ results
+ !

Item was added:
+ ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName 
+ 	size: entryNameSize
+ 	createDate: createDate 
+ 	modDate: modifiedDate
+ 	isDir: dirFlag 
+ 	fileSize: posixPermissions
+ 	posixPermissions: fileSize
+ 	isSymlink: symlinkFlag
+ 
+ 	| modDateOop createDateOop nameString results |
+ 	<var: 'entryName' type: 'char *'>
+ 
+ 	"allocate storage for results, remapping newly allocated
+ 	 oops in case GC happens during allocation"
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassArray) indexableSize: 6).
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize)..
+ 	self pushRemappableOop: (self positive32BitIntegerFor: createDate).
+ 	self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
+ 
+ 	modDateOop   := self popRemappableOop.
+ 	createDateOop := self popRemappableOop.
+ 	nameString    := self popRemappableOop.
+ 	results         := self popRemappableOop.
+ 
+ 	1 to: entryNameSize do: [ :i |
+ 		self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
+ 	].
+ 
+ 	self storePointer: 0 ofObject: results withValue: nameString.
+ 	self storePointer: 1 ofObject: results withValue: createDateOop.
+ 	self storePointer: 2 ofObject: results withValue: modDateOop.
+ 	dirFlag
+ 		ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
+ 		ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
+ 	self storePointer: 4 
+ 		ofObject: results
+ 		withValue: (self integerObjectOf: fileSize).
+ 	self storePointer: 5 
+ 		ofObject: results
+ 		withValue: (self integerObjectOf: posixPermissions).
+ 	dirFlag
+ 		ifTrue: [ self storePointer: 6 ofObject: results withValue: trueObj ]
+ 		ifFalse: [ self storePointer: 6 ofObject: results withValue: falseObj ].
+ 
+ 	^ results
+ !

Item was changed:
  ----- Method: InterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
  	| window localImageName |
+ 	localImageName := imageName asFileReference basename.
- 	localImageName := imageName
- 							ifNotNil: [FileDirectory default localNameFor: imageName]
- 							ifNil: [' synthetic image'].
  	window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
  
  	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.8).
  
+ 	transcript := ThreadSafeTranscript new.
- 	transcript := TranscriptStream on: (String new: 10000).
  	window addMorph: (PluggableTextMorph on: transcript text: nil accept: nil
  			readSelection: nil menu: #codePaneMenu:shifted:)
  		frame: (0 at 0.8 corner: 0.7 at 1).
  
  	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil) hideScrollBarsIndefinitely
  		frame: (0.7 at 0.8 corner: 1 at 1).
  
+ 	window openInWorld!
- 	window openInWorld.
- 	^window!

Item was changed:
  ----- Method: InterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
  primitiveDirectoryEntry
  	| name pathName array result |
  	name := self stringOf: self stackTop.
  	pathName := self stringOf: (self stackValue: 1).
  	
  	successFlag ifFalse:
  		[^self primitiveFail].
  
+ 	array := FileSystem workingDirectory primLookupEntryIn: pathName name: name.
- 	array := FileDirectory default primLookupEntryIn: pathName name: name.
  	array == nil ifTrue:
  		[self pop: 3 thenPush: nilObj.
  		^array].
  	array == #badDirectoryPath ifTrue:
  		[self halt.
  		^self primitiveFail].
  
+ 	result := self makeDirEntryName: (array at: 1) 
+ 		size: (array at: 1) size
+ 		createDate: (array at: 2) 
+ 		modDate: (array at: 3)
+ 		isDir: (array at: 4)  
+ 		fileSize: (array at: 5)
+ 		posixPermissions: (array at: 6)
+ 		isSymlink: (array at: 7).
- 	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- 				createDate: (array at: 2) modDate: (array at: 3)
- 				isDir: (array at: 4)  fileSize: (array at: 5).
  	self pop: 3.
  	self push: result!

Item was changed:
  ----- Method: InterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
  primitiveDirectoryLookup
  	| index pathName array result |
  	index := self stackIntegerValue: 0.
  	pathName := (self stringOf: (self stackValue: 1)).
  	
  	successFlag ifFalse: [
  		^self primitiveFail.
  	].
  
+ 	array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
- 	array := FileDirectory default primLookupEntryIn: pathName index: index.
  
  	array == nil ifTrue: [
  		self pop: 3.
  		self push: nilObj.
  		^array.
  	].
  	array == #badDirectoryPath ifTrue: [self halt.
  		^self primitiveFail.
  	].
  
+ 	result := self makeDirEntryName: (array at: 1) 
+ 		size: (array at: 1) size
+ 		createDate: (array at: 2) 
+ 		modDate: (array at: 3)
+ 		isDir: (array at: 4)  
+ 		fileSize: (array at: 5)
+ 		posixPermissions: (array at: 6)
+ 		isSymlink: (array at: 7).
- 	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- 				createDate: (array at: 2) modDate: (array at: 3)
- 				isDir: (array at: 4)  fileSize: (array at: 5).
  	self pop: 3.
  	self push: result.
  !

Item was changed:
  InterpreterPlugin subclass: #MiscPrimitivePlugin
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Plugins'!
  
+ !MiscPrimitivePlugin commentStamp: 'dtl 12/2/2009 11:28' prior: 0!
+ This plugin pulls together a number of translatable methods with no particularly meaningful home. See class>translatedPrimitives for the list.
+ 
+ The primitives in this plugin consist of various methods in the image that can benefit greatly from translation to C, but that do not inherently require translation. These may be thought of not as traditional primitives, but as methods that have been annotated for translation to C by this plugin. This approach allows performance critical methods to be written entirely in Smalltalk, then marked for translation as needed to achieve improved performance.!
- !MiscPrimitivePlugin commentStamp: 'tpr 5/5/2003 12:18' prior: 0!
- This plugin pulls together a number of translatable methods with no particularly meaningful home. See class>translatedPrimitives for the list!

Item was changed:
  ----- Method: MiscPrimitivePlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
  translateInDirectory: directory doInlining: inlineFlag
  "handle a special case code string rather than normal generated code."
  	| cg fname fstat |
  	 fname := self moduleName, '.c'.
  
  	"don't translate if the file is newer than my timeStamp"
  	fstat := directory entryAt: fname ifAbsent:[nil].
+ 	fstat ifNotNil:[self timeStamp < fstat modificationTime asSeconds ifTrue:[^nil]].
- 	fstat ifNotNil:[self timeStamp < fstat modificationTime ifTrue:[^nil]].
  
  	self initialize.
  	cg := self buildCodeGeneratorUpTo: InterpreterPlugin.
  	cg addMethodsForPrimitives: self translatedPrimitives.
  	self pruneUnusedInterpreterPluginMethodsIn: cg.
  	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: fname).
  	^cg exportedPrimitiveNames asArray
  !

Item was changed:
  ----- Method: MiscPrimitivePlugin class>>translatedPrimitives (in category 'translation') -----
  translatedPrimitives
  	"an assorted list of various primitives"
  	^#(
  		(Bitmap compress:toByteArray:)
  		(Bitmap decompress:fromByteArray:at:)
  		(Bitmap encodeBytesOf:in:at:)
  		(Bitmap encodeInt:in:at:)
  		(ByteString compare:with:collated:)
  		(ByteString translate:from:to:table:)	
  		(ByteString findFirstInString:inSet:startingAt:)
  		(ByteString indexOfAscii:inString:startingAt:)
+ 		(String findSubstringViaPrimitive:in:startingAt:matchTable:)
- 		(ByteString findSubstring:in:startingAt:matchTable:)
  		(ByteArray hashBytes:startingWith:)
  		(SampledSound convert8bitSignedFrom:to16Bit:)
  	)
  
  	"| tps |
  	'This opens a list browser on all translated primitives in the image'.
  	 tps := (SystemNavigation default allImplementorsOf: #translatedPrimitives)
  				inject: Set new
  				into: [:tp :mr|
  					tp addAll: (mr actualClass theNonMetaClass translatedPrimitives collect:
  								[:pair|
  								MethodReference
  									class: (((Smalltalk at: pair first) canUnderstand: pair last)
  												ifTrue: [Smalltalk at: pair first]
  												ifFalse: [(Smalltalk at: pair first) class])
  									selector: pair last]);
  						yourself].
  	SystemNavigation default browseMessageList: tps asArray sort name: 'Translated Primitives' "!

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

Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName 
+ 	size: entryNameSize
+ 	createDate: createDate 
+ 	modDate: modifiedDate
+ 	isDir: dirFlag 
+ 	fileSize: posixPermissions 
+ 	posixPermissions: fileSize
+ 
+ 	| modDateOop createDateOop nameString results |
+ 	<var: 'entryName' type: 'char *'>
+ 
+ 	"allocate storage for results, remapping newly allocated
+ 	 oops in case GC happens during allocation"
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize).
+ 	self pushRemappableOop: (self positive32BitIntegerFor: createDate).
+ 	self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
+ 
+ 	modDateOop   := self popRemappableOop.
+ 	createDateOop := self popRemappableOop.
+ 	nameString    := self popRemappableOop.
+ 	results         := self popRemappableOop.
+ 
+ 	1 to: entryNameSize do: [ :i |
+ 		self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
+ 	].
+ 
+ 	self storePointer: 0 ofObject: results withValue: nameString.
+ 	self storePointer: 1 ofObject: results withValue: createDateOop.
+ 	self storePointer: 2 ofObject: results withValue: modDateOop.
+ 	dirFlag
+ 		ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
+ 		ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
+ 	self storePointer: 4 ofObject: results
+ 		withValue: (self integerObjectOf: fileSize).
+ 	self storePointer: 5 ofObject: results
+ 		withValue: (self integerObjectOf: posixPermissions).
+ 	^ results
+ !

Item was added:
+ ----- Method: NewspeakInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName 
+ 	size: entryNameSize
+ 	createDate: createDate 
+ 	modDate: modifiedDate
+ 	isDir: dirFlag 
+ 	fileSize: posixPermissions 
+ 	posixPermissions: fileSize
+ 	isSymlink: symlinkFlag	
+ 
+ 	| modDateOop createDateOop nameString results |
+ 	<var: 'entryName' type: 'char *'>
+ 
+ 	"allocate storage for results, remapping newly allocated
+ 	 oops in case GC happens during allocation"
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassArray) indexableSize: 6).
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassString) indexableSize: entryNameSize).
+ 	self pushRemappableOop: (self positive32BitIntegerFor: createDate).
+ 	self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
+ 
+ 	modDateOop   := self popRemappableOop.
+ 	createDateOop := self popRemappableOop.
+ 	nameString    := self popRemappableOop.
+ 	results         := self popRemappableOop.
+ 
+ 	1 to: entryNameSize do: [ :i |
+ 		self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
+ 	].
+ 
+ 	self storePointer: 0 ofObject: results withValue: nameString.
+ 	self storePointer: 1 ofObject: results withValue: createDateOop.
+ 	self storePointer: 2 ofObject: results withValue: modDateOop.
+ 	dirFlag
+ 		ifTrue: [ self storePointer: 3 ofObject: results withValue: trueObj ]
+ 		ifFalse: [ self storePointer: 3 ofObject: results withValue: falseObj ].
+ 	self storePointer: 4 ofObject: results
+ 		withValue: (self integerObjectOf: fileSize).
+ 	self storePointer: 5 ofObject: results
+ 		withValue: (self integerObjectOf: posixPermissions).
+ 	symlinkFlag
+ 		ifTrue: [ self storePointer: 6 ofObject: results withValue: trueObj ]
+ 		ifFalse: [ self storePointer: 6 ofObject: results withValue: falseObj ].
+ 
+ 	^ results
+ !

Item was changed:
  ----- Method: NewspeakInterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
  	| window localImageName |
+ 	localImageName := imageName asFileReference basename.
- 	localImageName := imageName
- 							ifNotNil: [FileDirectory default localNameFor: imageName]
- 							ifNil: [' synthetic image'].
  	window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
  
  	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.8).
  
+ 	transcript := ThreadSafeTranscript new.
- 	transcript := TranscriptStream on: (String new: 10000).
  	window addMorph: (PluggableTextMorph
  							on: transcript text: nil accept: nil
  							readSelection: nil menu: #codePaneMenu:shifted:)
  			frame: (0 at 0.8 corner: 0.7 at 1).
  
  	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil
  						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  			frame: (0.7 at 0.8 corner: 1 at 1).
  
  	window openInWorldExtent: (self desiredDisplayExtent
  								+ (2 * window borderWidth)
  								+ (0 at window labelHeight)
+ 								* (1@(1/0.8))) rounded!
- 								* (1@(1/0.8))) rounded.
- 	^window!

Item was changed:
  ----- Method: NewspeakInterpreterSimulator>>openAsMorphNoTranscript (in category 'UI') -----
  openAsMorphNoTranscript
  	"Open a morphic view on this simulation."
  	| window localImageName |
+ 	localImageName := imageName asFileReference basename.
- 	localImageName := FileDirectory default localNameFor: imageName.
  	window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
  
  	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.95).
  
  	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil) hideScrollBarsIndefinitely
  		frame: (0 at 0.95 corner: 1 at 1).
  
  	window openInWorldExtent: (self desiredDisplayExtent
  								+ (2 * window borderWidth)
  								+ (0 at window labelHeight)
  								* (1@(1/0.95))) rounded!

Item was changed:
  ----- Method: NewspeakInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
  primitiveDirectoryEntry
  	| name pathName array result |
  	name := self stringOf: self stackTop.
  	pathName := self stringOf: (self stackValue: 1).
  	
  	self successful ifFalse:
  		[^self primitiveFail].
  
+ 	array := FileSystem workingDirectory primLookupEntryIn: pathName name: name.
- 	array := FileDirectory default primLookupEntryIn: pathName name: name.
  	array == nil ifTrue:
  		[self pop: 3 thenPush: nilObj.
  		^array].
  	array == #badDirectoryPath ifTrue:
  		[self halt.
  		^self primitiveFail].
  
+ 	result := self makeDirEntryName: (array at: 1) 
+ 		size: (array at: 1) size
+ 		createDate: (array at: 2) 
+ 		modDate: (array at: 3)
+ 		isDir: (array at: 4)  
+ 		fileSize: (array at: 5)
+ 		posixPermissions: (array at: 6)
+ 		isSymlink: (array at: 7).
- 	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- 				createDate: (array at: 2) modDate: (array at: 3)
- 				isDir: (array at: 4)  fileSize: (array at: 5).
  	self pop: 3.
  	self push: result!

Item was changed:
  ----- Method: NewspeakInterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
  primitiveDirectoryLookup
  	| index pathName array result |
  	index := self stackIntegerValue: 0.
  	pathName := (self stringOf: (self stackValue: 1)).
  	
  	self successful ifFalse: [
  		^self primitiveFail.
  	].
  
+ 	array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
- 	array := FileDirectory default primLookupEntryIn: pathName index: index.
  
  	array == nil ifTrue: [
  		self pop: 3.
  		self push: nilObj.
  		^array.
  	].
  	array == #badDirectoryPath ifTrue: [self halt.
  		^self primitiveFail.
  	].
  
+ 	result := self makeDirEntryName: (array at: 1) 
+ 		size: (array at: 1) size
+ 		createDate: (array at: 2) 
+ 		modDate: (array at: 3)
+ 		isDir: (array at: 4)  
+ 		fileSize: (array at: 5)
+ 		posixPermissions: (array at: 6)
+ 		isSymlink: (array at: 7).
- 	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- 				createDate: (array at: 2) modDate: (array at: 3)
- 				isDir: (array at: 4)  fileSize: (array at: 5).
  	self pop: 3.
  	self push: result.
  !

Item was changed:
  ----- Method: ObjectMemory class>>initializeObjectHeaderConstants (in category 'initialization') -----
  initializeObjectHeaderConstants
  
  	BytesPerWord ifNil: [BytesPerWord := 4].  "May get called on fileIn, so supply default"
  	BaseHeaderSize := BytesPerWord.
+ 	BytesPerOop := BytesPerWord.
  	WordMask := (1 bitShift: BytesPerWord*8) - 1.
  	
  	"masks for type field"
  	TypeMask := 3.
  	AllButTypeMask := WordMask - TypeMask.
  
  	"type field values"
  	HeaderTypeSizeAndClass := 0.
  	HeaderTypeClass := 1.
  	HeaderTypeFree := 2.
  	HeaderTypeShort := 3.
  	HeaderTypeExtraBytes := { BytesPerWord * 2. BytesPerWord. 0. 0 }.
  
  	"type field values used during the mark phase of GC"
  	HeaderTypeGC := 2.
  	GCTopMarker := 3.  "neither an oop, nor an oop+1, this value signals that we have crawled back up to the top of the marking phase."
  
  	"Base header word bit fields"
  	HashBits := 16r1FFE0000.
  	HashBitsOffset := 17.
  	HashMaskUnshifted := 16rFFF.
  	self assert: (HashMaskUnshifted bitShift: HashBitsOffset) = HashBits.
  	AllButHashBits := WordMask - HashBits.
  	SizeMask := 16rFC.
  	Size4Bit := 0.
  BytesPerWord = 8 ifTrue:
  		[SizeMask := 16rF8.  "Lose the 4 bit in temp 64-bit chunk format"
  		Size4Bit := 4].  "But need it for ST size"
  	"Note SizeMask + Size4Bit gives the mask needed for size fits of format word in classes.
  		This is used in instantiateClass:indexableSize: "
  	LongSizeMask := WordMask - 16rFF + SizeMask.
  	LongSizeNumBits := 30. "30 bits of size info in long size filed."
  	CompactClassMask := 16r1F000.
  
  	"masks for root and mark bits"
  	MarkBit := 1 bitShift: BytesPerWord*8 - 1.  "Top bit"
  	RootBit := 1 bitShift: BytesPerWord*8 - 2.  "Next-to-Top bit"
  	AllButMarkBit := WordMask - MarkBit.
  	AllButRootBit := WordMask - RootBit.
  
  	AllButMarkBitAndTypeMask := AllButTypeMask - MarkBit.
  
  	ImmutabilityBit := 1 bitShift: BytesPerWord*8 - 3.  "Next-to-Next-To-Top bit"
  	AllButImmutabilityBit := WordMask - ImmutabilityBit!

Item was added:
+ ----- Method: ObjectMemory class>>memoryManagerVersion (in category 'accessing') -----
+ memoryManagerVersion 
+ 	^ 'Blue Book'!

Item was changed:
  ----- Method: ObjectMemory>>finalizeReference: (in category 'finalization') -----
  finalizeReference: oop 
  	"During sweep phase we have encountered a weak reference. Check if its object
  	 has gone away (or is about to) and if so, signal a semaphore.  Do *not* inline
  	 this in sweepPhase - it is quite an unlikely case to run into a weak reference"
  	| weakOop oopGone chunk numFields firstField lastField |
  	<inline: false>
  	<var: #oop type: #usqInt>
  	<var: #weakOop type: #usqInt>
  	numFields := self nonWeakFieldsOf: oop. "so nonWeakFieldsOf: may be inlined"
  	firstField := self baseHeaderSize + (numFields << self shiftForWord).
  	lastField := self lastPointerOf: oop.
  	firstField to: lastField by: self wordSize do:
  		[:i|
  		weakOop := self longAt: oop + i.
  		"ar 1/18/2005: Added oop < youngStart test to make sure we're not testing
  		objects in non-GCable region. This could lead to a forward reference in
  		old space with the oop pointed to not being marked and thus treated as free."
  		(weakOop = nilObj or: [(self isIntegerObject: weakOop) or:[weakOop < youngStart]]) ifFalse:
  			["Check if the object is being collected. 
  			If the weak reference points  
  			* backward: check if the weakOops chunk is free
  			* forward: check if the weakOoop has been marked by GC"
  			weakOop < oop
  				ifTrue: [chunk := self chunkFromOop: weakOop.
  						oopGone := ((self longAt: chunk) bitAnd: TypeMask) = HeaderTypeFree]
  				ifFalse: [oopGone := (self isMarked: weakOop) not].
  			oopGone ifTrue: "Store nil in the pointer and signal the  interpreter"
  				[self longAt: oop + i put: nilObj.
+ 				numFields >= 2 ifTrue: [ self weakFinalizerCheck: oop ].
  				self signalFinalization: oop]]]!

Item was added:
+ ----- Method: ObjectMemory>>getHeapGrowthToSizeGCRatio (in category 'accessing') -----
+ getHeapGrowthToSizeGCRatio
+ 	"For compatibility with spur object memory"
+ 	<returnTypeC: #float>
+ 	^ 0!

Item was added:
+ ----- Method: ObjectMemory>>isInFinalizationList:head: (in category 'finalization') -----
+ isInFinalizationList: oop head: listHead
+ 	"it is known that oop's first fixed slot points to an instance of special object - ClassWeakFinalizer ,
+ 	so it is safe to assume that we can iterate over it to figure out if oop is already in that list"
+ 	| listItem |
+ 
+ 	listItem := listHead.
+ 	
+ 	[ listItem == self nilObject ] whileFalse: [
+ 		listItem == oop ifTrue: [ ^ true ].
+ 		listItem := self fetchPointer: 1 ofObject: listItem.   
+ 	].
+ 	^ false
+ !

Item was changed:
  ----- Method: ObjectMemory>>readHeapFromImageFile:dataBytes: (in category 'image save/restore') -----
  readHeapFromImageFile: f dataBytes: numBytes
  	"Read numBytes of image data from f into memory at memoryBaseForImageRead.
  	 Answer the number of bytes written."
  	<var: #f type: #sqImageFile>
  	^self cCode:
  			[self
  				sq: (self pointerForOop: self memoryBaseForImageRead)
  				Image: (self sizeof: #char)
  				File: numBytes
+ 				ReadEntireImage: f]
- 				Read: f]
  		inSmalltalk:
  			[(f	readInto: memory
  				startingAt: self memoryBaseForImageRead // 4 + 1
  				count: numBytes // 4)
  			 * 4]!

Item was added:
+ ----- Method: ObjectMemory>>setHeapGrowthToSizeGCRatio: (in category 'accessing') -----
+ setHeapGrowthToSizeGCRatio: aDouble
+ 	"For compatibility with spur object memory"
+ 	<var: #aDouble type: #double>
+ !

Item was removed:
- ----- Method: RelativeDetailedInstructionPrinter class>>on: (in category 'instance creation') -----
- on: method 
- 	"Answer an instance of me on the argument, method."
- 
- 	^self new method: method pc: method initialPC!

Item was added:
+ ----- Method: SerialPlugin>>primitiveSerialPortOpenByName:baudRate:stopBitsType:parityType:dataBits:inFlowControlType:outFlowControlType:xOnByte:xOffByte: (in category 'primitives') -----
+ primitiveSerialPortOpenByName: portName baudRate: baudRate stopBitsType: stopBitsType parityType: parityType dataBits: dataBits inFlowControlType: inFlowControl outFlowControlType: outFlowControl xOnByte: xOnChar xOffByte: xOffChar
+ 	<var: #port type: 'char *'>
+ 
+ 	| port portNameSize |
+ 	
+ 	self primitive: 'primitiveSerialPortOpenByName'
+ 		parameters: #(String SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger SmallInteger ).
+ 
+ 	portNameSize := interpreterProxy slotSizeOf: (portName asOop: String).
+ 	port := self cCode: 'calloc(portNameSize+1, sizeof(char))'.
+ 	self cCode: 'memcpy(port, portName, portNameSize)'.
+ 	
+ 	self cCode: 'serialPortOpenByName(
+ 			port, baudRate, stopBitsType, parityType, dataBits,
+ 			inFlowControl, outFlowControl, xOnChar, xOffChar)'.
+ 	
+ 	self free: port.!

Item was added:
+ ----- Method: SerialPlugin>>primitiveSerialPortReadByName:into:startingAt:count: (in category 'primitives') -----
+ primitiveSerialPortReadByName: portName into: array startingAt: startIndex count: count 
+ 	<var: #port type: 'char *'>
+ 
+ 	| port portNameSize bytesRead arrayPtr |
+ 
+ 	self primitive: 'primitiveSerialPortReadByName'
+ 		parameters: #(String  ByteArray SmallInteger SmallInteger ).
+ 
+ 	interpreterProxy success: (startIndex >= 1 and: [startIndex + count - 1 <= (interpreterProxy byteSizeOf: array cPtrAsOop)]).
+ 	"adjust for zero-origin indexing"
+ 
+ 	portNameSize := interpreterProxy slotSizeOf: (portName asOop: String).
+ 	port := self cCode: 'calloc(portNameSize+1, sizeof(char))'.
+ 	self cCode: 'memcpy(port, portName, portNameSize)'.
+ 
+ 	arrayPtr := array asInteger + startIndex - 1.
+ 	bytesRead := self cCode: 'serialPortReadIntoByName( port, count, arrayPtr)'.
+ 	
+ 	self free: port.
+ 	
+ 	^ bytesRead asSmallIntegerObj!

Item was added:
+ ----- Method: SerialPlugin>>primitiveSerialPortWriteByName:from:startingAt:count: (in category 'primitives') -----
+ primitiveSerialPortWriteByName: portName from: array startingAt: startIndex count: count 
+ 	<var: #port type: 'char *'>
+ 
+ 	| bytesWritten arrayPtr portNameSize port |
+ 	
+ 	self primitive: 'primitiveSerialPortWriteByName'
+ 		parameters: #(String ByteArray SmallInteger SmallInteger ).
+ 
+ 	portNameSize := interpreterProxy slotSizeOf: (portName asOop: String).
+ 	port := self cCode: 'calloc(portNameSize+1, sizeof(char))'.
+ 	self cCode: 'memcpy(port, portName, portNameSize)'.
+ 
+ 	interpreterProxy success: (startIndex >= 1 and: [startIndex + count - 1 <= (interpreterProxy byteSizeOf: array cPtrAsOop)]).
+ 	interpreterProxy failed
+ 		ifFalse: [arrayPtr := array asInteger + startIndex - 1.
+ 			bytesWritten := self cCode: 'serialPortWriteFromByName(port, count, arrayPtr)' ].
+ 	
+ 	self free: port.
+ 
+ 	^ bytesWritten asSmallIntegerObj!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPushEnclosingObjectAt: (in category 'bytecode generators') -----
  genPushEnclosingObjectAt: level
  	"Uncached push enclosing object"
  	self MoveCq: level R: SendNumArgsReg.
  	self CallRT: ceEnclosingObjectTrampoline.
  	self PushR: ReceiverResultReg.
  	^0!

Item was changed:
  ----- Method: SocketPlugin>>primitiveSocketCreateRaw:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: (in category 'primitives') -----
  primitiveSocketCreateRaw: netType type: protoType receiveBufferSize: recvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema 
+ 	"New IPV6 implementation removes this... and nobody is using (and it wont compile)"
+ 	<doNotGenerate>
  	| socketOop s okToCreate |
  	<var: #s type: 'SocketPtr '>
  	self primitive: 'primitiveSocketCreateRAW' parameters: #(#SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger #SmallInteger ).
  	"If the security plugin can be loaded, use it to check for permission.
  	If not, assume it's ok"
  	sCCSOTfn ~= 0
  		ifTrue: [okToCreate := self cCode: ' ((int (*) (int, int)) sCCSOTfn)(netType, protoType)'.
  			okToCreate
  				ifFalse: [^ interpreterProxy primitiveFail]].
  	socketOop := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self socketRecordSize.
  	s := self socketValueOf: socketOop.
  	self
  		sqSocket: s
  		CreateRaw: netType
  		ProtoType: protoType
  		RecvBytes: recvBufSize
  		SendBytes: sendBufSize
  		SemaID: semaIndex
  		ReadSemaID: aReadSema
  		WriteSemaID: aWriteSema.
  	^ socketOop!

Item was removed:
- ----- Method: Spur32BitCoMemoryManager class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
- objectRepresentationClass
- 	^CogObjectRepresentationFor32BitSpur!

Item was changed:
  ----- Method: Spur32BitCoMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') -----
  assimilateNewSegment: segInfo
  	"Update after adding a segment.
  	 Here we make sure the new segment is not executable."
  	<var: #segInfo type: #'SpurSegmentInfo *'>
  	super assimilateNewSegment: segInfo.
+ 	self 
+ 		cppIf: #SPUR_USE_EXECUTABLE_MEMORY
+ 		ifTrue: [ coInterpreter sqMakeMemoryExecutableFrom: segInfo segStart To: segInfo segLimit ]
+ 		ifFalse: [ coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segLimit ]
+ 		!
- 	coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segLimit!

Item was added:
+ ----- Method: Spur32BitMemoryManager class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
+ objectRepresentationClass
+ 	^CogObjectRepresentationFor32BitSpur!

Item was added:
+ ----- Method: SpurMemoryManager class>>memoryManagerVersion (in category 'accessing') -----
+ memoryManagerVersion 
+ 	^ 'Spur'!

Item was changed:
  ----- Method: SpurMemoryManager>>isForwarded: (in category 'object testing') -----
  isForwarded: objOop
  	"Answer if objOop is that if a forwarder.  Take advantage of isForwardedObjectClassIndexPun
  	 being a power of two to generate a more efficient test than the straight-forward
  		(self classIndexOf: objOop) = self isForwardedObjectClassIndexPun
  	 at the cost of this being ambiguous with free chunks.  So either never apply this to free chunks
  	 or guard with (self isFreeObject: foo) not.  So far the idiom has been to guard with isFreeObject:"
  	<api>
  	<inline: true>
  	"self assert: (self isFreeObject: objOop) not."
  	^(self longAt: objOop) noMask: self classIndexMask - self isForwardedObjectClassIndexPun!

Item was changed:
  ----- Method: SpurMemoryManager>>setHiddenRootsObj: (in category 'class table') -----
  setHiddenRootsObj: anOop
  	hiddenRootsObj := anOop.
  	self cCode: [self assert: self validClassTableRootPages]
  		inSmalltalk: [numClassTablePages ifNotNil:
  						[self assert: self validClassTableRootPages]]..
  	classTableFirstPage := self fetchPointer: 0 ofObject: hiddenRootsObj.
  	self assert: (self numSlotsOf: classTableFirstPage) - 1 = self classTableMinorIndexMask.
  	"Set classTableIndex to the start of the last used page (excepting first page).
  	 Set numClassTablePages to the number of used pages."
  	numClassTablePages := self classTableRootSlots.
  	2 to: numClassTablePages - 1 do:
  		[:i|
  		(self fetchPointer: i ofObject: hiddenRootsObj) = nilObj ifTrue:
  			[numClassTablePages := i.
  			 classTableIndex := (numClassTablePages - 1 max: 1) << self classTableMajorIndexShift.
  			 ^self]].
  	"no unused pages; set it to the start of the second page."
  	classTableIndex := 1 << self classTableMajorIndexShift!

Item was removed:
- InterpreterPlugin subclass: #SqueakSSLPlugin
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'VMMaker-Plugins'!

Item was removed:
- ----- Method: SqueakSSLPlugin class>>hasHeaderFile (in category 'translation') -----
- hasHeaderFile
- 	^true!

Item was removed:
- ----- Method: SqueakSSLPlugin class>>moduleName (in category 'translation') -----
- moduleName
- 	^'SqueakSSL'!

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveAccept (in category 'primitives') -----
- primitiveAccept
- 	"Primitive. Starts or continues a server handshake using the current session.
- 	Will eventually produce output to be sent to the client. Requires the host
- 	and cert name to be set for the session. Returns a code indicating the sate
- 	of the connection:
- 		> 0	 - Number of bytes to be sent to the client.
- 		0	 - Success. The connection is established.
- 		-1 	 - More input is required.
- 		< -1 - Other errors.
- 	"
- 	| start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
- 	<var: #srcPtr type: 'char *'>
- 	<var: #dstPtr type: 'char *'>
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 5
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	dstOop := interpreterProxy stackObjectValue: 0.
- 	srcLen := interpreterProxy stackIntegerValue: 1.
- 	start := interpreterProxy stackIntegerValue: 2.
- 	srcOop := interpreterProxy stackObjectValue: 3.
- 	handle := interpreterProxy stackIntegerValue: 4.
- 	interpreterProxy failed ifTrue:[^nil].
- 	((start > 0 and:[srcLen >= 0])
- 		and:[(interpreterProxy isBytes: srcOop) 
- 		and:[(interpreterProxy isBytes: dstOop) 
- 		and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
- 			ifFalse:[^interpreterProxy primitiveFail].
- 	srcPtr := interpreterProxy firstIndexableField: srcOop.
- 	dstPtr := interpreterProxy firstIndexableField: dstOop.
- 	srcPtr := srcPtr + start - 1.
- 	dstLen := interpreterProxy byteSizeOf: dstOop.
- 	result := self cCode: 'sqAcceptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)' 
- 					inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
- 	interpreterProxy failed ifTrue:[^nil].
- 	interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- 	interpreterProxy pushInteger: result.!

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveConnect (in category 'primitives') -----
- primitiveConnect
- 	"Primitive. Starts or continues a client handshake using the provided data.
- 	Will eventually produce output to be sent to the server. Requires the host
- 	name to be set for the session. 
- 	Returns:
- 		> 0	 - Number of bytes to be sent to the server
- 		0	 - Success. The connection is established.
- 		-1 	 - More input is required.
- 		< -1 - Other errors.
- 	"
- 	| start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
- 	<var: #srcPtr type: 'char *'>
- 	<var: #dstPtr type: 'char *'>
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 5
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	dstOop := interpreterProxy stackObjectValue: 0.
- 	srcLen := interpreterProxy stackIntegerValue: 1.
- 	start := interpreterProxy stackIntegerValue: 2.
- 	srcOop := interpreterProxy stackObjectValue: 3.
- 	handle := interpreterProxy stackIntegerValue: 4.
- 	interpreterProxy failed ifTrue:[^nil].
- 	((start > 0 and:[srcLen >= 0])
- 		and:[(interpreterProxy isBytes: srcOop) 
- 		and:[(interpreterProxy isBytes: dstOop) 
- 		and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
- 			ifFalse:[^interpreterProxy primitiveFail].
- 	srcPtr := interpreterProxy firstIndexableField: srcOop.
- 	dstPtr := interpreterProxy firstIndexableField: dstOop.
- 	srcPtr := srcPtr + start - 1.
- 	dstLen := interpreterProxy byteSizeOf: dstOop.
- 	result := self cCode: 'sqConnectSSL(handle, srcPtr, srcLen, dstPtr, dstLen)' 
- 					inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
- 	interpreterProxy failed ifTrue:[^nil].
- 	interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- 	interpreterProxy pushInteger: result.!

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveCreate (in category 'primitives') -----
- primitiveCreate
- 	"Primitive. Creates a new SSL session and returns its handle."
- 	| handle |
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 0 
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	handle := self cCode: 'sqCreateSSL()' inSmalltalk:[0].
- 	handle = 0 ifTrue:[^interpreterProxy primitiveFail].
- 	interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- 	interpreterProxy pushInteger: handle.
- !

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveDecrypt (in category 'primitives') -----
- primitiveDecrypt
- 	"Primitive. Decrypts a buffer sent via the connection.
- 	Requires the session to be established.
- 	Returns:
- 		>=0 - Number of bytes decrypted in the result buffer
- 		< -1 - Other errors.
- 	"
- 	| start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
- 	<var: #srcPtr type: 'char *'>
- 	<var: #dstPtr type: 'char *'>
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 5
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	dstOop := interpreterProxy stackObjectValue: 0.
- 	srcLen := interpreterProxy stackIntegerValue: 1.
- 	start := interpreterProxy stackIntegerValue: 2.
- 	srcOop := interpreterProxy stackObjectValue: 3.
- 	handle := interpreterProxy stackIntegerValue: 4.
- 	interpreterProxy failed ifTrue:[^nil].
- 	((start > 0 and:[srcLen >= 0])
- 		and:[(interpreterProxy isBytes: srcOop) 
- 		and:[(interpreterProxy isBytes: dstOop) 
- 		and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
- 			ifFalse:[^interpreterProxy primitiveFail].
- 	srcPtr := interpreterProxy firstIndexableField: srcOop.
- 	dstPtr := interpreterProxy firstIndexableField: dstOop.
- 	srcPtr := srcPtr + start - 1.
- 	dstLen := interpreterProxy byteSizeOf: dstOop.
- 	result := self cCode: 'sqDecryptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)' 
- 					inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
- 	interpreterProxy failed ifTrue:[^nil].
- 	interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- 	interpreterProxy pushInteger: result.!

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveDestroy (in category 'primitives') -----
- primitiveDestroy
- 	"Primitive. Destroys an SSL session."
- 
- 	| handle result |
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 1
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	handle := interpreterProxy stackIntegerValue: 0.
- 	interpreterProxy failed ifTrue:[^nil].
- 	result := self cCode: 'sqDestroySSL(handle)' inSmalltalk:[handle. 0].
- 	result = 0 ifTrue:[^interpreterProxy primitiveFail].
- 	interpreterProxy pop: interpreterProxy methodArgumentCount.
- 
- !

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveEncrypt (in category 'primitives') -----
- primitiveEncrypt
- 	"Primitive. Encrypts a buffer to be sent to the via the connection.
- 	Requires the session to be established.
- 	Returns:
- 		>=0 - Number of bytes encrypted in the result buffer
- 		< -1 - Other errors.
- 	"
- 	| start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
- 	<var: #srcPtr type: 'char *'>
- 	<var: #dstPtr type: 'char *'>
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 5
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	dstOop := interpreterProxy stackObjectValue: 0.
- 	srcLen := interpreterProxy stackIntegerValue: 1.
- 	start := interpreterProxy stackIntegerValue: 2.
- 	srcOop := interpreterProxy stackObjectValue: 3.
- 	handle := interpreterProxy stackIntegerValue: 4.
- 	interpreterProxy failed ifTrue:[^nil].
- 	((start > 0 and:[srcLen >= 0])
- 		and:[(interpreterProxy isBytes: srcOop) 
- 		and:[(interpreterProxy isBytes: dstOop) 
- 		and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
- 			ifFalse:[^interpreterProxy primitiveFail].
- 	srcPtr := interpreterProxy firstIndexableField: srcOop.
- 	dstPtr := interpreterProxy firstIndexableField: dstOop.
- 	srcPtr := srcPtr + start - 1.
- 	dstLen := interpreterProxy byteSizeOf: dstOop.
- 	result := self cCode: 'sqEncryptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)' 
- 					inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
- 	interpreterProxy failed ifTrue:[^nil].
- 	interpreterProxy pop: interpreterProxy methodArgumentCount+1.
- 	interpreterProxy pushInteger: result.!

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveGetIntProperty (in category 'primitives') -----
- primitiveGetIntProperty
- 	"Primitive. Returns an integer property for the session"
- 
- 	| propID handle value |
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 2
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	propID := interpreterProxy stackIntegerValue: 0.
- 	handle := interpreterProxy stackIntegerValue: 1.
- 	interpreterProxy failed ifTrue:[^nil].
- 	value := self cCode: 'sqGetIntPropertySSL(handle, propID)' 
- 					inSmalltalk:[handle. propID. 0].
- 	interpreterProxy failed ifTrue:[^nil].
- 	interpreterProxy 
- 		pop: interpreterProxy methodArgumentCount + 1
- 		thenPush: (interpreterProxy signed32BitIntegerFor: value)
- !

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveGetStringProperty (in category 'primitives') -----
- primitiveGetStringProperty
- 	"Primitive. Returns a string property for the session"
- 
- 	| stringLen stringOop propID handle stringPtr oopPtr |
- 	<var: #stringPtr type: 'char *'>
- 	<var: #oopPtr type: 'char *'>
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 2
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	propID := interpreterProxy stackIntegerValue: 0.
- 	handle := interpreterProxy stackIntegerValue: 1.
- 	interpreterProxy failed ifTrue:[^nil].
- 	stringPtr := self cCode: 'sqGetStringPropertySSL(handle, propID)' 
- 					inSmalltalk:[handle. propID. nil].
- 	interpreterProxy failed ifTrue:[^nil].
- 	stringPtr == nil ifTrue:[
- 		stringOop := interpreterProxy nilObject.
- 	] ifFalse:[
- 		stringLen := self strlen: stringPtr.
- 		stringOop := interpreterProxy 
- 			instantiateClass: (interpreterProxy classString)
- 			indexableSize: stringLen.
- 		oopPtr := interpreterProxy firstIndexableField: stringOop.
- 		0 to: stringLen-1 do:[:i| oopPtr at: i put: (stringPtr at: i)].
- 	].
- 	interpreterProxy 
- 		pop: interpreterProxy methodArgumentCount + 1
- 		thenPush: stringOop.
- !

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveSetIntProperty (in category 'primitives') -----
- primitiveSetIntProperty
- 	"Primitive. Sets a integer property for the session"
- 
- 	| propID handle result value |
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 3
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	value := interpreterProxy signed32BitValueOf: (interpreterProxy stackValue: 0).
- 	propID := interpreterProxy stackIntegerValue: 1.
- 	handle := interpreterProxy stackIntegerValue: 2.
- 	interpreterProxy failed ifTrue:[^nil].
- 	result := self cCode: 'sqSetIntPropertySSL(handle, propID, value)' 
- 					inSmalltalk:[handle. propID. value. false].
- 	result ifFalse:[^interpreterProxy primitiveFail].
- 	interpreterProxy failed ifTrue:[^nil].
- 	interpreterProxy pop: interpreterProxy methodArgumentCount.
- !

Item was removed:
- ----- Method: SqueakSSLPlugin>>primitiveSetStringProperty (in category 'primitives') -----
- primitiveSetStringProperty
- 	"Primitive. Sets a string property for the session"
- 
- 	| srcLen srcOop propID handle srcPtr result |
- 	<var: #srcPtr type: 'char *'>
- 	<export: true>
- 	interpreterProxy methodArgumentCount = 3
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	srcOop := interpreterProxy stackObjectValue: 0.
- 	propID := interpreterProxy stackIntegerValue: 1.
- 	handle := interpreterProxy stackIntegerValue: 2.
- 	interpreterProxy failed ifTrue:[^nil].
- 	(interpreterProxy isBytes: srcOop) 
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	srcPtr := interpreterProxy firstIndexableField: srcOop.
- 	srcLen := interpreterProxy byteSizeOf: srcOop.
- 	result := self cCode: 'sqSetStringPropertySSL(handle, propID, srcPtr, srcLen)' 
- 					inSmalltalk:[handle. srcPtr. propID. srcLen. false].
- 	result ifFalse:[^interpreterProxy primitiveFail].
- 	interpreterProxy failed ifTrue:[^nil].
- 	interpreterProxy pop: interpreterProxy methodArgumentCount.
- !

Item was added:
+ ----- Method: StackInterpreter class>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion 
+ 	^ 'Stack'!

Item was changed:
  ----- Method: StackInterpreter class>>requiredMethodNames: (in category 'translation') -----
  requiredMethodNames: options
  	"return the list of method names that should be retained for export or other support reasons"
  	| requiredList |
  	requiredList := self exportAPISelectors: options.
  	requiredList addAll: (NewObjectMemory requiredMethodNames: options).
  	"A number of methods required by VM support code, jitter, specific platforms etc"
  	requiredList addAll: #(
  		assertValidExecutionPointe:r:s:
  		characterForAscii:
  		findClassOfMethod:forReceiver: findSelectorOfMethod:
  			forceInterruptCheck forceInterruptCheckFromHeartbeat fullDisplayUpdate
  		getCurrentBytecode getFullScreenFlag getInterruptKeycode getInterruptPending
  			getSavedWindowSize getThisSessionID
  		interpret
  		loadInitialContext
  		primitiveFail primitiveFailFor: primitiveFlushExternalPrimitives printAllStacks printCallStack printContext:
  			printExternalHeadFrame printFramesInPage: printFrame: printHeadFrame printMemory printOop:
  				printStackPages printStackPageList printStackPagesInUse printStackPageListInUse
  		readableFormat: readImageFromFile:HeapSize:StartingAt:
  		setFullScreenFlag: setInterruptKeycode: setInterruptPending: setInterruptCheckChain:
  			setSavedWindowSize: success:
  		validInstructionPointer:inMethod:framePointer:).
  
  	"Nice to actually have all the primitives available"
  	requiredList addAll: (self primitiveTable select: [:each| each isSymbol]).
  
  	"InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
  	InterpreterProxy organization categories do:
  		[:cat |
+ 		((cat ~= 'initialize') 
+ 			and: [ cat ~= 'private'
+ 			and: [ cat ~= '-- all --' ] ]) ifTrue:
- 		((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue:
  			[requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
  
  	^requiredList!

Item was changed:
  ----- Method: StackInterpreter>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') -----
  codeGeneratorToComputeAccessorDepth
  	^VMMaker new
  		buildCodeGeneratorForInterpreter: self class primitivesClass
  		includeAPIMethods: false
  		initializeClasses: false!

Item was changed:
  ----- Method: StackInterpreter>>primitiveIndexOfMethod:header: (in category 'compiled methods') -----
  primitiveIndexOfMethod: theMethod header: methodHeader
  	"Note: With the Squeak V0 format we now have 10 bits of primitive index, but they are in
  	 two places for temporary backward compatibility.  The time to unpack is negligible,
  	 since the derived primitive function pointer is stored in the method cache.  With the new
  	 format we assume a 3-byte CallPrimitive with a little-endian 16-bit primitive index."
  	<api>
  	<inline: true>
  	| firstBytecode |
  	^objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[(self alternateHeaderHasPrimitiveFlag: methodHeader)
  				ifTrue:
  					[firstBytecode := self firstBytecodeOfAlternateHeader: methodHeader method: theMethod.
  					 (objectMemory byteAt: firstBytecode + 1) + ((objectMemory byteAt: firstBytecode + 2) << 8)]
  				ifFalse:
  					[0]]
  		ifFalse:
  			[MULTIPLEBYTECODESETS
  				ifTrue:
  					[(self headerIndicatesAlternateBytecodeSet: methodHeader)
  						ifTrue:
  							[(self alternateHeaderHasPrimitiveFlag: methodHeader)
  								ifTrue:
  									[firstBytecode := self firstBytecodeOfAlternateHeader: methodHeader method: theMethod.
  									 (objectMemory byteAt: firstBytecode + 1) + ((objectMemory byteAt: firstBytecode + 2) << 8)]
  								ifFalse:
  									[0]]
  						ifFalse:
  							[| primBits |
  							 primBits := objectMemory integerValueOf: methodHeader.
  							 (primBits bitAnd: 16r1FF) + (primBits >> 19 bitAnd: 16r200)]]
  				ifFalse:
  					[| primBits |
  					 primBits := objectMemory integerValueOf: methodHeader.
  					 (primBits bitAnd: 16r1FF) + (primBits >> 19 bitAnd: 16r200)]]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the StackInterpreterSimulator when running the interpreter
  	 inside Smalltalk. The primary responsibility of this method is to allocate
  	 Smalltalk Arrays for variables that will be declared as statically-allocated
  	 global arrays in the translated code."
  	super initialize.
  
  	bootstrapping := false.
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	objectMemory coInterpreter: self.
  
  	"Note: we must initialize ConstMinusOne differently for simulation,
  		due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := objectMemory integerObjectOf: -1.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	mappedPluginEntries := OrderedCollection new.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[primitiveAccessorDepthTable := Array new: primitiveTable size.
  			 pluginList := {}.
  			 self loadNewPlugin: '']
  		ifFalse:
  			[pluginList := {'' -> self }].
  	desiredNumStackPages := desiredEdenBytes := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := sendCount := lookupCount := 0.
  	quitBlock := [^self].
  	traceOn := true.
  	printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
+ 	displayForm := (ImageMorph fromString: 'Display has not yet been installed') form.
- 	displayForm := 'Display has not yet been installed' asDisplayText form.
  	eventQueue := SharedQueue new.
  	suppressHeartbeatFlag := false.
  	systemAttributes := Dictionary new.
  	extSemTabSize := 256.
  	disableBooleanCheat := false.
  	assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"!

Item was added:
+ ----- Method: StackInterpreterSimulator>>initializeInterpreter: (in category 'initialization') -----
+ initializeInterpreter: bytesToShift
+ 	super initializeInterpreter: bytesToShift.
+ 	"self initStackPages.
+ 	self loadInitialContext"!

Item was changed:
  ----- Method: StackInterpreterSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
  ioRelinquishProcessorForMicroseconds: microseconds
  	"In the simulator give an indication that we're idling and check for input."
  	Display reverse: (0 at 0 extent: 16 at 16).
  	Sensor peekEvent ifNotNil:
  		[self forceInterruptCheck].
+ 	Processor activeProcess == UIManager default uiProcess ifTrue:
- 	Processor activeProcess == Project uiProcess ifTrue:
  		[World doOneCycle].
  	microseconds >= 1000
  		ifTrue: [(Delay forMilliseconds: microseconds + 999 // 1000) wait]
  		ifFalse: [Processor yield].
  	"And increase the byteCount form which the microsecond clock is derived..."
  	byteCount := byteCount + microseconds - 1.
  	self incrementByteCount!

Item was added:
+ ----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName 
+ 	size: entryNameSize
+ 	createDate: createDate 
+ 	modDate: modifiedDate
+ 	isDir: dirFlag 
+ 	fileSize: posixPermissions
+ 	posixPermissions: fileSize
+ 
+ 	| modDateOop createDateOop nameString results |
+ 	<var: 'entryName' type: 'char *'>
+ 
+ 	results			:= objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 5.
+ 	nameString		:= objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize.
+ 	createDateOop	:= self positive32BitIntegerFor: createDate.
+ 	modDateOop	:= self positive32BitIntegerFor: modifiedDate.
+ 
+ 	1 to: entryNameSize do:
+ 		[ :i |
+ 		objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue].
+ 
+ 	objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString.
+ 	objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop.
+ 	objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop.
+ 	dirFlag
+ 		ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ]
+ 		ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ].
+ 	objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize).
+ 	objectMemory storePointerUnchecked: 5 ofObject: results withValue: (objectMemory integerObjectOf: posixPermissions).
+ 	^ results!

Item was added:
+ ----- Method: StackInterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'as yet unclassified') -----
+ makeDirEntryName: entryName 
+ 	size: entryNameSize
+ 	createDate: createDate 
+ 	modDate: modifiedDate
+ 	isDir: dirFlag 
+ 	fileSize: posixPermissions
+ 	posixPermissions: fileSize
+ 	isSymlink: symlinkFlag
+ 
+ 	| modDateOop createDateOop nameString results |
+ 	<var: 'entryName' type: 'char *'>
+ 
+ 	results			:= objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 7.
+ 	nameString		:= objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize.
+ 	createDateOop	:= self positive32BitIntegerFor: createDate.
+ 	modDateOop	:= self positive32BitIntegerFor: modifiedDate.
+ 
+ 	1 to: entryNameSize do:
+ 		[ :i |
+ 		objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue].
+ 
+ 	objectMemory storePointerUnchecked: 0 ofObject: results withValue: nameString.
+ 	objectMemory storePointerUnchecked: 1 ofObject: results withValue: createDateOop.
+ 	objectMemory storePointerUnchecked: 2 ofObject: results withValue: modDateOop.
+ 	dirFlag
+ 		ifTrue: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory trueObject ]
+ 		ifFalse: [ objectMemory storePointerUnchecked: 3 ofObject: results withValue: objectMemory falseObject ].
+ 	objectMemory storePointerUnchecked: 4 ofObject: results withValue: (objectMemory integerObjectOf: fileSize).
+ 	objectMemory storePointerUnchecked: 5 ofObject: results withValue: (objectMemory integerObjectOf: posixPermissions).
+ 	symlinkFlag
+ 		ifTrue: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory trueObject ]
+ 		ifFalse: [ objectMemory storePointerUnchecked: 6 ofObject: results withValue: objectMemory falseObject ].
+ 
+ 	^ results!

Item was changed:
  ----- Method: StackInterpreterSimulator>>openAsMorph (in category 'UI') -----
  openAsMorph
  	"Open a morphic view on this simulation."
+ 	| window localImageName |
+ 	localImageName := imageName asFileReference basename.
- 	| localImageName borderWidth window |
- 	localImageName := imageName
- 							ifNotNil: [FileDirectory default localNameFor: imageName]
- 							ifNil: [' synthetic image'].
  	window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
  
  	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.8).
  
+ 	transcript := ThreadSafeTranscript new.
- 	transcript := TranscriptStream on: (String new: 10000).
  	window addMorph: (PluggableTextMorph
  							on: transcript text: nil accept: nil
  							readSelection: nil menu: #codePaneMenu:shifted:)
  			frame: (0 at 0.8 corner: 0.7 at 1).
+ 
  	window addMorph: (PluggableTextMorph on: self
  						text: #byteCountText accept: nil
  						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  			frame: (0.7 at 0.8 corner: 1 at 1).
  
- 	borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
- 						on: MessageNotUnderstood
- 						do: [:ex| 0]. "3.8"
- 	borderWidth := borderWidth + window borderWidth.
  	window openInWorldExtent: (self desiredDisplayExtent
+ 								+ (2 * window borderWidth)
- 								+ (2 * borderWidth)
  								+ (0 at window labelHeight)
+ 								* (1@(1/0.8))) rounded!
- 								* (1@(1/0.8))) rounded.
- 	^window!

Item was changed:
  ----- Method: StackInterpreterSimulator>>openAsMorphNoTranscript (in category 'UI') -----
  openAsMorphNoTranscript
  	"Open a morphic view on this simulation."
+ 	| window localImageName |
+ 	localImageName := imageName asFileReference basename.
- 	| localImageName borderWidth window |
- 	localImageName := FileDirectory default localNameFor: imageName.
  	window := (SystemWindow labelled: 'Simulation of ' , localImageName) model: self.
  
  	window addMorph: (displayView := ImageMorph new image: displayForm)
  		frame: (0 at 0 corner: 1 at 0.95).
  
  	window addMorph: (PluggableTextMorph on: self
+ 						text: #byteCountText accept: nil) hideScrollBarsIndefinitely
- 						text: #byteCountText accept: nil
- 						readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
  		frame: (0 at 0.95 corner: 1 at 1).
  
- 	borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
- 						on: MessageNotUnderstood
- 						do: [:ex| 0]. "3.8"
- 	borderWidth := borderWidth + window borderWidth.
  	window openInWorldExtent: (self desiredDisplayExtent
+ 								+ (2 * window borderWidth)
- 								+ (2 * borderWidth)
  								+ (0 at window labelHeight)
  								* (1@(1/0.95))) rounded!

Item was changed:
  ----- Method: StackInterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
  primitiveDirectoryEntry
  	| name pathName array result |
  	name := self stringOf: self stackTop.
  	pathName := self stringOf: (self stackValue: 1).
  	
  	self successful ifFalse:
  		[^self primitiveFail].
  
+ 	array := FileSystem disk store basicEntryAt: (pathName asFileReference / name) path.
- 	array := FileDirectory default primLookupEntryIn: pathName name: name.
  	array == nil ifTrue:
  		[self pop: 3 thenPush: objectMemory nilObject.
  		^array].
  	array == #badDirectoryPath ifTrue:
+ 		[
- 		[self halt.
  		^self primitiveFail].
  
+ 	result := self makeDirEntryName: (array at: 1) 
+ 		size: (array at: 1) size
+ 		createDate: (array at: 2) 
+ 		modDate: (array at: 3)
+ 		isDir: (array at: 4)  
+ 		fileSize: (array at: 5)
+ 		posixPermissions: (array at: 6)
+ 		isSymlink: (array at: 7).
- 	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- 				createDate: (array at: 2) modDate: (array at: 3)
- 				isDir: (array at: 4)  fileSize: (array at: 5).
  	self pop: 3.
  	self push: result!

Item was changed:
  ----- Method: StackInterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
  primitiveDirectoryLookup
  	| index pathName array result |
  	index := self stackIntegerValue: 0.
  	pathName := (self stringOf: (self stackValue: 1)).
  	
  	self successful ifFalse:
  		[^self primitiveFail].
  
+ 	array := FileSystem workingDirectory primLookupEntryIn: pathName index: index.
- 	array := FileDirectory default primLookupEntryIn: pathName index: index.
  
  	array == nil ifTrue:
  		[self pop: 3 thenPush: objectMemory nilObject.
  		^array].
  	array == #badDirectoryPath ifTrue:
  		["self halt."
  		^self primitiveFail].
  
+ 	result := self 
+ 		makeDirEntryName: (array at: 1) 
+ 		size: (array at: 1) size
+ 		createDate: (array at: 2) 
+ 		modDate: (array at: 3)
+ 		isDir: (array at: 4)  
+ 		fileSize: (array at: 5)
+ 		posixPermissions: (array at: 6)
+ 		isSymlink: (array at: 7).
- 	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
- 				createDate: (array at: 2) modDate: (array at: 3)
- 				isDir: (array at: 4)  fileSize: (array at: 5).
  	self pop: 3 thenPush: result!

Item was added:
+ ----- Method: StackInterpreterSimulator>>redirectTranscriptToHost (in category 'debug support') -----
+ redirectTranscriptToHost
+ 	"Sometimes you need the capability to see the transcript output of the image into the 
+ 	 local transcript (for debugging when bootstrapping, for example). "
+ 	transcript := Transcript!

Item was changed:
  ----- Method: StackInterpreterSimulator>>runAtEachStep: (in category 'testing') -----
  runAtEachStep: aBlock
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 aBlock value: currentBytecode.
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount].
  	localIP := localIP - 1.
  	"undo the pre-increment of IP before returning"
  	self externalizeIPandSP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>runForNBytes: (in category 'testing') -----
  runForNBytes: nBytecodes 
  	"Do nByteCodes more bytecode dispatches.
  	Keep byteCount up to date.
  	This can be run repeatedly."
  	| endCount |
  	self initStackPages.
+ 	self loadInitialContext.	
- 	self loadInitialContext.
  	endCount := byteCount + nBytecodes.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[byteCount < endCount] whileTrue:
  		[self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount].
  	localIP := localIP - 1.
  	"undo the pre-increment of IP before returning"
  	self externalizeIPandSP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>runWithBreakCount: (in category 'testing') -----
  runWithBreakCount: theBreakCount
  	"Just run, halting when byteCount is reached"
  	quitBlock := [displayView ifNotNil:
  				   [displayView containingWindow ifNotNil:
  					[:topWindow|
  					((World submorphs includes: topWindow)
  					 and: [UIManager default confirm: 'close?']) ifTrue:
  						[topWindow delete]]].
  				  ^self].
  	breakCount := theBreakCount.
  	self initStackPages.
+ 	self loadInitialContext.	
- 	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount].
  	localIP := localIP - 1.
  	"undo the pre-increment of IP before returning"
  	self externalizeIPandSP!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') -----
  initializeBytecodeTableForNewspeakV4
  	"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV4"
  
  	numPushNilsFunction := #v4:Num:Push:Nils:.
  	pushNilSizeFunction := #v4PushNilSize:.
  	NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit"
  	FirstSpecialSelector := 80.
  	self flag:
  'Special selector send class must be inlined to agree with the interpreter, which
   inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
   class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
   have identical semantics.  We get away with not hardwiring the other special
   selectors either because in the Cointerpreter they are not inlined or because they
   are inlined only to instances of classes for which there will always be a method.'.
  	self generatorTableFrom: #(
  		"1 byte bytecodes"
  		(1    0   15 genPushReceiverVariableBytecode needsFrameNever: 1)
  		(1  16   31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
  		(1  32   63 genPushLiteralConstantBytecode needsFrameNever: 1)
  		(1  64   75 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
  		(1  76   76 genPushReceiverBytecode needsFrameNever: 1)
  		(1  77   77 genExtPushPseudoVariableOrOuterBytecode needsFrameIfExtBGT2: 1)
  		(1  78   78 genPushConstantZeroBytecode needsFrameNever: 1)
  		(1  79   79 genPushConstantOneBytecode needsFrameNever: 1)
  
  		(1   80   80 genSpecialSelectorArithmetic isMapped AddRR)
  		(1   81   81 genSpecialSelectorArithmetic isMapped SubRR)
  		(1   82   82 genSpecialSelectorComparison isMapped JumpLess)
  		(1   83   83 genSpecialSelectorComparison isMapped JumpGreater)
  		(1   84   84 genSpecialSelectorComparison isMapped JumpLessOrEqual)
  		(1   85   85 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
  		(1   86   86 genSpecialSelectorComparison isMapped JumpZero)
  		(1   87   87 genSpecialSelectorComparison isMapped JumpNonZero)
  		(1   88   93 genSpecialSelectorSend isMapped)	 " #* #/ #\\ #@ #bitShift: //"
  		(1   94   94 genSpecialSelectorArithmetic isMapped AndRR)
  		(1   95   95 genSpecialSelectorArithmetic isMapped OrRR)
  		(1   96 101 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
  		(1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 103 103 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  
  		(1 112 127 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 128 143 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 144 159 genSendLiteralSelector2ArgsBytecode isMapped)
  		(1 160 175	genSendAbsentImplicit0ArgsBytecode isMapped hasIRC)
  
  		(1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 184 191 genStoreAndPopTemporaryVariableBytecode)
  
  		(1 192 199 genShortUnconditionalJump	branch v3:ShortForward:Branch:Distance:)
  		(1 200 207 genShortJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(1 208 215 genShortJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  
  		(1 216 216 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 217 217 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1 218 218 genExtReturnTopFromBlock	return needsFrameNever: -1)
  
  		(1 219 219 duplicateTopBytecode			needsFrameNever: 1)
  		(1 220 220 genPopStackBytecode			needsFrameNever: -1)
  		(1 221 221 genExtNopBytecode			needsFrameNever: 0)
  		(1 222 223	unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension					needsFrameNever: 0)
  		(2 225 225 extBBytecode extension					needsFrameNever: 0)
  		(2 226 226 genExtPushReceiverVariableBytecode)
  		(2 227 227 genExtPushLiteralVariableBytecode		needsFrameNever: 1)
  		(2 228 228 genExtPushLiteralBytecode					needsFrameNever: 1)
  		(2 229 229 genExtPushIntegerBytecode				needsFrameNever: 1)
  		(2 230 230 genLongPushTemporaryVariableBytecode)
  		(2 231 231 genPushNewArrayBytecode)
  		(2 232 232 genExtStoreReceiverVariableBytecode)
  		(2 233 233 genExtStoreLiteralVariableBytecode)
  		(2 234 234 genLongStoreTemporaryVariableBytecode)
  		(2 235 235 genExtStoreAndPopReceiverVariableBytecode)
  		(2 236 236 genExtStoreAndPopLiteralVariableBytecode)
  		(2 237 237 genLongStoreAndPopTemporaryVariableBytecode)
  
  		(2 238 238 genExtSendBytecode isMapped)
  		(2 239 239 genExtSendSuperBytecode isMapped)
  		(2 240 240 genExtSendAbsentImplicitBytecode isMapped hasIRC)
  		(2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped)
  
  		(2 242 242 genExtUnconditionalJump	branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
  		(2 243 243 genExtJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  		(2 244 244 genExtJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  
  		(2 245 245	genExtSendAbsentSelfBytecode isMapped)
  
  		(2 246 248	unknownBytecode)
  
  		"3 byte bytecodes"
  		(3 249 249 callPrimitiveBytecode)
  		(3 250 250 genPushRemoteTempLongBytecode)
  		(3 251 251 genStoreRemoteTempLongBytecode)
  		(3 252 252 genStoreAndPopRemoteTempLongBytecode)
  		(3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:)
  		(3 254 254	genExtSendAbsentOuterBytecode isMapped)
  
  		(3 255 255	unknownBytecode))!

Item was added:
+ SmartSyntaxInterpreterPlugin subclass: #SystemInfoPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: 'VMBasicConstants'
+ 	category: 'VMMaker-Plugins'!
+ 
+ !SystemInfoPlugin commentStamp: '<historical>' prior: 0!
+ I'm a symple plugin who answers some information about the system.
+ My main purpose is to provide identifiers that can be used for security reasons (to forbid an application to run in different machines)
+ !

Item was added:
+ ----- Method: SystemInfoPlugin class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: codeGenerator
+ 	codeGenerator addHeaderFile: '"SystemInfo.h"'.!

Item was added:
+ ----- Method: SystemInfoPlugin>>primitivePrimaryMACAddress (in category 'primitives') -----
+ primitivePrimaryMACAddress
+ 	| identifier size resultOop resultPtr |
+ 	
+ 	<export: true>
+ 	<var: #identifier type: 'char *'>
+ 	<var: #resultPtr type: 'char *'>	
+ 
+ 	self primitive: #primitivePrimaryMACAddress parameters: #().
+ 	
+ 	interpreterProxy failed ifTrue: [ ^self ].
+ 	
+ 	identifier := self sqPrimaryMACAddress.
+ 	size := self strlen: identifier.
+ 	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: size.
+ 	resultPtr := interpreterProxy firstIndexableField: resultOop.
+ 	0 to: (size - 1) do: [ :i | 
+ 		resultPtr at: i put: (identifier at: i) ].
+ 	
+ 	^resultOop!

Item was added:
+ ----- Method: SystemInfoPlugin>>primitiveUniqueIdentifier (in category 'primitives') -----
+ primitiveUniqueIdentifier
+ 	| identifier size resultOop resultPtr |
+ 	
+ 	<export: true>
+ 	<var: #identifier type: 'char *'>
+ 	<var: #resultPtr type: 'char *'>	
+ 
+ 	self primitive: #primitiveUniqueIdentifier parameters: #().
+ 	
+ 	interpreterProxy failed ifTrue: [ ^self ].
+ 	
+ 	identifier := self sqUniqueIdentifier.
+ 	size := self strlen: identifier.
+ 	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: size.
+ 	resultPtr := interpreterProxy firstIndexableField: resultOop.
+ 	0 to: (size - 1) do: [ :i | 
+ 		resultPtr at: i put: (identifier at: i) ].
+ 	
+ 	^resultOop!

Item was changed:
  ----- Method: TAssignmentNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
  emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
  	aStream nextPut: $(.
  	self emitCCodeOn: aStream level: level generator: aCodeGen.
  	aStream nextPut: $)!

Item was changed:
  ----- Method: TMethod>>buildCaseStmt:in: (in category 'transformations') -----
  buildCaseStmt: aSendNode in: aCodeGen
  	"Build a case statement node for the given send of dispatchOn:in:."
  	"Note: the first argument is the variable to be dispatched on. The second argument is a constant node holding an array of unary selectors, which will be turned into sends to self."
  
  	| unimplemented errorMessage |
  	(aSendNode args size >= 2
  	 and: [aSendNode args second isConstant
  	 and: [aSendNode args second value isArray]]) ifFalse:
  		[self error: 'wrong node structure for a case statement'].
  
  	unimplemented := aSendNode args second value select: [:s| (aCodeGen methodNamed: s) isNil].
  	unimplemented isEmpty ifFalse:
  		[errorMessage := 'The following selectors in case statement "', (aSendNode printString copyUpTo: $#), '..." are unimplemented: ',
  							(String streamContents: [:s| unimplemented do: [:sel| s crtab; store: sel]]).
  		 aCodeGen logger nextPutAll: errorMessage; cr; flush.
+ 		 "(self confirm: errorMessage
- 		 (self confirm: errorMessage
  			orCancel: aCodeGen abortBlock) ifFalse:
+ 				[self halt]"].
- 				[self halt]].
  
  	^TCaseStmtNode new
  		setExpression: aSendNode args first
  		selectors: aSendNode args second value
  		arguments: (aSendNode args copyFrom: 3 to: aSendNode args size)!

Item was changed:
  ----- Method: TMethod>>emitCCodeOn:generator: (in category 'C code generation') -----
  emitCCodeOn: aStream generator: aCodeGen
  	"Emit C code for this method onto the given stream.
  	 All calls to inlined methods should already have been expanded."
  
  	aCodeGen currentMethod: self.
  	self emitCCommentOn: aStream.	"place method comment before function"
  	aStream cr. 
  	self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
  	aStream cr; nextPut: ${.
+ 	aStream cr; tab;
+ 		nextPutAll: '// '; nextPutAll: self definingClass name; nextPutAll: '>>#'; nextPutAll: self selector.	
  	self emitCLocalsOn: aStream generator: aCodeGen.
  	aCodeGen
  		pushScope: declarations
  		while: [parseTree emitCCodeOn: aStream level: 1 generator: aCodeGen].
  	aStream nextPut: $}; cr!

Item was changed:
  ----- Method: TParseNode>>emitCCodeAsArgumentOn:level:generator: (in category 'C code generation') -----
  emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen
  	^self emitCCodeOn: aStream level: level generator: aCodeGen!

Item was changed:
  ----- Method: TParseNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
  emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
  	^self emitCCodeOn: aStream level: level generator: aCodeGen!

Item was changed:
  ----- Method: TSendNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
  emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
  	^self emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen!

Item was changed:
  ----- Method: TestOSAPlugin class>>declareCVarsIn: (in category 'as yet unclassified') -----
  declareCVarsIn: cg
+ 	cg addHeaderFile: '<Carbon/Carbon.h>'.
+ !
- 
- 	cg addHeaderFile: '<AppleEvents.h>'.
- 	cg addHeaderFile: '<AppleScript.h>'.
- 	cg addHeaderFile: '<OSA.h>'.
- 	cg addHeaderFile: '<OSAGeneric.h>'.
- 	cg addHeaderFile: '<Script.h>'.!

Item was removed:
- ----- Method: ThreadedIA32FFIPlugin class>>moduleName (in category 'translation') -----
- moduleName
- 	^'IA32FFIPlugin'!

Item was changed:
  ----- Method: VMClass class>>declareInterpreterVersionIn:defaultName: (in category 'translation') -----
  declareInterpreterVersionIn: aCCodeGenerator defaultName: defaultName
+ 	NewspeakVM 
+ 		ifTrue: [
+ 			"Newspeak as of mid 2011 derives SystemScope systemName from the interpreterVersion
+ 			(via system attribute 1004) by copying up to but not including the last space, provided the
+ 			string ends with a digit.  So spaces must be eliminated from the Monitcello version string,
+ 			and we can't surround it with square brackets."
+ 			(aCCodeGenerator shortMonticelloDescriptionForClass: self) last isDigit 
+ 				ifFalse: [ self error: 'Newspeak expects interpreterVersion ends with a digit' ].
+ 			
+ 			aCCodeGenerator
+ 				var: #interpreterVersion
+ 				declareC: 'const char *interpreterVersion = "Newspeak Virtual Machine ',
+ 								((aCCodeGenerator shortMonticelloDescriptionForClass: self) copyReplaceAll: ' ' with: '_'),
+ 								'"'.
+ 			^self].
- 	NewspeakVM ifTrue:
- 		["Newspeak as of mid 2011 derives SystemScope systemName from the interpreterVersion
- 		  (via system attribute 1004) by copying up to but not including the last space, provided the
- 		  string ends with a digit.  So spaces must be eliminated from the Monitcello version string,
- 		  and we can't surround it with square brackets."
- 		(aCCodeGenerator shortMonticelloDescriptionForClass: self) last isDigit ifFalse:
- 			[self error: 'Newspeak expects interpreterVersion ends with a digit'].
- 		aCCodeGenerator
- 			var: #interpreterVersion
- 			declareC: 'const char *interpreterVersion = "Newspeak Virtual Machine ',
- 							((aCCodeGenerator shortMonticelloDescriptionForClass: self) copyReplaceAll: ' ' with: '_'),
- 							'"'.
- 		^self].
  	
  	aCCodeGenerator
  		var: #interpreterVersion
+ 		declareC: 'const char *interpreterVersion = "', defaultName, '"'.!
- 		declareC: 'const char *interpreterVersion = "Croquet Closure ', defaultName, ' VM [',
- 					(aCCodeGenerator shortMonticelloDescriptionForClass: self),']"'.!

Item was changed:
  ----- Method: VMClass class>>initializePrimitiveErrorCodes (in category 'initialization') -----
  initializePrimitiveErrorCodes
  	"Define the VM's primitive error codes.  N.B. these are
  	 replicated in platforms/Cross/vm/sqVirtualMachine.h."
  	"VMClass initializePrimitiveErrorCodes"
  	| pet |
  	PrimErrTableIndex := 51. "Zero-relative"
  	"See SmalltalkImage>>recreateSpecialObjectsArray for the table definition.
  	 If the table exists and is large enough the corresponding entry is returned as
  	 the primitive error, otherwise the error is answered numerically."
  	pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()].
  	pet isArray ifFalse: [pet := #()].
  	PrimNoErr := 0. "for helper methods that need to answer success or an error code."
  	PrimErrGenericFailure		:= pet indexOf: nil ifAbsent: 1.
  	PrimErrBadReceiver			:= pet indexOf: #'bad receiver' ifAbsent: 2.
  	PrimErrBadArgument		:= pet indexOf: #'bad argument' ifAbsent: 3.
  	PrimErrBadIndex			:= pet indexOf: #'bad index' ifAbsent: 4.
  	PrimErrBadNumArgs		:= pet indexOf: #'bad number of arguments' ifAbsent: 5.
  	PrimErrInappropriate		:= pet indexOf: #'inappropriate operation' ifAbsent: 6.
  	PrimErrUnsupported		:= pet indexOf: #'unsupported operation' ifAbsent: 7.
  	PrimErrNoModification		:= pet indexOf: #'no modification' ifAbsent: 8.
  	PrimErrNoMemory			:= pet indexOf: #'insufficient object memory' ifAbsent: 9.
  	PrimErrNoCMemory			:= pet indexOf: #'insufficient C memory' ifAbsent: 10.
  	PrimErrNotFound			:= pet indexOf: #'not found' ifAbsent: 11.
  	PrimErrBadMethod			:= pet indexOf: #'bad method' ifAbsent: 12.
  	PrimErrNamedInternal		:= pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13.
  	PrimErrObjectMayMove		:= pet indexOf: #'object may move' ifAbsent: 14.
  	PrimErrLimitExceeded		:= pet indexOf: #'resource limit exceeded' ifAbsent: 15.
  	PrimErrObjectIsPinned		:= pet indexOf: #'object is pinned' ifAbsent: 16.
  	PrimErrWritePastObject	:= pet indexOf: #'primitive write beyond end of object' ifAbsent: 17!

Item was added:
+ ----- Method: VMClass class>>interpreterVersion (in category 'accessing') -----
+ interpreterVersion 
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: VMClass class>>memoryManagerVersion (in category 'accessing') -----
+ memoryManagerVersion 
+ 	^ self subclassResponsibility!

Item was changed:
  ----- Method: VMClass class>>writeVMHeaderTo:bytesPerWord: (in category 'translation') -----
  writeVMHeaderTo: aStream bytesPerWord: bytesPerWord
  	"Generate the contents of interp.h on aStream.  Specific Interpreter subclasses
  	 override to add more stuff."
  	aStream
  		nextPutAll: '#define VM_PROXY_MAJOR '; print: self vmProxyMajorVersion; cr;
  		nextPutAll: '#define VM_PROXY_MINOR '; print: self vmProxyMinorVersion; cr;
  		cr;
  		nextPutAll: '#define SQ_VI_BYTES_PER_WORD '; print: bytesPerWord; cr;
  		cr.
  
  	"The most basic constants must be defined here, not in e.g. the plugin sources, so allow those
  	 other sources to be shared between different builds (Spur vs SqueakV3, 32-bit vs 64-bit, etc)"
  	VMBasicConstants mostBasicConstantNames asSet asArray sort do:
  		[:constName|
  		(VMBasicConstants classPool at: constName ifAbsent: []) ifNotNil:
  			[:const|
  			aStream nextPutAll: '#define '; nextPutAll: constName; space; print: const; cr]].
  	aStream cr.
  
  	((VMBasicConstants classPool associations select: [:a| a key beginsWith: 'PrimErr'])
  		asSortedCollection: [:a1 :a2| a1 value <= a2 value])
  		do: [:a|
  			aStream nextPutAll: '#define '; nextPutAll: a key; space; print: a value; cr].
  	aStream cr.
  
  	aStream
+ 		nextPutAll: '#define MinSmallInteger '; print: self objectMemoryClass new minSmallInteger; cr;
+ 		nextPutAll: '#define MaxSmallInteger '; print: self objectMemoryClass new maxSmallInteger; cr;
- 		nextPutAll: '#define MinSmallInteger '; print: self objectMemoryClass minSmallInteger; cr;
- 		nextPutAll: '#define MaxSmallInteger '; print: self objectMemoryClass maxSmallInteger; cr;
  		cr.!

Item was changed:
  ----- Method: VMClass>>doOrDefer: (in category 'simulation support') -----
  doOrDefer: aBlock
  	<doNotGenerate>
  	"Either evaluate aBlock immediately if in the uiProcess or defer aBlock as a UI message"
+ 	Processor activeProcess == UIManager default uiProcess
- 	Processor activeProcess == Project uiProcess
  		ifTrue: [aBlock value]
  		ifFalse: [WorldState addDeferredUIMessage: aBlock]!

Item was changed:
  ----- Method: VMMaker>>needsToRegenerateCogitFile (in category 'generate sources') -----
  needsToRegenerateCogitFile
  	"Check the timestamp for the relevant classes and then the timestamp for the main source file (e.g. interp.c)
  	 file if it already exists. Answer if the file needs regenerating."
  
  	| cogitClass cogitClasses tStamp |
  	cogitClasses := (cogitClass := self interpreterClass cogitClass) withAllSuperclasses copyUpThrough: Cogit.
  	cogitClasses addAllLast: (cogitClass ancilliaryClasses: self options).
  	tStamp := cogitClasses inject: 0 into: [:tS :cl| tS max: cl timeStamp].
  
  	"don't translate if the file is newer than my timeStamp"
  	(self coreVMDirectory entryAt: cogitClass sourceFileName ifAbsent: [nil]) ifNotNil:
  		[:fstat|
+ 		tStamp < fstat modificationTime asSeconds ifTrue:
- 		tStamp < fstat modificationTime ifTrue:
  			[^self confirm: 'The ', self configurationNameIfAny, cogitClass printString, ' classes have not been modified since\ the source file was last generated.\Do you still want to regenerate it?' withCRs]].
  	^true
  !

Item was changed:
  ----- Method: VMMaker>>needsToRegenerateInterpreterFile (in category 'initialize') -----
  needsToRegenerateInterpreterFile
  	"Check the timestamp for the relevant classes and then the timestamp for the main
  	 source file (e.g. interp.c) if it already exists.  Answer if the file needs regenerating."
  
  	| classes tStamp |
  	classes := self interpreterClass withAllSuperclasses copyUpTo: VMClass.
  	self interpreterClass objectMemoryClass ifNotNil:
  		[:objectMemoryClass|
  		classes addAllLast: (objectMemoryClass withAllSuperclasses copyUpTo: VMClass)].
  	classes copy do:
  		[:class| classes addAllLast: (class ancilliaryClasses: self options)].
  	tStamp := classes inject: 0 into: [:tS :cl| tS max: cl timeStamp].
  
  	"don't translate if the file is newer than my timeStamp"
  	(self coreVMDirectory entryAt: self interpreterFilename ifAbsent: [nil]) ifNotNil:
  		[:fstat|
+ 		tStamp < fstat modificationTime asSeconds ifTrue:
- 		tStamp < fstat modificationTime ifTrue:
  			[^self confirm: 'The ', self configurationNameIfAny, 'interpreter classes have not been modified since\ the interpreter file was last generated.\Do you still want to regenerate the source file?' withCRs]].
  	^true
  !

Item was changed:
  ----- Method: VMMakerTool class>>initialize (in category 'instance creation') -----
  initialize
  
+ 	Smalltalk at: #TheWorldMenu ifPresent: [ :class |
+ 		class class methodDict at: #registerOpenCommand: ifPresent: [ :method |
+ 			(method sendsSelector: #deprecated:) 
+ 				ifFalse: [ class registerOpenCommand: (Array with: 'VMMaker' with: (Array with: self with: #openInWorld)) ] ] ]
+ 	!
- 	 (TheWorldMenu respondsTo: #registerOpenCommand:)
- 
-          ifTrue: [TheWorldMenu registerOpenCommand: {'VMMaker'. {self. #openInWorld}. 'The VM making tool'}].!



More information about the Vm-dev mailing list