[commit] r2315 - OSCogVM source as per VMMaker-oscog.35. Slight improvements to LargerIntegers.

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

[commit] r2315 - OSCogVM source as per VMMaker-oscog.35. Slight improvements to LargerIntegers.

commits-3
 
Author: eliot
Date: 2010-10-03 20:39:37 -0700 (Sun, 03 Oct 2010)
New Revision: 2315

Modified:
   branches/Cog/image/VMMaker-Squeak4.1.changes
   branches/Cog/image/VMMaker-Squeak4.1.image
   branches/Cog/scripts/revertIfEssentiallyUnchanged
   branches/Cog/src/examplePlugins.ext
   branches/Cog/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c
   branches/Cog/src/plugins/B2DPlugin/B2DPlugin.c
   branches/Cog/src/plugins/BitBltPlugin/BitBltPlugin.c
   branches/Cog/src/plugins/BochsIA32Plugin/BochsIA32Plugin.c
   branches/Cog/src/plugins/CroquetPlugin/CroquetPlugin.c
   branches/Cog/src/plugins/DSAPrims/DSAPrims.c
   branches/Cog/src/plugins/FilePlugin/FilePlugin.c
   branches/Cog/src/plugins/GeniePlugin/GeniePlugin.c
   branches/Cog/src/plugins/InternetConfigPlugin/InternetConfigPlugin.c
   branches/Cog/src/plugins/JPEGReaderPlugin/JPEGReaderPlugin.c
   branches/Cog/src/plugins/LargeIntegers/LargeIntegers.c
   branches/Cog/src/plugins/MacMenubarPlugin/MacMenubarPlugin.c
   branches/Cog/src/plugins/QuicktimePlugin/QuicktimePlugin.c
   branches/Cog/src/plugins/SoundGenerationPlugin/SoundGenerationPlugin.c
   branches/Cog/src/plugins/SqueakFFIPrims/SqueakFFIPrims.c
   branches/Cog/src/plugins/StarSqueakPlugin/StarSqueakPlugin.c
   branches/Cog/src/plugins/ZipPlugin/ZipPlugin.c
   branches/Cog/src/vm/cogmethod.h
   branches/Cog/src/vm/cointerp.c
   branches/Cog/src/vm/cointerp.h
   branches/Cog/src/vm/gcc3x-cointerp.c
   branches/Cog/src/vm/interp.h
   branches/Cog/stacksrc/vm/gcc3x-interp.c
   branches/Cog/stacksrc/vm/interp.c
   branches/Cog/stacksrc/vm/interp.h
Log:
OSCogVM source as per VMMaker-oscog.35.  Slight improvements to LargerIntegers.
Freshen a few plugins after oscog.34's import of Slang tweaks to constant defs.


Modified: branches/Cog/image/VMMaker-Squeak4.1.changes
===================================================================
--- branches/Cog/image/VMMaker-Squeak4.1.changes 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/image/VMMaker-Squeak4.1.changes 2010-10-04 03:39:37 UTC (rev 2315)
@@ -133631,4 +133631,917 @@
  password: pw ].
 user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
 
-----QUIT----{1 October 2010 . 7:35:21 am} VMMaker-Squeak4.1.image priorSource: 5397953!
\ No newline at end of file
+----QUIT----{1 October 2010 . 7:35:21 am} VMMaker-Squeak4.1.image priorSource: 5397953!
+
+----STARTUP----{3 October 2010 . 8:22:57 am} as /Users/eliot/Cog/oscog/Cog.squeakvm.org/image/VMMaker-Squeak4.1.image!
+
+
+'From Squeak4.1 of 17 April 2010 [latest update: #9957] on 3 October 2010 at 8:21:56 am'!
+
+Array removeSelector: #ccg:emitLoadFor:from:on:!
+!ArrayedCollection class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/2/2010 14:12' prior: 33654660!
+ccg: cg generateCoerceToOopFrom: aNode on: aStream
+ "N.B.  The is used both for generation and simulation so answer the result (for interpretation)"
+ self instSize > 0 ifTrue:
+ [self error: 'cannot auto-coerce arrays with named instance variables'].
+ ^cg generateCoerceToObjectFromPtr: aNode on: aStream! !
+!ArrayedCollection class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/3/2010 08:09' prior: 33654968!
+ccg: cg generateCoerceToValueFrom: aNode on: aStream
+ "N.B.  The could be used both for generation and simulation so answer the result (for interpretation)"
+ ^cg
+ generateCoerceToPtr: (self ccgDeclareCForVar: '')
+ fromObject: aNode on: aStream! !
+
+Boolean removeSelector: #ccg:emitLoadFor:from:on:!
+!Boolean class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/2/2010 14:12' prior: 34232232!
+ccg: cg generateCoerceToOopFrom: aNode on: aStream
+ "N.B.  The is used both for generation and simulation so answer the result (for interpretation)"
+ ^cg generateCoerceToBooleanObjectFrom: aNode on: aStream! !
+!Boolean class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/3/2010 08:09' prior: 34232431!
+ccg: cg generateCoerceToValueFrom: aNode on: aStream
+ "N.B.  The could be used both for generation and simulation so answer the result (for interpretation)"
+ ^cg generateCoerceToBooleanValueFrom: aNode on: aStream! !
+
+ByteArray removeSelector: #ccg:emitLoadFor:from:on:!
+!CogVMSimulator methodsFor: 'plugin support' stamp: 'eem 10/2/2010 09:50' prior: 35018254!
+ioLoadFunction: functionString From: pluginString
+ "Load and return the requested function from a module"
+ | firstTime plugin fnSymbol |
+ firstTime := false.
+ fnSymbol := functionString asSymbol.
+ transcript
+ cr;
+ show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
+ (pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
+ functionString = breakSelector ifTrue: [self halt: breakSelector].
+ plugin := pluginList
+ detect:[:any| any key = pluginString asString]
+ ifNone:
+ [firstTime := true.
+ self loadNewPlugin: pluginString].
+ plugin ifNil: [^0].
+ plugin := plugin value.
+ mappedPluginEntries doWithIndex:
+ [:pluginAndName :index|
+ ((pluginAndName at: 1) == plugin
+ and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
+ [^index]].
+ (plugin respondsTo: fnSymbol) ifFalse:
+ [firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
+ ^0].
+ mappedPluginEntries addLast: (Array
+ with: plugin
+ with: fnSymbol
+ with: [plugin perform: fnSymbol. self]).
+ "Transcript show: ' ... okay'."
+ ^ mappedPluginEntries size! !
+!CogVMSimulator methodsFor: 'plugin support' stamp: 'eem 10/2/2010 09:40' prior: 35019443!
+loadNewPlugin: pluginString
+ | plugin plugins simulatorClasses |
+ transcript cr; show: 'Looking for module ', pluginString.
+ "but *why*??"
+ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
+ [transcript show: ' ... defeated'. ^nil].
+ plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString].
+ simulatorClasses := (plugins
+ select: [:psc| psc simulatorClass notNil]
+ thenCollect: [:psc| psc simulatorClass]) asSet.
+ simulatorClasses isEmpty ifTrue: [transcript show: ' ... not found'. ^nil].
+ simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
+ plugins size > 1 ifTrue:
+ [transcript show: '...multiple plugin classes; choosing ', plugins last name].
+ plugin := simulatorClasses anyOne newFor: plugins last. "hopefully lowest in the hierarchy..."
+ plugin setInterpreter: objectMemory. "Ignore return value from setInterpreter"
+ (plugin respondsTo: #initialiseModule) ifTrue:
+ [plugin initialiseModule ifFalse:
+ [transcript show: ' ... initialiser failed'. ^nil]]. "module initialiser failed"
+ pluginList := pluginList copyWith: (pluginString asString -> plugin).
+ transcript show: ' ... loaded'.
+ ^pluginList last! !
+!CogVMSimulator methodsFor: 'debugging traps' stamp: 'eem 10/3/2010 08:17' prior: 35015371!
+sendBreak: selectorString point: selectorLength receiver: receiverOrNil
+ "self shortPrintFrameAndCallers: localFP"
+ | i |
+ cogit printOnTrace ifTrue:
+ [0 to: selectorLength - 1 do:
+ [:si| transcript nextPut: (self byteAt: selectorString + si) asCharacter].
+ transcript cr; flush].
+ breakSelectorLength = selectorLength ifTrue:
+ [i := breakSelectorLength.
+ [i > 0] whileTrue:
+ [(self byteAt: selectorString + i - 1) = (breakSelector at: i) asInteger
+ ifTrue: [(i := i - 1) = 0 ifTrue:
+ [self halt: 'Send of '
+ , breakSelector,
+ (receiverOrNil
+ ifNotNil: [' to ', (self shortPrint: receiverOrNil)]
+ ifNil: [''])]]
+ ifFalse: [i := 0]]]! !
+!Cogit methodsFor: 'simulation only' stamp: 'eem 10/3/2010 08:18' prior: 35274930!
+simulateCogCodeAt: address "<Integer>"
+ <doNotGenerate>
+ | stackZoneBase |
+ stackZoneBase := coInterpreter stackZoneBase.
+ processor eip: address.
+ [[[singleStep ifTrue:
+ [[processor sp < stackZoneBase ifTrue: [self halt].
+  self recordRegisters.
+  printRegisters ifTrue:
+ [processor printRegistersOn: coInterpreter transcript].
+  self recordLastInstruction.
+  printInstructions ifTrue:
+ [Transcript nextPutAll: lastNInstructions last; cr; flush].
+  (processor pc = breakPC
+   and: [breakBlock value: self]) ifTrue:
+ ["printRegisters := printInstructions := true"
+ "self reportLastNInstructions"
+ "coInterpreter printExternalHeadFrame"
+ "coInterpreter printFrameAndCallers: coInterpreter framePointer SP: coInterpreter stackPointer"
+ "coInterpreter shortPrintFrameAndCallers: coInterpreter framePointer"
+ "coInterpreter printFrame: processor fp WithSP: processor sp"
+ "coInterpreter printFrameAndCallers: processor fp SP: processor sp"
+ "coInterpreter shortPrintFrameAndCallers: processor fp"
+ "self disassembleMethodFor: processor pc"
+ self halt: 'machine code breakpoint at ', breakPC hex]] value]. "So that the Debugger's Over steps over all this"
+   singleStep
+ ifTrue: [processor
+ singleStepIn: coInterpreter memory
+ minimumAddress: guardPageSize
+ readOnlyBelow: coInterpreter cogCodeSize]
+ ifFalse: [processor
+ runInMemory: coInterpreter memory
+ minimumAddress: guardPageSize
+ readOnlyBelow: coInterpreter cogCodeSize].
+   ((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
+ [(self confirm: 'continue?') ifFalse:
+ [self halt]].
+   true] whileTrue]
+ on: ProcessorSimulationTrap
+ do: [:ex| self handleSimulationTrap: ex].
+ true] whileTrue! !
+
+Float removeSelector: #ccg:emitLoadFor:from:on:!
+!Float class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/2/2010 14:12' prior: 35645867!
+ccg: cg generateCoerceToOopFrom: aNode on: aStream
+ "N.B.  The is used both for generation and simulation so answer the result (for interpretation)"
+ ^cg generateCoerceToFloatObjectFrom: aNode on: aStream! !
+!Float class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/3/2010 08:09' prior: 35646062!
+ccg: cg generateCoerceToValueFrom: aNode on: aStream
+ "N.B.  The could be used both for generation and simulation so answer the result (for interpretation)"
+ ^cg generateCoerceToFloatValueFrom: aNode on: aStream! !
+
+FloatArray removeSelector: #ccg:emitLoadFor:from:on:!
+
+IntegerArray removeSelector: #ccg:emitLoadFor:from:on:!
+!InterpreterPlugin class methodsFor: 'simulation' stamp: 'eem 10/1/2010 20:35'!
+newFor: anUnsimulatedInterpreterPluginClass
+ "Overridden by SmartSyntaxPluginSimulator to wrap a specific plugin class."
+ ^self new! !
+!InterpreterSimulator methodsFor: 'memory access' stamp: 'eem 10/2/2010 12:49' prior: 36458668!
+firstIndexableField: oop
+ "NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
+ | hdr fmt totalLength fixedFields |
+ <returnTypeC: #'void *'>
+ hdr := self baseHeader: oop.
+ fmt := self formatOfHeader: hdr.
+ fmt <= 4 ifTrue: "<= 4 pointer"
+ ["pointer; may need to delve into the class format word"
+ totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ ^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
+ ^self
+ cCoerce: (self pointerForOop: oop + BaseHeaderSize)
+ to: (fmt < 8
+ ifTrue: [fmt = 6
+ ifTrue: ["32 bit field objects" 'int *']
+ ifFalse: ["full word objects (bits)" 'oop *']]
+ ifFalse: ["byte objects (including CompiledMethod" 'char *'])! !
+!InterpreterSimulator methodsFor: 'plugin support' stamp: 'eem 10/3/2010 08:15' prior: 36464663!
+ioLoadFunction: functionString From: pluginString
+ "Load and return the requested function from a module"
+ | plugin fnSymbol |
+ fnSymbol := functionString asSymbol.
+ transcript cr; show:'Looking for ', functionString, ' in '.
+ pluginString isEmpty
+ ifTrue:[transcript show: 'vm']
+ ifFalse:[transcript show: pluginString].
+ plugin := pluginList
+ detect:[:any| any key = pluginString asString]
+ ifNone:[self loadNewPlugin: pluginString].
+ plugin ifNil:[
+ "Transcript cr; show:'Failed ... no plugin found'." ^ 0].
+ plugin := plugin value.
+ mappedPluginEntries doWithIndex:[:pluginAndName :index|
+ ((pluginAndName at: 1) == plugin
+ and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:[
+ "Transcript show:' ... okay'." ^ index]].
+ (plugin respondsTo: fnSymbol) ifFalse:[
+ "Transcript cr; show:'Failed ... primitive not in plugin'." ^ 0].
+ mappedPluginEntries := mappedPluginEntries copyWith: (Array with: plugin with: fnSymbol).
+ "Transcript show:' ... okay'."
+ ^ mappedPluginEntries size! !
+!InterpreterSimulator methodsFor: 'plugin support' stamp: 'eem 10/3/2010 08:21' prior: 36465745!
+loadNewPlugin: pluginString
+ | plugin plugins simulatorClasses |
+ transcript cr; show: 'Looking for module ', pluginString.
+ "but *why*??"
+ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
+ [transcript show: ' ... defeated'. ^nil].
+ plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString].
+ simulatorClasses := (plugins
+ select: [:psc| psc simulatorClass notNil]
+ thenCollect: [:psc| psc simulatorClass]) asSet.
+ simulatorClasses isEmpty ifTrue: [transcript show: ' ... not found'. ^nil].
+ simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
+ plugins size > 1 ifTrue:
+ [transcript show: '...multiple plugin classes; choosing ', plugins last name].
+ plugin := simulatorClasses anyOne newFor: plugins last. "hopefully lowest in the hierarchy..."
+ plugin setInterpreter: self. "Ignore return value from setInterpreter"
+ (plugin respondsTo: #initialiseModule) ifTrue:
+ [plugin initialiseModule ifFalse:
+ [transcript show: ' ... initialiser failed'. ^nil]]. "module initialiser failed"
+ pluginList := pluginList copyWith: (pluginString asString -> plugin).
+ transcript show: ' ... loaded'.
+ ^pluginList last! !
+!LargeIntegersPlugin class methodsFor: 'instance creation' stamp: 'eem 10/2/2010 09:38'!
+simulatorClass
+ self flag: 'comment when this works!!!!'.
+ ^SmartSyntaxPluginSimulator! !
+!LargeIntegersPlugin methodsFor: 'util' stamp: 'eem 10/2/2010 13:17' prior: 36635258!
+unsafeByteOf: bytesOop at: ix
+ "Argument bytesOop must not be aSmallInteger!!"
+ <inline: true>
+ | pointer |
+ <var: #pointer type: #'unsigned char *'>
+ ^(pointer := interpreterProxy firstIndexableField: bytesOop) at: ix - 1! !
+!NewCoObjectMemorySimulator methodsFor: 'simulation only' stamp: 'eem 10/2/2010 12:49' prior: 36913400!
+firstIndexableField: oop
+ "NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
+ | hdr fmt totalLength fixedFields |
+ <returnTypeC: #'void *'>
+ hdr := self baseHeader: oop.
+ fmt := self formatOfHeader: hdr.
+ fmt <= 4 ifTrue: "<= 4 pointer"
+ ["pointer; may need to delve into the class format word"
+ totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ ^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
+ ^self
+ cCoerce: (self pointerForOop: oop + BaseHeaderSize)
+ to: (fmt < 8
+ ifTrue: [fmt = 6
+ ifTrue: ["32 bit field objects" 'int *']
+ ifFalse: ["full word objects (bits)" 'oop *']]
+ ifFalse: ["byte objects (including CompiledMethod" 'char *'])! !
+!NewCoObjectMemorySimulator methodsFor: 'simulation only' stamp: 'eem 10/2/2010 13:25'!
+is: oop KindOf: classNameString
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter is: oop KindOf: classNameString! !
+!NewCoObjectMemorySimulator methodsFor: 'simulation only' stamp: 'eem 10/2/2010 13:27'!
+success: boolean
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter success: boolean! !
+!NewObjectMemorySimulator methodsFor: 'simulation only' stamp: 'eem 10/2/2010 12:49' prior: 37026846!
+firstIndexableField: oop
+ "NOTE: overridden from ObjectMemory to add coercion to CArray, so please duplicate any changes"
+ | hdr fmt totalLength fixedFields |
+ <returnTypeC: #'void *'>
+ hdr := self baseHeader: oop.
+ fmt := self formatOfHeader: hdr.
+ fmt <= 4 ifTrue: "<= 4 pointer"
+ ["pointer; may need to delve into the class format word"
+ totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ ^self cCoerce: (self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)) to: 'oop *'].
+ ^self
+ cCoerce: (self pointerForOop: oop + BaseHeaderSize)
+ to: (fmt < 8
+ ifTrue: [fmt = 6
+ ifTrue: ["32 bit field objects" 'int *']
+ ifFalse: ["full word objects (bits)" 'oop *']]
+ ifFalse: ["byte objects (including CompiledMethod" 'char *'])! !
+!NewObjectMemorySimulator methodsFor: 'simulation only' stamp: 'eem 10/2/2010 15:34'!
+is: oop KindOf: classNameString
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter is: oop KindOf: classNameString! !
+!NewObjectMemorySimulator methodsFor: 'simulation only' stamp: 'eem 10/2/2010 22:37'!
+stObject: objOop at: indexOop put: valueOop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter stObject: objOop at: indexOop put: valueOop! !
+!NewObjectMemorySimulator methodsFor: 'simulation only' stamp: 'eem 10/2/2010 15:34'!
+success: boolean
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter success: boolean! !
+
+Object removeSelector: #ccg:emitLoadFor:from:on:!
+!Object class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/2/2010 14:12' prior: 37126091!
+ccg: cg generateCoerceToOopFrom: aNode on: aStream
+ "N.B.  The is used both for generation and simulation so answer the result (for interpretation)"
+ ^cg emitCExpression: aNode on: aStream! !
+!Object class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/3/2010 08:09' prior: 37126271!
+ccg: cg generateCoerceToValueFrom: aNode on: aStream
+ "N.B.  The could be used both for generation and simulation so answer the result (for interpretation)"
+ ^cg emitCExpression: aNode on: aStream! !
+!Object methodsFor: '*VMMaker-translation support' stamp: 'eem 10/2/2010 13:55' prior: 37114029!
+asOop: aClass
+
+ (self class isVariable and: [self class instSize > 0])
+ ifTrue: [self error: 'cannot auto-coerce indexable objects with named instance variables'].
+ (aClass ccgCanConvertFrom: self)
+ ifFalse: [self error: 'incompatible object for this coercion'].
+ ^(Notification new tag: #getSimulator; signal)
+ ifNotNil: [:simulator| aClass ccg: simulator generateCoerceToOopFrom: self on: nil]
+ ifNil: [self]! !
+!Object methodsFor: '*VMMaker-translation support' stamp: 'eem 10/2/2010 22:55' prior: 37115697!
+debugCode: aBlock
+ "Sending this message tells the code generator that there is debug code in
+ aBlock. Debug code will be be generated only, if the correponding flag
+ has been set by TestCodeGenerator>>generateDebugCode:.
+ In ST simulation just perform the debug code."
+ false ifTrue: [aBlock value]! !
+
+Object removeSelector: #primitive:parameters:!
+
+Object removeSelector: #primitive:parameters:!
+
+Object removeSelector: #primitive:parameters:receiver:!
+
+Object removeSelector: #primitive:parameters:receiver:!
+!Object methodsFor: '*VMMaker-translation support' stamp: 'eem 10/2/2010 22:19' prior: 37117773!
+stAt: index
+ "Simulation of generateStAt:on:indent:"
+
+ ^(Notification new tag: #getSimulator; signal)
+ ifNotNil: [:simulator| simulator stObject: self at: index]
+ ifNil: [self at: index]! !
+!Object methodsFor: '*VMMaker-translation support' stamp: 'eem 10/2/2010 22:33' prior: 37117887!
+stAt: index put: value
+ "Simulation of generateStAtPut:on:indent:"
+
+ ^(Notification new tag: #getSimulator; signal)
+ ifNotNil: [:simulator| simulator getInterpreter stObject: self at: index put: value]
+ ifNil: [self at: index put: value]! !
+!ObjectMemory methodsFor: 'object format' stamp: 'eem 10/2/2010 12:40' prior: 37253390!
+firstIndexableField: oop
+ "NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes"
+ | hdr fmt totalLength fixedFields |
+ <returnTypeC: #'void *'>
+ hdr := self baseHeader: oop.
+ fmt := self formatOfHeader: hdr.
+ fmt <= 4 ifTrue: "<= 4 pointer"
+ ["pointer; may need to delve into the class format word"
+ totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ ^self pointerForOop: oop + BaseHeaderSize + (fixedFields << ShiftForWord)].
+ ^self pointerForOop: oop + BaseHeaderSize! !
+!Oop class methodsFor: 'plugin generation' stamp: 'eem 10/2/2010 14:12' prior: 37303011!
+ccg: cg generateCoerceToOopFrom: aNode on: aStream
+ "N.B.  The is used both for generation and simulation so answer the result (for interpretation)"
+ ^cg emitCExpression: aNode on: aStream! !
+!Oop class methodsFor: 'plugin generation' stamp: 'eem 10/3/2010 08:09' prior: 37303179!
+ccg: cg generateCoerceToValueFrom: aNode on: aStream
+ "N.B.  The could be used both for generation and simulation so answer the result (for interpretation)"
+ ^cg emitCExpression: aNode on: aStream! !
+!SmallInteger class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/2/2010 14:12' prior: 37811460!
+ccg: cg generateCoerceToOopFrom: aNode on: aStream
+ "N.B.  The is used both for generation and simulation so answer the result (for interpretation)"
+ ^cg generateCoerceToSmallIntegerObjectFrom: aNode on: aStream! !
+!SmallInteger class methodsFor: '*VMMaker-plugin generation' stamp: 'eem 10/3/2010 08:09' prior: 37811669!
+ccg: cg generateCoerceToValueFrom: aNode on: aStream
+ "N.B.  The could be used both for generation and simulation so answer the result (for interpretation)"
+ ^cg generateCoerceToSmallIntegerValueFrom: aNode on: aStream! !
+
+InterpreterPlugin subclass: #SmartSyntaxInterpreterPlugin
+ instanceVariableNames: 'simulator'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SmartSyntaxPlugins'!
+!SmartSyntaxInterpreterPlugin commentStamp: '<historical>' prior: 37836691!
+Subclass of InterpreterPlugin, used in connection with TestCodeGenerator for named primitives with type coercion specifications!
+!SmartSyntaxInterpreterPlugin class methodsFor: 'translation' stamp: 'eem 10/2/2010 10:01'!
+prepareToBeAddedToCodeGenerator: aCodeGen
+ aCodeGen removeVariable: 'simulator'! !
+!SmartSyntaxInterpreterPlugin methodsFor: 'simulation' stamp: 'eem 10/2/2010 10:05'!
+primitive: primName parameters: parms
+ <doNotGenerate>
+ ^simulator primitive: primName parameters: parms! !
+!SmartSyntaxInterpreterPlugin methodsFor: 'simulation' stamp: 'eem 10/2/2010 10:13'!
+primitive: primName parameters: anArray receiver: aClassSymbol
+ <doNotGenerate>
+ ^simulator primitive: primName parameters: anArray receiver: aClassSymbol! !
+!SmartSyntaxInterpreterPlugin methodsFor: 'simulation' stamp: 'eem 10/2/2010 11:17'!
+remapOop: oopOrList in: aBlock
+ <doNotGenerate>
+ | numIncrGCs numFullGCs result |
+ numIncrGCs := interpreterProxy statIncrGCs.
+ numFullGCs := interpreterProxy statFullGCs.
+ result := aBlock value.
+ "If you really did want to implement remapping you would try and locate the
+ arguments in the caller context and update them via tempAt:put:.  But beware
+ ambiguities.  You'd have to parse the bytecode to be sure to get the right temps."
+ (numIncrGCs ~= interpreterProxy statIncrGCs
+ or: [numFullGCs ~= interpreterProxy statFullGCs]) ifTrue:
+ [self error: 'GC occurred in middle of remapOop:in: and remapping in this context is not implemented'].
+ ^result! !
+!SmartSyntaxInterpreterPlugin methodsFor: 'accessing' stamp: 'eem 10/2/2010 10:02'!
+simulator
+ ^simulator! !
+!SmartSyntaxInterpreterPlugin methodsFor: 'accessing' stamp: 'eem 10/2/2010 10:02'!
+simulator: aSmartSyntaxPluginSimulator
+ <doNotGenerate>
+ simulator := aSmartSyntaxPluginSimulator! !
+
+InterpreterPlugin subclass: #SmartSyntaxPluginSimulator
+ instanceVariableNames: 'actualPlugin signatureMap forMap'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SmartSyntaxPlugins'!
+!SmartSyntaxPluginSimulator class methodsFor: 'simulation' stamp: 'eem 10/1/2010 20:36'!
+newFor: anUnsimulatedInterpreterPluginClass
+ ^self new
+ actualPlugin: anUnsimulatedInterpreterPluginClass new;
+ yourself! !
+!SmartSyntaxPluginSimulator methodsFor: 'accessing' stamp: 'eem 10/1/2010 09:22'!
+actualPlugin
+ "Answer the value of actualPlugin"
+
+ ^ actualPlugin! !
+!SmartSyntaxPluginSimulator methodsFor: 'accessing' stamp: 'eem 10/2/2010 10:04'!
+actualPlugin: aSmartSyntaxInterpreterPlugin
+ actualPlugin := aSmartSyntaxInterpreterPlugin.
+ actualPlugin simulator: self! !
+!SmartSyntaxPluginSimulator methodsFor: 'simulation' stamp: 'eem 10/2/2010 22:00'!
+ccgLoad: forProlog expr: failBlock asBooleanValueFrom: anInteger
+ ^[:oop| interpreterProxy booleanValueOf: oop]! !
+!SmartSyntaxPluginSimulator methodsFor: 'simulation' stamp: 'eem 10/2/2010 21:48'!
+ccgLoad: forProlog expr: failBlock asIntegerValueFrom: anInteger
+ ^[:oop| interpreterProxy checkedIntegerValueOf: oop]! !
+!SmartSyntaxPluginSimulator methodsFor: 'simulation' stamp: 'eem 10/2/2010 13:29'!
+ccgLoad: forProlog expr: failBlock asKindOf: aClass from: argIndexOrNil
+ ^[:oop|
+   interpreterProxy success: (interpreterProxy is: oop KindOf: aClass name asString).
+   oop]! !
+!SmartSyntaxPluginSimulator methodsFor: 'simulation' stamp: 'eem 10/2/2010 21:46'!
+ccgLoad: forProlog expr: failBlock asRawOopFrom: anUndefinedObject
+ ^[:oop| oop]! !
+!SmartSyntaxPluginSimulator methodsFor: 'initialize' stamp: 'eem 10/2/2010 22:31'!
+computeSignatureFor: selector from: tuple
+ | signature |
+ self assert: tuple first == #forMap.
+ signature := tuple third collect:
+ [:className|
+ (Smalltalk classNamed: className)
+ ifNil: [self error: 'Argument class' , className, ' does not exist']
+ ifNotNil:
+ [:argClass|
+ argClass
+ ccg: self
+ prolog: true
+ expr: [interpreterProxy primitiveFail]
+ index: nil]].
+ ^signatureMap
+ at: tuple second asSymbol
+ put: { selector.
+ signature.
+ tuple fourth
+ ifNil: [[:oop| oop]]
+ ifNotNil:
+ [:rcvrClassSymbol|
+ (Smalltalk classNamed: rcvrClassSymbol)
+ ifNil: [self error: 'Receiver class' , rcvrClassSymbol, ' does not exist']
+ ifNotNil:
+ [:rcvrClass|
+ rcvrClass
+ ccg: self
+ prolog: false
+ expr: [interpreterProxy primitiveFail]
+ index: nil]] }! !
+!SmartSyntaxPluginSimulator methodsFor: 'initialize' stamp: 'eem 10/2/2010 22:45'!
+computeSignatureMap
+ forMap := true. "true only while we compute the signatureMap"
+ signatureMap := Dictionary new.
+ actualPlugin class selectorsAndMethodsDo:
+ [:s :m|
+ (m messages includesAnyOf: #(primitive:parameters: primitive:parameters:receiver:)) ifTrue:
+ [self getPrimitiveSignatureFor: s]].
+ forMap := false! !
+!SmartSyntaxPluginSimulator methodsFor: 'message forwarding' stamp: 'eem 10/2/2010 22:31'!
+doesNotUnderstand: aMessage
+ | signature selector parameters rawResult resultBlock result |
+ signature := signatureMap
+ at: aMessage selector
+ ifAbsent: [^super doesNotUnderstand: aMessage].
+ selector := signature first.
+ parameters := signature second.
+ rawResult := [actualPlugin
+ perform: selector
+ withArguments: (parameters withIndexCollect:
+ [:block :index|
+ block value: (interpreterProxy stackValue: parameters size - index)])]
+ on: Notification
+ do: [:ex|
+ ex tag == #getSimulator
+ ifTrue: [ex resume: self]
+ ifFalse: [ex pass]].
+ interpreterProxy failed ifTrue:
+ [^nil].
+ resultBlock := signature third.
+ result := resultBlock value: rawResult.
+ interpreterProxy failed ifTrue:
+ [^nil].
+ interpreterProxy
+ pop: interpreterProxy methodArgumentCount + 1
+ thenPush: result.
+ ^nil "SmartSyntaxPluginPrimitives return null"! !
+!SmartSyntaxPluginSimulator methodsFor: 'simulation' stamp: 'eem 10/2/2010 14:03'!
+generateCoerceToSmallIntegerObjectFrom: aSmallInteger on: ignored
+ ^interpreterProxy integerObjectOf: aSmallInteger! !
+!SmartSyntaxPluginSimulator methodsFor: 'initialize' stamp: 'eem 10/2/2010 22:21'!
+getPrimitiveSignatureFor: s
+ "Execute the primitive until the send of #primitive:parameters: or primitive:parameters:receiver:,
+ collect the processed signature and store it in the map"
+ [actualPlugin perform: s withArguments: (1 to: s numArgs) asArray]
+ on: Notification
+ do: [:ex|
+ (ex tag isArray
+ and: [ex tag first == #forMap]) ifTrue:
+ [^self computeSignatureFor: s from: ex tag]].
+ self error: 'can''t find primitive name in ', s! !
+!SmartSyntaxPluginSimulator methodsFor: 'initialize' stamp: 'eem 10/2/2010 22:44'!
+initialiseModule
+ ^(actualPlugin respondsTo: #initialiseModule) not
+  or: [actualPlugin initialiseModule]! !
+!SmartSyntaxPluginSimulator methodsFor: 'simulation' stamp: 'eem 10/2/2010 21:36'!
+primitive: primNameString parameters: argumentClassNames
+ "If initializing, pass back the type signature.  If executing, answer nil."
+ ^self primitive: primNameString parameters: argumentClassNames receiver: nil! !
+!SmartSyntaxPluginSimulator methodsFor: 'simulation' stamp: 'eem 10/2/2010 21:35'!
+primitive: primNameString parameters: argumentClassNames receiver: rcvrClassSymbolOrNil
+ "If initializing, pass back the type signature.  If executing, answer the receiver or nil."
+ forMap
+ ifTrue:
+ [Notification new
+ tag: {#forMap. primNameString. argumentClassNames. rcvrClassSymbolOrNil};
+ signal]
+ ifFalse:
+ [^rcvrClassSymbolOrNil ifNotNil:
+ [interpreterProxy stackValue: interpreterProxy methodArgumentCount]]! !
+!SmartSyntaxPluginSimulator methodsFor: 'message forwarding' stamp: 'eem 10/2/2010 22:31'!
+respondsTo: aSelector
+ ^(signatureMap notNil and: [signatureMap includesKey: aSelector])
+  or: [super respondsTo: aSelector]! !
+!SmartSyntaxPluginSimulator methodsFor: 'initialize' stamp: 'eem 10/2/2010 22:45'!
+setInterpreter: anInterpreterProxy
+ interpreterProxy := anInterpreterProxy.
+ actualPlugin setInterpreter: anInterpreterProxy.
+ self computeSignatureMap! !
+
+SmartSyntaxPluginTMethod removeSelector: #simulatePrologInContext:!
+
+SmartSyntaxPluginTMethod removeSelector: #simulatePrologInContext:!
+
+StackInterpreterPrimitives subclass: #StackInterpreterSimulator
+ instanceVariableNames: 'byteCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock breakCount'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-InterpreterSimulation'!
+!StackInterpreterSimulator methodsFor: 'testing' stamp: 'eem 10/2/2010 15:45'!
+ensureDebugAtEachStepBlock
+ atEachStepBlock := [printFrameAtEachStep ifTrue:
+ [self printFrame: localFP WithSP: localSP].
+ printBytecodeAtEachStep ifTrue:
+ [self printCurrentBytecodeOn: transcript.
+ transcript cr; flush].
+ byteCount = breakCount ifTrue:
+ ["printFrameAtEachStep :=" printBytecodeAtEachStep := true]]! !
+!StackInterpreterSimulator methodsFor: 'interpreter shell' stamp: 'eem 10/2/2010 15:45' prior: 38441336!
+incrementByteCount
+ (byteCount := byteCount + 1) = breakCount ifTrue:
+ [self doOrDefer: [self changed: #byteCountText].
+ self halt].
+ byteCount \\ 1000 = 0 ifTrue:
+ [self doOrDefer: [self changed: #byteCountText].
+ self forceInterruptCheck.
+ byteCount \\ 10000 = 0 ifTrue: [self fullDisplayUpdate]]! !
+!StackInterpreterSimulator methodsFor: 'plugin support' stamp: 'eem 10/2/2010 15:32' prior: 38451937!
+loadNewPlugin: pluginString
+ | plugin plugins simulatorClasses |
+ transcript cr; show: 'Looking for module ', pluginString.
+ "but *why*??"
+ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
+ [transcript show: ' ... defeated'. ^nil].
+ plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString].
+ simulatorClasses := (plugins
+ select: [:psc| psc simulatorClass notNil]
+ thenCollect: [:psc| psc simulatorClass]) asSet.
+ simulatorClasses isEmpty ifTrue: [transcript show: ' ... not found'. ^nil].
+ simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
+ plugins size > 1 ifTrue:
+ [transcript show: '...multiple plugin classes; choosing ', plugins last name].
+ plugin := simulatorClasses anyOne newFor: plugins last. "hopefully lowest in the hierarchy..."
+ plugin setInterpreter: objectMemory. "Ignore return value from setInterpreter"
+ (plugin respondsTo: #initialiseModule) ifTrue:
+ [plugin initialiseModule ifFalse:
+ [transcript show: ' ... initialiser failed'. ^nil]]. "module initialiser failed"
+ pluginList := pluginList copyWith: (pluginString asString -> plugin).
+ transcript show: ' ... loaded'.
+ ^pluginList last! !
+!StackInterpreterSimulator methodsFor: 'UI' stamp: 'eem 10/2/2010 15:37' prior: 38447358!
+openAsMorph
+ "Open a morphic view on this simulation."
+ | window localImageName |
+ localImageName := FileDirectory default localNameFor: imageName.
+ window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
+
+ window addMorph: (displayView := ImageMorph new image: displayForm)
+ frame: (0@0 corner: 1@0.8).
+
+ transcript := TranscriptStream on: (String new: 10000).
+ window addMorph: (PluggableTextMorph
+ on: transcript text: nil accept: nil
+ readSelection: nil menu: #codePaneMenu:shifted:)
+ frame: (0@0.8 corner: 0.7@1).
+
+ window addMorph: (PluggableTextMorph on: self
+ text: #byteCountText accept: nil
+ readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
+ frame: (0.7@0.8 corner: 1@1).
+
+ window openInWorldExtent: (self desiredDisplayExtent
+ + (2 * window borderWidth)
+ + (0@window labelHeight)
+ * (1@(1/0.8))) rounded! !
+!StackInterpreterSimulator methodsFor: 'arithmetic largeint primitives' stamp: 'eem 10/2/2010 20:25'!
+primitiveMultiplyLargeIntegers
+ (objectMemory lengthOf: (self stackValue: 1)) >= 9 ifTrue:
+ [self halt].
+ ^super primitiveMultiplyLargeIntegers! !
+!StackInterpreterSimulator methodsFor: 'arithmetic largeint primitives' stamp: 'eem 10/2/2010 20:24'!
+primitiveQuoLargeIntegers
+ (objectMemory lengthOf: (self stackValue: 1)) >= 9 ifTrue:
+ [self halt].
+ ^super primitiveQuoLargeIntegers! !
+!StackInterpreterSimulator methodsFor: 'arithmetic largeint primitives' stamp: 'eem 10/2/2010 20:24'!
+primitiveSubtractLargeIntegers
+ (objectMemory lengthOf: (self stackValue: 1)) >= 9 ifTrue:
+ [self halt].
+ ^super primitiveSubtractLargeIntegers! !
+!StackInterpreterSimulator methodsFor: 'testing' stamp: 'eem 10/2/2010 15:46' prior: 38433977!
+runWithBreakCount: theBreakCount
+ "Just run, halting when byteCount is reached"
+ quitBlock := [(displayView notNil
+   and: [UIManager default confirm: 'close?']) ifTrue:
+ [(displayView outermostMorphThat: [:m| m isSystemWindow]) ifNotNil:
+ [:topWindow| topWindow delete]].
+  ^self].
+ breakCount := theBreakCount.
+ self initStackPages.
+ 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! !
+!StackInterpreterSimulator methodsFor: 'UI' stamp: 'eem 10/2/2010 15:31'!
+toggleTranscript
+ | transcriptPane |
+ transcript ifNil: [transcript := Transcript. ^self].
+ displayView ifNil: [^self changed: #flash].
+ transcriptPane := (displayView outermostMorphThat: [:m| m isSystemWindow])
+ submorphThat: [:m| m model isStream]
+ ifNone: [^self changed: #flash].
+ transcript := transcript = Transcript
+ ifTrue: [transcriptPane model]
+ ifFalse: [Transcript]! !
+!StackInterpreterSimulator methodsFor: 'UI' stamp: 'eem 10/2/2010 15:50'!
+utilitiesMenu: aMenuMorph
+ aMenuMorph
+ add: 'toggle transcript' action: #toggleTranscript;
+ addLine;
+ add: 'print ext head frame' action: #printExternalHeadFrame;
+ add: 'print int head frame' action: #printHeadFrame;
+ add: 'short print frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
+ add: 'long print frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
+ add: 'print call stack' action: #printCallStack;
+ addLine;
+ add: 'inspect object memory' target: objectMemory action: #inspect;
+ add: 'inspect cointerpreter' action: #inspect;
+ addLine;
+ add: 'set break pc...' action: #setBreakPC;
+ addLine;
+ add: 'set break count...' action: #setBreakCount;
+ add: (printSends
+ ifTrue: ['no print sends']
+ ifFalse: ['print sends'])
+ action: [self ensureDebugAtEachStepBlock.
+ printSends := printSends not];
+ "currently printReturns does nothing"
+ "add: (printReturns
+ ifTrue: ['no print returns']
+ ifFalse: ['print returns'])
+ action: [self ensureDebugAtEachStepBlock.
+ printReturns := printReturns not];"
+ add: (printBytecodeAtEachStep
+ ifTrue: ['no print bytecode each bytecode']
+ ifFalse: ['print bytecode each bytecode'])
+ action: [self ensureDebugAtEachStepBlock.
+ printBytecodeAtEachStep := printBytecodeAtEachStep not];
+ add: (printFrameAtEachStep
+ ifTrue: ['no print frame each bytecode']
+ ifFalse: ['print frame each bytecode'])
+ action: [self ensureDebugAtEachStepBlock.
+ printFrameAtEachStep := printFrameAtEachStep not].
+ ^aMenuMorph! !
+
+Unsigned removeSelector: #ccg:emitLoadFor:from:on:!
+!Unsigned class methodsFor: 'plugin generation' stamp: 'eem 10/2/2010 14:12' prior: 38775441!
+ccg: cg generateCoerceToOopFrom: aNode on: aStream
+ "N.B.  The is used both for generation and simulation so answer the result (for interpretation)"
+ ^cg generateCoerceToUnsignedObjectFrom: aNode on: aStream! !
+!Unsigned class methodsFor: 'plugin generation' stamp: 'eem 10/3/2010 08:09' prior: 38775633!
+ccg: cg generateCoerceToValueFrom: aNode on: aStream
+ "N.B.  The could be used both for generation and simulation so answer the result (for interpretation)"
+ ^cg generateCoerceToUnsignedValueFrom: aNode on: aStream! !
+
+WordArray removeSelector: #ccg:emitLoadFor:from:on:!
+
+WordsOrBytes removeSelector: #ccg:emitLoadFor:from:on:!
+
+----End fileIn of /Users/eliot/Cog/methods.st----!
+
+'From Squeak4.1 of 17 April 2010 [latest update: #9957] on 3 October 2010 at 8:28:19 am'!
+!SmartSyntaxPluginSimulator class methodsFor: 'simulation' stamp: 'eem 10/3/2010 08:28'!
+shouldBeTranslated
+ ^false! !
+
+----End fileIn of /Users/eliot/Cog/SmartSyntaxPluginSimulator class-shouldBeTranslated.st----!
+
+VMMaker
+ generate: CoInterpreter
+ to: (FileDirectory default / '../src') fullName
+ platformDir: (FileDirectory default / '../platforms') fullName
+ excluding:#(BrokenPlugin IA32ABIPluginSimulator SlangTestPlugin TestOSAPlugin
+ FFIPlugin ReentrantARMFFIPlugin ReentrantFFIPlugin ReentrantPPCBEFFIPlugin)!
+
+'From Squeak4.1 of 17 April 2010 [latest update: #9957] on 3 October 2010 at 8:31:56 am'!
+!SmartSyntaxInterpreterPlugin methodsFor: 'accessing' stamp: 'eem 10/3/2010 08:31' prior: 38974204!
+simulator
+ <doNotGenerate>
+ ^simulator! !
+
+----End fileIn of /Users/eliot/Cog/SmartSyntaxInterpreterPlugin-simulator.st----!
+
+VMMaker
+ generate: CoInterpreter
+ to: (FileDirectory default / '../src') fullName
+ platformDir: (FileDirectory default / '../platforms') fullName
+ excluding:#(BrokenPlugin IA32ABIPluginSimulator SlangTestPlugin TestOSAPlugin
+ FFIPlugin ReentrantARMFFIPlugin ReentrantFFIPlugin ReentrantPPCBEFFIPlugin)!
+!CroquetPlugin methodsFor: 'mesh processing' stamp: 'jcg 6/18/2010 14:54' prior: 35393167!
+primitiveOptimizeVertexIndicesForCacheLocality
+ "Given a list of integer indices for rendering a triangle-mesh in indexed-triangles mode, reorganize the indices in-place to provide better vertex cache locality.
+ We use Tom Forsyth's algorithm:
+ http://home.comcast.net/~tom_forsyth/papers/fast_vert_cache_opt.html
+ ... and the MIT-licensed implementation by Michael Georgoulpoulos at:
+ http://code.google.com/p/vcacne/"
+ | indicesOop indices byteSize triCount result |
+ <export: true>
+ <inline: true>
+ <var: #indices type: 'void *'>
+
+ "Get the oop of the IntegerArray containing the indices."
+ (interpreterProxy methodArgumentCount = 1) ifFalse: [^interpreterProxy primitiveFail].
+ indicesOop := interpreterProxy stackObjectValue: 0.
+ interpreterProxy failed ifTrue: [^nil].
+ (interpreterProxy isWords: indicesOop) ifFalse: [^interpreterProxy primitiveFail].
+
+ "Ensure that the number of indices is a multiple of 3."
+ byteSize := interpreterProxy byteSizeOf: indicesOop.
+ triCount := byteSize / 12.
+ (triCount * 12) = byteSize ifFalse: [^interpreterProxy primitiveFail].
+
+ "Get an int* to the indices, and optimize 'em."
+ indices := interpreterProxy firstIndexableField: indicesOop.
+ self touch: indices.
+ interpreterProxy failed ifTrue: [^nil].
+ result := self cCode: 'optimizeVertexIndices((int*)indices, triCount)'.
+ result = 0 "success" ifFalse: [^interpreterProxy primitiveFail].
+ ^interpreterProxy pop: 1.
+
+
+ ! !
+
+CroquetPlugin removeSelector: #primitiveOptimizeVertexIndicesForCacheLocality!
+
+VMMaker
+ generate: CoInterpreter
+ to: (FileDirectory default / '../src') fullName
+ platformDir: (FileDirectory default / '../platforms') fullName
+ excluding:#(BrokenPlugin IA32ABIPluginSimulator SlangTestPlugin TestOSAPlugin
+ FFIPlugin ReentrantARMFFIPlugin ReentrantFFIPlugin ReentrantPPCBEFFIPlugin)!
+
+VMMaker
+ generate: CoInterpreter
+ to: (FileDirectory default / '../src') fullName
+ platformDir: (FileDirectory default / '../platforms') fullName
+ excluding:#(BrokenPlugin IA32ABIPluginSimulator SlangTestPlugin TestOSAPlugin
+ FFIPlugin ReentrantARMFFIPlugin ReentrantFFIPlugin ReentrantPPCBEFFIPlugin
+ NewsqueakIA32ABIPlugin NewsqueakIA32ABIPluginAttic)!
+
+'From Squeak4.1 of 17 April 2010 [latest update: #9957] on 3 October 2010 at 8:44:31 am'!
+!IA32ABIPluginSimulator class methodsFor: 'translation' stamp: 'eem 10/3/2010 08:43'!
+shouldBeTranslated
+ ^false! !
+
+----End fileIn of /Users/eliot/Cog/IA32ABIPluginSimulator class-shouldBeTranslated.st----!
+
+VMMaker
+ generate: CoInterpreter
+ to: (FileDirectory default / '../src') fullName
+ platformDir: (FileDirectory default / '../platforms') fullName
+ excluding:#(BrokenPlugin SlangTestPlugin TestOSAPlugin
+ FFIPlugin ReentrantARMFFIPlugin ReentrantFFIPlugin ReentrantPPCBEFFIPlugin
+ NewsqueakIA32ABIPlugin NewsqueakIA32ABIPluginAttic)!
+
+----QUIT----{3 October 2010 . 8:49:05 am} VMMaker-Squeak4.1.image priorSource: 5398716!
+
+----STARTUP----{3 October 2010 . 9:14:08 am} as /Users/eliot/Cog/oscog/Cog.squeakvm.org/image/VMMaker-Squeak4.1.image!
+
+
+| user pw |
+Utilities setAuthorInitials.
+user := UIManager default request: 'Repository user name'.
+pw := UIManager default requestPassword: 'Monticello password'.
+MCHttpRepository allSubInstancesDo: [ : rep |
+ rep user: user;
+ password: pw ].
+user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
+
+"VMMaker"!
+
+| user pw |
+Utilities setAuthorInitials.
+user := UIManager default request: 'Repository user name'.
+pw := UIManager default requestPassword: 'Monticello password'.
+MCHttpRepository allSubInstancesDo: [ : rep |
+ rep user: user;
+ password: pw ].
+user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
+
+----QUIT----{3 October 2010 . 9:29:23 am} VMMaker-Squeak4.1.image priorSource: 5438592!
+
+----STARTUP----{3 October 2010 . 7:58:04 pm} as /Users/eliot/Cog/oscog/Cog.squeakvm.org/image/VMMaker-Squeak4.1.image!
+
+
+self first ancestors first!
+
+self at: 1 put: self first ancestors first!
+
+| user pw |
+Utilities setAuthorInitials.
+user := UIManager default request: 'Repository user name'.
+pw := UIManager default requestPassword: 'Monticello password'.
+MCHttpRepository allSubInstancesDo: [ : rep |
+ rep user: user;
+ password: pw ].
+user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
+
+"VMMaker"!
+
+| user pw |
+Utilities setAuthorInitials.
+user := UIManager default request: 'Repository user name'.
+pw := UIManager default requestPassword: 'Monticello password'.
+MCHttpRepository allSubInstancesDo: [ : rep |
+ rep user: user;
+ password: pw ].
+user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
+
+VMMaker
+ generate: CoInterpreter
+ to: (FileDirectory default / '../src') fullName
+ platformDir: (FileDirectory default / '../platforms') fullName
+ excluding:#(BrokenPlugin SlangTestPlugin TestOSAPlugin
+ FFIPlugin ReentrantARMFFIPlugin ReentrantFFIPlugin ReentrantPPCBEFFIPlugin
+ NewsqueakIA32ABIPlugin NewsqueakIA32ABIPluginAttic)!
+
+VMMaker
+ generate: StackInterpreter
+ to: (FileDirectory default / '../stacksrc') fullName
+ platformDir: (FileDirectory default / '../platforms') fullName
+ excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name])!
+
+| user pw |
+Utilities setAuthorInitials.
+user := UIManager default request: 'Repository user name'.
+pw := UIManager default requestPassword: 'Monticello password'.
+MCHttpRepository allSubInstancesDo: [ : rep |
+ rep user: user;
+ password: pw ].
+user = 'anon' ifTrue: [MCFileBasedRepository flushAllCaches]!
+
+----QUIT----{3 October 2010 . 8:27:27 pm} VMMaker-Squeak4.1.image priorSource: 5439428!
\ No newline at end of file

Modified: branches/Cog/image/VMMaker-Squeak4.1.image
===================================================================
(Binary files differ)

Modified: branches/Cog/scripts/revertIfEssentiallyUnchanged
===================================================================
--- branches/Cog/scripts/revertIfEssentiallyUnchanged 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/scripts/revertIfEssentiallyUnchanged 2010-10-04 03:39:37 UTC (rev 2315)
@@ -2,6 +2,4 @@
 # Revert the argument if its changes comprise only the generation metadata
 # such as date generated, VMMaker version etc.
 
-# svn diff $1 | grep '^[+-]' | egrep -v ' VMMaker-[a-z][a-z]*\.[0-9][0-9]* uuid:| VMMaker-[a-z][a-z]*\.[0-9][0-9]* \([ie]\)|^-\-\-|^+\+\+'
-
-test -z "`svn diff \"$1\" | grep '^[+-]' | egrep -v ' VMMaker-[a-z][a-z]*\.[0-9][0-9]* uuid:| VMMaker-[a-z][a-z]*\.[0-9][0-9]* \([ie]\)|^-\-\-|^+\+\+'`" && svn revert "$1"
+test -z "`svn diff \"$1\" | grep '^[+-]' | egrep -v ' VMMaker-[a-z][a-z]*\.[0-9][0-9]* uuid:| Qwaq-Plugins-[a-z][a-z]*\.[0-9][0-9]* uuid:| VMMaker-[a-z][a-z]*\.[0-9][0-9]* \([ie]\)| Qwaq-Plugins-[a-z][a-z]*\.[0-9][0-9]* \([ie]\)|^-\-\-|^+\+\+|^[+-]$'`" && svn revert "$1"

Modified: branches/Cog/src/examplePlugins.ext
===================================================================
--- branches/Cog/src/examplePlugins.ext 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/examplePlugins.ext 2010-10-04 03:39:37 UTC (rev 2315)
@@ -31,8 +31,6 @@
 Matrix2x3Plugin \
 MiscPrimitivePlugin \
 Mpeg3Plugin \
-IA32ABI \
-IA32ABI \
 QVMProfileMacSupportPlugin \
 QuicktimePlugin \
 RePlugin \

Modified: branches/Cog/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c
===================================================================
--- branches/Cog/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/AsynchFilePlugin/AsynchFilePlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ SmartSyntaxPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- AsynchFilePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ AsynchFilePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "AsynchFilePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "AsynchFilePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -38,7 +38,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 
 
@@ -69,9 +68,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "AsynchFilePlugin VMMaker-oscog.8 (i)"
+ "AsynchFilePlugin VMMaker-oscog.35 (i)"
 #else
- "AsynchFilePlugin VMMaker-oscog.8 (e)"
+ "AsynchFilePlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 static void * sCOAFfn;
@@ -168,9 +167,9 @@
 EXPORT(sqInt)
 primitiveAsyncFileOpen(void) {
  sqInt fOop;
- AsyncFile *f;
- sqInt fileNameSize;
  sqInt okToOpen;
+ sqInt fileNameSize;
+ AsyncFile *f;
  char *fileName;
  sqInt writeFlag;
  sqInt semaIndex;

Modified: branches/Cog/src/plugins/B2DPlugin/B2DPlugin.c
===================================================================
--- branches/Cog/src/plugins/B2DPlugin/B2DPlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/B2DPlugin/B2DPlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- BalloonEnginePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ BalloonEnginePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "BalloonEnginePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "BalloonEnginePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -37,7 +37,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 #define BEBalloonEngineSize 12
 #define BEBitBltIndex 2
@@ -86,7 +85,7 @@
 #define GBWideWidth 17
 #define GEBaseEdgeSize 10
 #define GEBaseFillSize 4
-#define GEEdgeFillsInvalid 65536
+#define GEEdgeFillsInvalid 0x10000
 #define GEFAlreadyFailed 100
 #define GEFBadPoint 121
 #define GEFBitBltLoadFailed 122
@@ -118,19 +117,19 @@
 #define GEObjectLength 1
 #define GEObjectType 0
 #define GEPrimitiveBezier 6
-#define GEPrimitiveClippedBitmapFill 1024
+#define GEPrimitiveClippedBitmapFill 0x400
 #define GEPrimitiveEdge 2
-#define GEPrimitiveEdgeMask 255
-#define GEPrimitiveFill 256
-#define GEPrimitiveFillMask 65280
+#define GEPrimitiveEdgeMask 0xFF
+#define GEPrimitiveFill 0x100
+#define GEPrimitiveFillMask 0xFF00
 #define GEPrimitiveLine 4
-#define GEPrimitiveLinearGradientFill 512
-#define GEPrimitiveRadialGradientFill 768
-#define GEPrimitiveTypeMask 65535
+#define GEPrimitiveLinearGradientFill 0x200
+#define GEPrimitiveRadialGradientFill 0x300
+#define GEPrimitiveTypeMask 0xFFFF
 #define GEPrimitiveWide 1
 #define GEPrimitiveWideBezier 7
 #define GEPrimitiveWideLine 5
-#define GEPrimitiveWideMask 254
+#define GEPrimitiveWideMask 0xFE
 #define GErrorAETEntry 6
 #define GErrorBadState 2
 #define GErrorFillEntry 5
@@ -173,11 +172,11 @@
 #define GLXDirection 10
 #define GLXIncrement 12
 #define GLYDirection 11
-#define GWAAColorMask 51
+#define GWAAColorMask 0x33
 #define GWAAColorShift 50
 #define GWAAHalfPixel 53
 #define GWAALevel 48
-#define GWAAScanMask 52
+#define GWAAScanMask 0x34
 #define GWAAShift 49
 #define GWAETStart 13
 #define GWAETUsed 14
@@ -754,9 +753,9 @@
 static void * loadBBFn;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "B2DPlugin VMMaker-oscog.8 (i)"
+ "B2DPlugin VMMaker-oscog.35 (i)"
 #else
- "B2DPlugin VMMaker-oscog.8 (e)"
+ "B2DPlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 static int* objBuffer;
@@ -1148,7 +1147,7 @@
  srcIndex = workBuffer[GWAETUsed];
  dstIndex = (workBuffer[GWAETUsed]) + nSlots;
  for (i = 1; i <= (workBuffer[GWAETUsed]); i += 1) {
- aetBuffer[dstIndex -= 1] = (aetBuffer[srcIndex -= 1]);
+ aetBuffer[(dstIndex -= 1)] = (aetBuffer[(srcIndex -= 1)]);
  }
  }
  aetBuffer += nSlots;
@@ -1226,7 +1225,7 @@
  srcIndex = workBuffer[GWGETUsed];
  dstIndex = (workBuffer[GWGETUsed]) + nSlots;
  for (i = 1; i <= (workBuffer[GWGETUsed]); i += 1) {
- getBuffer[dstIndex -= 1] = (getBuffer[srcIndex -= 1]);
+ getBuffer[(dstIndex -= 1)] = (getBuffer[(srcIndex -= 1)]);
  }
  }
  getBuffer += nSlots;
@@ -1450,8 +1449,8 @@
  if (bmDepth == 32) {
  value = (((int*) bits))[(bmRaster * yp) + xp];
  if ((value != 0)
- && ((value & 4278190080U) == 0)) {
- value = value | 4278190080U;
+ && ((value & 4278190080UL) == 0)) {
+ value = value | 4278190080UL;
  }
  return uncheckedTransformColor(value);
  }
@@ -2706,8 +2705,8 @@
  if (bmDepth == 32) {
  value = (((int*) bits))[(bmRaster * yp) + xp];
  if ((value != 0)
- && ((value & 4278190080U) == 0)) {
- value = value | 4278190080U;
+ && ((value & 4278190080UL) == 0)) {
+ value = value | 4278190080UL;
  }
  fillValue = uncheckedTransformColor(value);
  goto l3;
@@ -2761,7 +2760,7 @@
  dt += dtX;
  x += 1;
  }
- cMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160U;
+ cMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160UL;
  cShift = workBuffer[GWAAShift];
  while (x < lastPixel) {
  if (tileFlag) {
@@ -2830,8 +2829,8 @@
  if (bmDepth1 == 32) {
  value1 = (((int*) bits))[(bmRaster1 * yp) + xp];
  if ((value1 != 0)
- && ((value1 & 4278190080U) == 0)) {
- value1 = value1 | 4278190080U;
+ && ((value1 & 4278190080UL) == 0)) {
+ value1 = value1 | 4278190080UL;
  }
  fillValue = uncheckedTransformColor(value1);
  goto l6;
@@ -2954,8 +2953,8 @@
  if (bmDepth2 == 32) {
  value2 = (((int*) bits))[(bmRaster2 * yp) + xp];
  if ((value2 != 0)
- && ((value2 & 4278190080U) == 0)) {
- value2 = value2 | 4278190080U;
+ && ((value2 & 4278190080UL) == 0)) {
+ value2 = value2 | 4278190080UL;
  }
  fillValue = uncheckedTransformColor(value2);
  goto l9;
@@ -3038,7 +3037,7 @@
  bitX = -1;
  if ((workBuffer[GWAALevel]) == 1) {
  while (x0 < x1) {
- fillValue = (((int *) bits))[bitX += 1];
+ fillValue = (((int *) bits))[(bitX += 1)];
  spanBuffer[x0] = fillValue;
  x0 += 1;
  }
@@ -3052,7 +3051,7 @@
  baseShift = workBuffer[GWAAShift];
  while (x0 < x1) {
  x = ((usqInt) x0) >> baseShift;
- fillValue = (((int *) bits))[bitX += 1];
+ fillValue = (((int *) bits))[(bitX += 1)];
  fillValue = ((usqInt) (fillValue & colorMask)) >> colorShift;
  spanBuffer[x] = ((spanBuffer[x]) + fillValue);
  x0 += 1;
@@ -3181,8 +3180,8 @@
  if (bmDepth == 32) {
  value = (((int*) bits))[(bmRaster * yp) + xp];
  if ((value != 0)
- && ((value & 4278190080U) == 0)) {
- value = value | 4278190080U;
+ && ((value & 4278190080UL) == 0)) {
+ value = value | 4278190080UL;
  }
  fillValue = uncheckedTransformColor(value);
  goto l3;
@@ -3282,7 +3281,7 @@
  }
  }
  if (x < lastPixel) {
- colorMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160U;
+ colorMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160UL;
  pv32 = ((usqInt) (pixelValue32 & colorMask)) >> (workBuffer[GWAAShift]);
  while (x < lastPixel) {
  idx = ((usqInt) x) >> baseShift;
@@ -3415,7 +3414,7 @@
  }
  rampIndex = ((sqInt) ds >> 16);
  }
- colorMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160U;
+ colorMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160UL;
  colorShift = workBuffer[GWAAShift];
  while ((x < lastPixel)
  && ((rampIndex < rampSize)
@@ -3737,7 +3736,7 @@
  }
  }
  if (x < lastPixel) {
- colorMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160U;
+ colorMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160UL;
  colorShift = workBuffer[GWAAShift];
  rampValue = (((int *) ramp))[rampIndex];
  rampValue = ((usqInt) (rampValue & colorMask)) >> colorShift;
@@ -4109,7 +4108,7 @@
  }
  if ((x < lastPixel)
  && (lastLength < length2)) {
- colorMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160U;
+ colorMask = (((usqInt) (workBuffer[GWAAColorMask])) >> (workBuffer[GWAAShift])) | 4042322160UL;
  colorShift = workBuffer[GWAAShift];
  rampValue = (((int *) ramp))[rampIndex];
  rampValue = ((usqInt) (rampValue & colorMask)) >> colorShift;
@@ -4275,7 +4274,7 @@
  if (x0 >= x1) {
  return 0;
  }
- if ((fill & 4278190080U) != 0) {
+ if ((fill & 4278190080UL) != 0) {
  /* begin fillColorSpan:from:to: */
  if (!((workBuffer[GWAALevel]) == 1)) {
  fillColorSpanAAx0x1(fill, x0, x1);
@@ -5069,22 +5068,22 @@
 
 static sqInt
 isFillColor(sqInt fill) {
- return (fill & 4278190080U) != 0;
+ return (fill & 4278190080UL) != 0;
 }
 
 static sqInt
 isFillOkay(sqInt fill) {
  return (fill == 0)
- || (((fill & 4278190080U) != 0)
+ || (((fill & 4278190080UL) != 0)
  || (((fill >= 0)
  && (fill < objUsed))
- && (((fill & 4278190080U) != 0)
+ && (((fill & 4278190080UL) != 0)
  || ((((objBuffer[fill + GEObjectType]) & GEPrimitiveTypeMask) & GEPrimitiveFillMask) != 0))));
 }
 
 static sqInt
 isFill(sqInt fill) {
- return ((fill & 4278190080U) != 0)
+ return ((fill & 4278190080UL) != 0)
  || ((((objBuffer[fill + GEObjectType]) & GEPrimitiveTypeMask) & GEPrimitiveFillMask) != 0);
 }
 
@@ -10706,17 +10705,17 @@
  workBuffer[GWAALevel] = aaLevel;
  if (aaLevel == 1) {
  workBuffer[GWAAShift] = 0;
- workBuffer[GWAAColorMask] = 4294967295U;
+ workBuffer[GWAAColorMask] = 4294967295UL;
  workBuffer[GWAAScanMask] = 0;
  }
  if (aaLevel == 2) {
  workBuffer[GWAAShift] = 1;
- workBuffer[GWAAColorMask] = 4244438268U;
+ workBuffer[GWAAColorMask] = 4244438268UL;
  workBuffer[GWAAScanMask] = 1;
  }
  if (aaLevel == 4) {
  workBuffer[GWAAShift] = 2;
- workBuffer[GWAAColorMask] = 4042322160U;
+ workBuffer[GWAAColorMask] = 4042322160UL;
  workBuffer[GWAAScanMask] = 3;
  }
  workBuffer[GWAAColorShift] = ((workBuffer[GWAAShift]) * 2);
@@ -12144,7 +12143,7 @@
     float *transform;
 
  if (!((fillIndex == 0)
- || ((fillIndex & 4278190080U) != 0))) {
+ || ((fillIndex & 4278190080UL) != 0))) {
  return fillIndex;
  }
  b = fillIndex & 255;

Modified: branches/Cog/src/plugins/BitBltPlugin/BitBltPlugin.c
===================================================================
--- branches/Cog/src/plugins/BitBltPlugin/BitBltPlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/BitBltPlugin/BitBltPlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.18 uuid: 66fabf9e-52f4-43aa-a0fc-023e1c0e686e
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- BitBltSimulation VMMaker-oscog.18 uuid: 66fabf9e-52f4-43aa-a0fc-023e1c0e686e
+ BitBltSimulation VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "BitBltSimulation VMMaker-oscog.18 uuid: 66fabf9e-52f4-43aa-a0fc-023e1c0e686e " __DATE__ ;
+static char __buildInfo[] = "BitBltSimulation VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -37,9 +37,8 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
-#define AllOnes 4294967295U
+#define AllOnes 0xFFFFFFFFUL
 #define AlphaIndex 3
 #define BBClipHeightIndex 13
 #define BBClipWidthIndex 12
@@ -63,7 +62,7 @@
 #define ColorMapIndexedPart 4
 #define ColorMapNewStyle 8
 #define ColorMapPresent 1
-#define FixedPt1 16384
+#define FixedPt1 0x4000
 #define FormBitsIndex 0
 #define FormDepthIndex 3
 #define FormHeightIndex 2
@@ -266,9 +265,9 @@
 };
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "BitBltPlugin VMMaker-oscog.18 (i)"
+ "BitBltPlugin VMMaker-oscog.35 (i)"
 #else
- "BitBltPlugin VMMaker-oscog.18 (e)"
+ "BitBltPlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 static sqInt noHalftone;
@@ -644,7 +643,7 @@
 
  /* Mix colors */
 
- destWord = ((((usqInt) (destWord & 31744) << 9)) | (((usqInt) (destWord & 992) << 6))) | ((((usqInt) (destWord & 31) << 3)) | 4278190080U);
+ destWord = ((((usqInt) (destWord & 31744) << 9)) | (((usqInt) (destWord & 992) << 6))) | ((((usqInt) (destWord & 31) << 3)) | 4278190080UL);
 
  /* And dither */
 
@@ -905,14 +904,14 @@
  }
  else {
  srcShift -= 8;
- dstMask = (((usqInt) dstMask) >> 8) | 4278190080U;
+ dstMask = (((usqInt) dstMask) >> 8) | 4278190080UL;
  }
  }
  else {
  if (srcShift == 32) {
  dstIndex += 4;
  srcShift = 0;
- dstMask = 4294967040U;
+ dstMask = 4294967040UL;
  }
  else {
  srcShift += 8;
@@ -1969,7 +1968,7 @@
  /* adjust source pix index */
 
  dstShift1 += dstShiftInc;
- if (!((((srcShift1 += srcShiftInc)) & 4294967264U) == 0)) {
+ if (!((((srcShift1 += srcShiftInc)) & 4294967264UL) == 0)) {
  if (sourceMSB) {
  srcShift1 += 32;
  }
@@ -2015,7 +2014,7 @@
  /* adjust source pix index */
 
  dstShift1 += dstShiftInc;
- if (!((((srcShift1 += srcShiftInc)) & 4294967264U) == 0)) {
+ if (!((((srcShift1 += srcShiftInc)) & 4294967264UL) == 0)) {
  if (sourceMSB) {
  srcShift1 += 32;
  }
@@ -2491,10 +2490,10 @@
  if (destinationWord == 0) {
  return 0;
  }
- if (!((destinationWord & 4278190080U) == 0)) {
+ if (!((destinationWord & 4278190080UL) == 0)) {
  return destinationWord;
  }
- return destinationWord | (sourceWord & 4278190080U);
+ return destinationWord | (sourceWord & 4278190080UL);
 }
 
 
@@ -2667,7 +2666,7 @@
  && (((masks[RedIndex]) == 16711680)
  && (((masks[GreenIndex]) == 65280)
  && (((masks[BlueIndex]) == 255)
- && ((masks[AlphaIndex]) == 4278190080U)))))))) {
+ && ((masks[AlphaIndex]) == 4278190080UL)))))))) {
  return 1;
  }
  return 0;
@@ -4214,7 +4213,7 @@
  /* adjust source pix index */
 
  dstShift += dstShiftInc;
- if (!((((srcShift += srcShiftInc)) & 4294967264U) == 0)) {
+ if (!((((srcShift += srcShiftInc)) & 4294967264UL) == 0)) {
  if (sourceMSB) {
  srcShift += 32;
  }
@@ -4260,7 +4259,7 @@
  /* adjust source pix index */
 
  dstShift += dstShiftInc;
- if (!((((srcShift += srcShiftInc)) & 4294967264U) == 0)) {
+ if (!((((srcShift += srcShiftInc)) & 4294967264UL) == 0)) {
  if (sourceMSB) {
  srcShift += 32;
  }

Modified: branches/Cog/src/plugins/BochsIA32Plugin/BochsIA32Plugin.c
===================================================================
--- branches/Cog/src/plugins/BochsIA32Plugin/BochsIA32Plugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/BochsIA32Plugin/BochsIA32Plugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,5 +1,5 @@
 /* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ SmartSyntaxPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
  BochsIA32Plugin Cog-eem.40 uuid: 1348aa2c-fc34-4398-84be-5f3aac98257d
  */
@@ -38,7 +38,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 #define BaseHeaderSize 4
 #define BytesPerOop 4
@@ -179,8 +178,8 @@
 primitiveErrorAndLog(void) {
  char *logObjData;
  sqInt resultObj;
- sqInt logLen;
  char *log;
+ sqInt logLen;
  sqInt logObj;
 
  log = getlog((&logLen));

Modified: branches/Cog/src/plugins/CroquetPlugin/CroquetPlugin.c
===================================================================
--- branches/Cog/src/plugins/CroquetPlugin/CroquetPlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/CroquetPlugin/CroquetPlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- CroquetPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ CroquetPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "CroquetPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "CroquetPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -38,7 +38,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 
 
@@ -74,9 +73,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "CroquetPlugin VMMaker-oscog.8 (i)"
+ "CroquetPlugin VMMaker-oscog.35 (i)"
 #else
- "CroquetPlugin VMMaker-oscog.8 (e)"
+ "CroquetPlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 
@@ -179,7 +178,7 @@
  dst[c23] = (0.0 - ((m11 * m23) - (m13 * m21)));
  dst[c33] = ((m11 * m22) - (m12 * m21));
  interpreterProxy->pop(argc + 1);
- interpreterProxy->push(dstOop);
+ return interpreterProxy->push(dstOop);
 }
 
 
@@ -264,7 +263,7 @@
  interpreterProxy->storePointerofObjectwithValue(0, ptOop, xOop);
  interpreterProxy->storePointerofObjectwithValue(1, ptOop, yOop);
  interpreterProxy->pop((interpreterProxy->methodArgumentCount()) + 1);
- interpreterProxy->push(ptOop);
+ return interpreterProxy->push(ptOop);
 }
 
 
@@ -307,7 +306,7 @@
  m33 = src[10];
  det = ((m11 * ((m22 * m33) - (m23 * m32))) + (m12 * ((m23 * m31) - (m21 * m33)))) + (m13 * ((m21 * m32) - (m22 * m31)));
  interpreterProxy->pop(argc + 1);
- interpreterProxy->pushFloat(det);
+ return interpreterProxy->pushFloat(det);
 }
 
 
@@ -337,7 +336,7 @@
  return interpreterProxy->primitiveFail();
  }
  interpreterProxy->pop((interpreterProxy->methodArgumentCount()) + 1);
- interpreterProxy->pushBool(1);
+ return interpreterProxy->pushBool(1);
 }
 
 
@@ -418,6 +417,7 @@
  rcvr[(i * 4) + j] = (((float) ((x[i])[j])));
  }
  }
+ return null;
 }
 
 
@@ -523,7 +523,7 @@
  dst[c24] = (0.0 - (((x * m21) + (y * m22)) + (z * m23)));
  dst[c34] = (0.0 - (((x * m31) + (y * m32)) + (z * m33)));
  interpreterProxy->pop(argc + 1);
- interpreterProxy->push(dstOop);
+ return interpreterProxy->push(dstOop);
 }
 
 
@@ -553,7 +553,7 @@
  buffer = interpreterProxy->firstIndexableField(bufOop);
  MD5Transform(hash, buffer);
  interpreterProxy->pop((interpreterProxy->methodArgumentCount()) + 1);
- interpreterProxy->push(bufOop);
+ return interpreterProxy->push(bufOop);
 }
 
 EXPORT(sqInt)
@@ -607,7 +607,7 @@
  dst[7] = (((float) (0.0 - ry)));
  dst[11] = (((float) (0.0 - rz)));
  interpreterProxy->pop(1);
- interpreterProxy->push(dstOop);
+ return interpreterProxy->push(dstOop);
 }
 
 EXPORT(sqInt)
@@ -650,7 +650,7 @@
  vertex[1] = (((float) ry));
  vertex[2] = (((float) rz));
  interpreterProxy->pop(2);
- interpreterProxy->push(v3Oop);
+ return interpreterProxy->push(v3Oop);
 }
 
 
@@ -701,7 +701,7 @@
  m11 += 4;
  m31 += 4;
  }
- interpreterProxy->pop(3);
+ return interpreterProxy->pop(3);
 }
 
 EXPORT(sqInt)
@@ -759,7 +759,7 @@
  vertex[2] = (((float) (rz * rw)));
  }
  interpreterProxy->pop(2);
- interpreterProxy->push(v3Oop);
+ return interpreterProxy->push(v3Oop);
 }
 
 EXPORT(sqInt)
@@ -803,7 +803,7 @@
  dst[13] = (src[7]);
  dst[14] = (src[11]);
  interpreterProxy->pop(1);
- interpreterProxy->push(dstOop);
+ return interpreterProxy->push(dstOop);
 }
 
 
@@ -831,7 +831,7 @@
  return interpreterProxy->primitiveFail();
  }
  interpreterProxy->pop(6);
- interpreterProxy->pushBool(result);
+ return interpreterProxy->pushBool(result);
 }
 
 
@@ -924,6 +924,7 @@
  m1 += 4;
  m3 += 4;
  }
+ return null;
 }
 
 

Modified: branches/Cog/src/plugins/DSAPrims/DSAPrims.c
===================================================================
--- branches/Cog/src/plugins/DSAPrims/DSAPrims.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/DSAPrims/DSAPrims.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- DSAPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ DSAPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "DSAPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "DSAPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -37,7 +37,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 
 
@@ -71,9 +70,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "DSAPrims VMMaker-oscog.8 (i)"
+ "DSAPrims VMMaker-oscog.35 (i)"
 #else
- "DSAPrims VMMaker-oscog.8 (e)"
+ "DSAPrims VMMaker-oscog.35 (e)"
 #endif
 ;
 static sqInt remainderDigitCount;
@@ -557,7 +556,7 @@
  a = tmp;
  }
  for (i = 40; i <= 59; i += 1) {
- tmp = (((2400959708U + (((b & c) | (b & d)) | (c & d))) + ((a << 5) | (((usqInt) a) >> (32 - 5)))) + e) + (bufPtr[i]);
+ tmp = (((2400959708UL + (((b & c) | (b & d)) | (c & d))) + ((a << 5) | (((usqInt) a) >> (32 - 5)))) + e) + (bufPtr[i]);
  e = d;
  d = c;
  c = (b << 30) | (((usqInt) b) >> (32 - 30));
@@ -565,7 +564,7 @@
  a = tmp;
  }
  for (i = 60; i <= 79; i += 1) {
- tmp = (((3395469782U + ((b ^ c) ^ d)) + ((a << 5) | (((usqInt) a) >> (32 - 5)))) + e) + (bufPtr[i]);
+ tmp = (((3395469782UL + ((b ^ c) ^ d)) + ((a << 5) | (((usqInt) a) >> (32 - 5)))) + e) + (bufPtr[i]);
  e = d;
  d = c;
  c = (b << 30) | (((usqInt) b) >> (32 - 30));
@@ -608,7 +607,7 @@
  bigIntPtr = interpreterProxy->firstIndexableField(arg);
  i = interpreterProxy->stSizeOf(arg);
  while ((i > 0)
- && ((bigIntPtr[i -= 1]) == 0)) {
+ && ((bigIntPtr[(i -= 1)]) == 0)) {
  }
  interpreterProxy->pop(1);
  interpreterProxy->pushInteger(i + 1);

Modified: branches/Cog/src/plugins/FilePlugin/FilePlugin.c
===================================================================
--- branches/Cog/src/plugins/FilePlugin/FilePlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/FilePlugin/FilePlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.12 uuid: a34fa6af-c3a0-453e-8450-8525342057ac
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- FilePlugin VMMaker-oscog.12 uuid: a34fa6af-c3a0-453e-8450-8525342057ac
+ FilePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "FilePlugin VMMaker-oscog.12 uuid: a34fa6af-c3a0-453e-8450-8525342057ac " __DATE__ ;
+static char __buildInfo[] = "FilePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -38,12 +38,15 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 #define DirBadPath 2
 #define DirNoMoreEntries 1
+#define PrimErrBadArgument 3
+#define PrimErrBadIndex 4
 #define PrimErrNoMemory 9
+#define PrimErrObjectMayMove 14
 #define PrimErrUnsupported 7
+#define PrimNoErr 0
 
 
 /*** Function Prototypes ***/
@@ -94,9 +97,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "FilePlugin VMMaker-oscog.12 (i)"
+ "FilePlugin VMMaker-oscog.35 (i)"
 #else
- "FilePlugin VMMaker-oscog.12 (e)"
+ "FilePlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 static void * sCCPfn;
@@ -717,47 +720,48 @@
 EXPORT(sqInt)
 primitiveFileRead(void) {
     sqInt array;
-    char *arrayIndex;
-    size_t byteSize;
     sqInt bytesRead;
     size_t count;
+    size_t elementSize;
     SQFile *file;
     sqInt objectPointer;
+    sqInt retryCount;
     size_t startIndex;
 
+ retryCount = 0;
  count = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(0));
  startIndex = interpreterProxy->positive32BitValueOf(interpreterProxy->stackValue(1));
- array = interpreterProxy->stackValue(2);
- /* begin fileValueOf: */
- objectPointer = interpreterProxy->stackValue(3);
- if (!((interpreterProxy->isBytes(objectPointer))
- && ((interpreterProxy->byteSizeOf(objectPointer)) == (fileRecordSize())))) {
- interpreterProxy->primitiveFail();
- file = null;
- goto l1;
+ while (1) {
+ array = interpreterProxy->stackValue(2);
+ /* begin fileValueOf: */
+ objectPointer = interpreterProxy->stackValue(3);
+ if (!((interpreterProxy->isBytes(objectPointer))
+ && ((interpreterProxy->byteSizeOf(objectPointer)) == (fileRecordSize())))) {
+ interpreterProxy->primitiveFail();
+ file = null;
+ goto l1;
+ }
+ file = interpreterProxy->firstIndexableField(objectPointer);
+ l1: /* end fileValueOf: */;
+ if ((interpreterProxy->failed())
+ || (!(interpreterProxy->isWordsOrBytes(array)))) {
+ return interpreterProxy->primitiveFailFor(PrimErrBadArgument);
+ }
+ elementSize = (interpreterProxy->isWords(array)
+ ? 4
+ : 1);
+ if (!((startIndex >= 1)
+ && (((startIndex + count) - 1) <= (interpreterProxy->slotSizeOf(array))))) {
+ return interpreterProxy->primitiveFailFor(PrimErrBadIndex);
+ }
+ bytesRead = sqFileReadIntoAt(file, count * elementSize, ((char *) (interpreterProxy->firstIndexableField(array))), (startIndex - 1) * elementSize);
+ if (!(((interpreterProxy->primitiveFailureCode()) == PrimErrObjectMayMove)
+ && (((retryCount += 1)) <= 2))) break;
+ interpreterProxy->tenuringIncrementalGC();
+ interpreterProxy->primitiveFailFor(PrimNoErr);
  }
- file = interpreterProxy->firstIndexableField(objectPointer);
-l1: /* end fileValueOf: */;
- if (!(interpreterProxy->isWordsOrBytes(array))) {
- return interpreterProxy->primitiveFail();
- }
- if (interpreterProxy->isWords(array)) {
- byteSize = 4;
- }
- else {
- byteSize = 1;
- }
- if (!((startIndex >= 1)
- && (((startIndex + count) - 1) <= (interpreterProxy->slotSizeOf(array))))) {
- return interpreterProxy->primitiveFail();
- }
-
- /* Note: adjust startIndex for zero-origin indexing */
-
- arrayIndex = interpreterProxy->firstIndexableField(array);
- bytesRead = sqFileReadIntoAt(file, count * byteSize, arrayIndex, (startIndex - 1) * byteSize);
  if (!(interpreterProxy->failed())) {
- interpreterProxy->popthenPush(5, (((bytesRead / byteSize) << 1) | 1));
+ interpreterProxy->popthenPush(5, (((bytesRead / elementSize) << 1) | 1));
  }
 }
 
@@ -893,12 +897,6 @@
  memcpy(interpreterProxy->firstIndexableField(result), (&(fileRecords[index])), fileRecordSize());
  }
  }
-
-#if COGMTVM
- interpreterProxy->fullGC();
-
-#endif /* COGMTVM */
-;
  result = interpreterProxy->popRemappableOop();
  interpreterProxy->popthenPush(1, result);
 }

Modified: branches/Cog/src/plugins/GeniePlugin/GeniePlugin.c
===================================================================
--- branches/Cog/src/plugins/GeniePlugin/GeniePlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/GeniePlugin/GeniePlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ SmartSyntaxPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- GeniePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ GeniePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "GeniePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "GeniePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -37,7 +37,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 
 
@@ -64,9 +63,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "GeniePlugin v2.0 26 May 2010 VMMaker-oscog.8 (i)"
+ "GeniePlugin v2.0 3 October 2010 VMMaker-oscog.35 (i)"
 #else
- "GeniePlugin v2.0 26 May 2010 VMMaker-oscog.8 (e)"
+ "GeniePlugin v2.0 3 October 2010 VMMaker-oscog.35 (e)"
 #endif
 ;
 
@@ -76,12 +75,12 @@
 
 static sqInt
 cSquaredDistanceFromto(int *   aPoint, int *   bPoint) {
+ sqInt yDiff;
  sqInt aPointX;
  sqInt bPointX;
- sqInt xDiff;
  sqInt aPointY;
  sqInt bPointY;
- sqInt yDiff;
+ sqInt xDiff;
 
  aPointX = aPoint[0];
  aPointY = aPoint[1];

Modified: branches/Cog/src/plugins/InternetConfigPlugin/InternetConfigPlugin.c
===================================================================
--- branches/Cog/src/plugins/InternetConfigPlugin/InternetConfigPlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/InternetConfigPlugin/InternetConfigPlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ SmartSyntaxPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- InternetConfigPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ InternetConfigPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "InternetConfigPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "InternetConfigPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -38,7 +38,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 
 
@@ -63,9 +62,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "InternetConfigPlugin VMMaker-oscog.8 (i)"
+ "InternetConfigPlugin VMMaker-oscog.35 (i)"
 #else
- "InternetConfigPlugin VMMaker-oscog.8 (e)"
+ "InternetConfigPlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 
@@ -111,8 +110,8 @@
  sqInt oop;
  char *ptr;
  sqInt keyLength;
- sqInt i;
  char creator[8];
+ sqInt i;
  char *aFileName;
 
  interpreterProxy->success(interpreterProxy->isBytes(interpreterProxy->stackValue(0)));

Modified: branches/Cog/src/plugins/JPEGReaderPlugin/JPEGReaderPlugin.c
===================================================================
--- branches/Cog/src/plugins/JPEGReaderPlugin/JPEGReaderPlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/JPEGReaderPlugin/JPEGReaderPlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- JPEGReaderPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ JPEGReaderPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "JPEGReaderPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "JPEGReaderPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -37,7 +37,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 #define BlockWidthIndex 5
 #define BlueIndex 2
@@ -48,7 +47,7 @@
 #define DCTSize2 64
 #define FIXn0n298631336 2446
 #define FIXn0n34414 22554
-#define FIXn0n390180644 3196
+#define FIXn0n390180644 0xC7C
 #define FIXn0n541196100 4433
 #define FIXn0n71414 46802
 #define FIXn0n765366865 6270
@@ -71,8 +70,8 @@
 #define MCUWidthIndex 8
 #define MinComponentSize 11
 #define Pass1Bits 2
-#define Pass1Div 2048
-#define Pass2Div 262144
+#define Pass1Div 0x800
+#define Pass2Div 0x40000
 #define PriorDCValueIndex 10
 #define RedIndex 0
 #define SampleOffset 127
@@ -147,9 +146,9 @@
 static sqInt jsReadLimit;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "JPEGReaderPlugin VMMaker-oscog.8 (i)"
+ "JPEGReaderPlugin VMMaker-oscog.35 (i)"
 #else
- "JPEGReaderPlugin VMMaker-oscog.8 (e)"
+ "JPEGReaderPlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 static int *residuals;
@@ -271,7 +270,7 @@
  residuals[GreenIndex] = (y & ditherMask);
  y = y & (MaxSample - ditherMask);
  y = ((y < 1) ? 1 : y);
- jpegBits[i] = (((4278190080U + (y << 16)) + (y << 8)) + y);
+ jpegBits[i] = (((4278190080UL + (y << 16)) + (y << 8)) + y);
  }
 }
 
@@ -402,7 +401,7 @@
  residuals[BlueIndex] = (blue & ditherMask);
  blue = blue & (MaxSample - ditherMask);
  blue = ((blue < 1) ? 1 : blue);
- jpegBits[i] = (((4278190080U + (((usqInt) red << 16))) + (((usqInt) green << 8))) + blue);
+ jpegBits[i] = (((4278190080UL + (((usqInt) red << 16))) + (((usqInt) green << 8))) + blue);
  }
 }
 
@@ -1040,7 +1039,7 @@
  residuals[GreenIndex] = (y & ditherMask);
  y = y & (MaxSample - ditherMask);
  y = ((y < 1) ? 1 : y);
- jpegBits[i] = (((4278190080U + (y << 16)) + (y << 8)) + y);
+ jpegBits[i] = (((4278190080UL + (y << 16)) + (y << 8)) + y);
  }
  interpreterProxy->pop(4);
 }
@@ -1222,7 +1221,7 @@
  residuals[BlueIndex] = (blue & ditherMask);
  blue = blue & (MaxSample - ditherMask);
  blue = ((blue < 1) ? 1 : blue);
- jpegBits[i] = (((4278190080U + (((usqInt) red << 16))) + (((usqInt) green << 8))) + blue);
+ jpegBits[i] = (((4278190080UL + (((usqInt) red << 16))) + (((usqInt) green << 8))) + blue);
  }
  interpreterProxy->pop(4);
 }

Modified: branches/Cog/src/plugins/LargeIntegers/LargeIntegers.c
===================================================================
--- branches/Cog/src/plugins/LargeIntegers/LargeIntegers.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/LargeIntegers/LargeIntegers.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ SmartSyntaxPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- LargeIntegersPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ LargeIntegersPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "LargeIntegersPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "LargeIntegersPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -37,7 +37,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 
 
@@ -123,9 +122,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "LargeIntegers v1.5 VMMaker-oscog.8 (i)"
+ "LargeIntegers v1.5 VMMaker-oscog.35 (i)"
 #else
- "LargeIntegers v1.5 VMMaker-oscog.8 (e)"
+ "LargeIntegers v1.5 VMMaker-oscog.35 (e)"
 #endif
 ;
 static const int  orOpIndex = 1;
@@ -147,6 +146,7 @@
  sqInt stop;
  sqInt mask;
  sqInt ix;
+ unsigned char *pointer;
 
  /* missing DebugCode */;
  if ((start < 1) || (stopArg < 1)) {
@@ -169,7 +169,7 @@
  goto l1;
  }
  else {
- digit = ((interpreterProxy->stObjectat(magnitude, firstByteIx)) >> 1);
+ digit = ((pointer = interpreterProxy->firstIndexableField(magnitude)))[firstByteIx - 1];
  goto l1;
  }
  l1: /* end digitOfBytes:at: */;
@@ -242,8 +242,8 @@
 static sqInt
 bytesgrowTo(sqInt aBytesObject, sqInt newLen) {
  sqInt oldLen;
+ sqInt newBytes;
  sqInt copyLen;
- sqInt newBytes;
 
  interpreterProxy->pushRemappableOop(aBytesObject);
  newBytes = interpreterProxy->instantiateClassindexableSize(interpreterProxy->fetchClassOf(aBytesObject), newLen);
@@ -267,10 +267,10 @@
 
 static sqInt
 bytesLshift(sqInt aBytesOop, sqInt shiftCount) {
+ sqInt highBit;
+ sqInt newBytes;
+ sqInt oldLen;
  sqInt newLen;
- sqInt oldLen;
- sqInt newBytes;
- sqInt highBit;
  unsigned char *  pFrom;
  unsigned char *  pTo;
  sqInt carry;
@@ -357,6 +357,8 @@
  sqInt j;
  sqInt digit1;
  sqInt x1;
+ unsigned char *pointer;
+ unsigned char *pointer1;
 
  n = 0 - anInteger;
  x = 0;
@@ -369,7 +371,7 @@
  goto l2;
  }
  else {
- digit = ((interpreterProxy->stObjectat(aBytesOop, i)) >> 1);
+ digit = ((pointer1 = interpreterProxy->firstIndexableField(aBytesOop)))[i - 1];
  goto l2;
  }
 l2: /* end digitOfBytes:at: */;
@@ -386,7 +388,7 @@
  goto l1;
  }
  else {
- digit = ((interpreterProxy->stObjectat(aBytesOop, i)) >> 1);
+ digit = ((pointer = interpreterProxy->firstIndexableField(aBytesOop)))[i - 1];
  goto l1;
  }
  l1: /* end digitOfBytes:at: */;
@@ -1180,6 +1182,7 @@
  sqInt l;
  sqInt secondLen;
  sqInt firstLen;
+ unsigned char *pointer;
  unsigned char *  pDiv;
  sqInt divLen;
  unsigned char *  pRem;
@@ -1221,7 +1224,7 @@
  interpreterProxy->stObjectatput(result,2,firstInteger);
  return result;
  }
- d = 8 - (cHighBit(((interpreterProxy->stObjectat(secondInteger, secondLen)) >> 1)));
+ d = 8 - (cHighBit(((pointer = interpreterProxy->firstIndexableField(secondInteger)))[secondLen - 1]));
  interpreterProxy->pushRemappableOop(firstInteger);
  div = bytesLshift(secondInteger, d);
  div = bytesOrIntgrowTo(div, (digitLength(div)) + 1);
@@ -1554,16 +1557,20 @@
 
 static sqInt
 digitOfBytesat(sqInt aBytesOop, sqInt ix) {
+ unsigned char *pointer;
+
  if (ix > (interpreterProxy->slotSizeOf(aBytesOop))) {
  return 0;
  }
  else {
- return ((interpreterProxy->stObjectat(aBytesOop, ix)) >> 1);
+ return ((pointer = interpreterProxy->firstIndexableField(aBytesOop)))[ix - 1];
  }
 }
 
 static sqInt
 digitOfat(sqInt oop, sqInt ix) {
+ unsigned char *pointer;
+
  if ((oop & 1)) {
  return cDigitOfCSIat((oop >> 1), ix);
  }
@@ -1573,7 +1580,7 @@
  return 0;
  }
  else {
- return ((interpreterProxy->stObjectat(oop, ix)) >> 1);
+ return ((pointer = interpreterProxy->firstIndexableField(oop)))[ix - 1];
  }
  }
 }
@@ -1723,11 +1730,15 @@
 
 static sqInt
 isNormalized(sqInt anInteger) {
- sqInt ix;
  sqInt len;
  sqInt sLen;
  sqInt minVal;
+ sqInt ix;
  sqInt maxVal;
+ unsigned char *pointer;
+ unsigned char *pointer1;
+ unsigned char *pointer2;
+ unsigned char *pointer3;
 
  if ((anInteger & 1)) {
  return 1;
@@ -1761,7 +1772,7 @@
  if (len == 0) {
  return 0;
  }
- if ((((interpreterProxy->stObjectat(anInteger, len)) >> 1)) == 0) {
+ if ((((pointer = interpreterProxy->firstIndexableField(anInteger)))[len - 1]) == 0) {
  return 0;
  }
 
@@ -1780,7 +1791,7 @@
  /* all bytes of maxVal but the highest one are just FF's */
 
  maxVal = 1073741823;
- return (((interpreterProxy->stObjectat(anInteger, sLen)) >> 1)) > (cDigitOfCSIat(maxVal, sLen));
+ return (((pointer1 = interpreterProxy->firstIndexableField(anInteger)))[sLen - 1]) > (cDigitOfCSIat(maxVal, sLen));
  }
  else {
 
@@ -1788,12 +1799,12 @@
  /* all bytes of minVal but the highest one are just 00's */
 
  minVal = -1073741824;
- if ((((interpreterProxy->stObjectat(anInteger, sLen)) >> 1)) < (cDigitOfCSIat(minVal, sLen))) {
+ if ((((pointer2 = interpreterProxy->firstIndexableField(anInteger)))[sLen - 1]) < (cDigitOfCSIat(minVal, sLen))) {
  return 0;
  }
  else {
  for (ix = 1; ix <= sLen; ix += 1) {
- if (!((((interpreterProxy->stObjectat(anInteger, ix)) >> 1)) == (cDigitOfCSIat(minVal, ix)))) {
+ if (!((((pointer3 = interpreterProxy->firstIndexableField(anInteger)))[ix - 1]) == (cDigitOfCSIat(minVal, ix)))) {
  return 1;
  }
  }
@@ -1819,16 +1830,18 @@
 
 static sqInt
 normalizeNegative(sqInt aLargeNegativeInteger) {
+ sqInt len;
  sqInt i;
- sqInt len;
  sqInt sLen;
  sqInt minVal;
  sqInt oldLen;
  sqInt val;
+ unsigned char *pointer;
+ unsigned char *pointer1;
 
  len = oldLen = digitLength(aLargeNegativeInteger);
  while ((len != 0)
- && ((((interpreterProxy->stObjectat(aLargeNegativeInteger, len)) >> 1)) == 0)) {
+ && ((((pointer = interpreterProxy->firstIndexableField(aLargeNegativeInteger)))[len - 1]) == 0)) {
  len -= 1;
  }
  if (len == 0) {
@@ -1850,7 +1863,7 @@
 
  val = 0;
  for (i = len; i >= 1; i += -1) {
- val = (val * 256) - (((interpreterProxy->stObjectat(aLargeNegativeInteger, i)) >> 1));
+ val = (val * 256) - (((pointer1 = interpreterProxy->firstIndexableField(aLargeNegativeInteger)))[i - 1]);
  }
  return interpreterProxy->integerObjectOf(val);
  }
@@ -1883,12 +1896,14 @@
  sqInt i;
  sqInt len;
  sqInt sLen;
+ sqInt oldLen;
  sqInt val;
- sqInt oldLen;
+ unsigned char *pointer;
+ unsigned char *pointer1;
 
  len = oldLen = digitLength(aLargePositiveInteger);
  while ((len != 0)
- && ((((interpreterProxy->stObjectat(aLargePositiveInteger, len)) >> 1)) == 0)) {
+ && ((((pointer = interpreterProxy->firstIndexableField(aLargePositiveInteger)))[len - 1]) == 0)) {
  len -= 1;
  }
  if (len == 0) {
@@ -1905,7 +1920,7 @@
 
  val = 0;
  for (i = len; i >= 1; i += -1) {
- val = (val * 256) + (((interpreterProxy->stObjectat(aLargePositiveInteger, i)) >> 1));
+ val = (val * 256) + (((pointer1 = interpreterProxy->firstIndexableField(aLargePositiveInteger)))[i - 1]);
  }
  return interpreterProxy->integerObjectOf(val);
  }
@@ -2191,9 +2206,9 @@
 
 EXPORT(sqInt)
 primDigitBitShift(void) {
+ sqInt anInteger;
+ sqInt rShift;
  sqInt aLarge;
- sqInt rShift;
- sqInt anInteger;
  sqInt shiftCount;
  sqInt _return_value;
  sqInt aLargeInteger;
@@ -2246,9 +2261,9 @@
 
 EXPORT(sqInt)
 primDigitBitShiftMagnitude(void) {
+ sqInt anInteger;
+ sqInt rShift;
  sqInt aLarge;
- sqInt rShift;
- sqInt anInteger;
  sqInt shiftCount;
  sqInt _return_value;
  sqInt aLargeInteger;
@@ -2914,13 +2929,15 @@
 
 static sqInt
 unsafeByteOfat(sqInt bytesOop, sqInt ix) {
- return ((interpreterProxy->stObjectat(bytesOop, ix)) >> 1);
+ unsigned char *pointer;
+
+ return ((pointer = interpreterProxy->firstIndexableField(bytesOop)))[ix - 1];
 }
 
 EXPORT(sqInt)
 _primDigitBitShift(void) {
+ sqInt aLarge;
  sqInt rShift;
- sqInt aLarge;
  sqInt anInteger;
  sqInt shiftCount;
  sqInt _return_value;

Modified: branches/Cog/src/plugins/MacMenubarPlugin/MacMenubarPlugin.c
===================================================================
--- branches/Cog/src/plugins/MacMenubarPlugin/MacMenubarPlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/MacMenubarPlugin/MacMenubarPlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ SmartSyntaxPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- MacMenubarPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ MacMenubarPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "MacMenubarPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "MacMenubarPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -38,7 +38,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 
 
@@ -118,9 +117,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "MacMenubarPlugin VMMaker-oscog.8 (i)"
+ "MacMenubarPlugin VMMaker-oscog.35 (i)"
 #else
- "MacMenubarPlugin VMMaker-oscog.8 (e)"
+ "MacMenubarPlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 
@@ -966,12 +965,12 @@
 
 EXPORT(sqInt)
 primitiveGetMenuItemText(void) {
- Str255  aString;
+ sqInt i;
  sqInt oop;
- char *ptr;
  sqInt size;
+ Str255  aString;
+ char *ptr;
  MenuHandle menuHandle;
- sqInt i;
  sqInt menuHandleOop;
  sqInt anInteger;
  sqInt _return_value;
@@ -1041,8 +1040,8 @@
  Str255  aString;
  sqInt oop;
  char *ptr;
- sqInt size;
  MenuHandle menuHandle;
+ sqInt size;
  sqInt i;
  sqInt menuHandleOop;
  sqInt _return_value;
@@ -1122,8 +1121,8 @@
 
 EXPORT(sqInt)
 primitiveInsertIntlResMenu(void) {
- ResType resType;
  MenuHandle menuHandle;
+ ResType resType;
  sqInt menuHandleOop;
  sqInt aResType;
  sqInt afterItemInteger;

Modified: branches/Cog/src/plugins/QuicktimePlugin/QuicktimePlugin.c
===================================================================
--- branches/Cog/src/plugins/QuicktimePlugin/QuicktimePlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/QuicktimePlugin/QuicktimePlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ SmartSyntaxPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- QuicktimePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ QuicktimePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "QuicktimePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "QuicktimePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -38,7 +38,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 
 
@@ -67,9 +66,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "QuicktimePlugin VMMaker-oscog.8 (i)"
+ "QuicktimePlugin VMMaker-oscog.35 (i)"
 #else
- "QuicktimePlugin VMMaker-oscog.8 (e)"
+ "QuicktimePlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 
@@ -173,8 +172,8 @@
 
 EXPORT(sqInt)
 primitiveSetGWorldPtrOntoExistingSurface(void) {
- sqInt buffer;
  sqInt movie;
+ sqInt buffer;
  sqInt surfaceID;
  sqInt bitMapPtr;
  sqInt width;
@@ -205,9 +204,9 @@
 
 EXPORT(sqInt)
 primitiveSetGWorldPtrOntoSurface(void) {
- sqInt buffer;
- sqInt movie;
  sqInt results;
+ sqInt movie;
+ sqInt buffer;
  sqInt bitMapPtr;
  sqInt width;
  sqInt height;

Modified: branches/Cog/src/plugins/SoundGenerationPlugin/SoundGenerationPlugin.c
===================================================================
--- branches/Cog/src/plugins/SoundGenerationPlugin/SoundGenerationPlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/SoundGenerationPlugin/SoundGenerationPlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.20 uuid: 528a9b5e-293c-4fac-9430-1eabdb0d278d
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- SoundGenerationPlugin VMMaker-oscog.20 uuid: 528a9b5e-293c-4fac-9430-1eabdb0d278d
+ SoundGenerationPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "SoundGenerationPlugin VMMaker-oscog.20 uuid: 528a9b5e-293c-4fac-9430-1eabdb0d278d " __DATE__ ;
+static char __buildInfo[] = "SoundGenerationPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -60,10 +60,10 @@
 
 /*** Constants ***/
 #define IncrementFractionBits 16
-#define LoopIndexFractionMask 511
-#define LoopIndexScaleFactor 512
-#define ScaledIndexOverflow 536870912
-#define ScaleFactor 32768
+#define LoopIndexFractionMask 0x1FF
+#define LoopIndexScaleFactor 0x200
+#define ScaledIndexOverflow 0x20000000
+#define ScaleFactor 0x8000
 
 
 /*** Variables ***/
@@ -74,9 +74,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "SoundGenerationPlugin VMMaker-oscog.20 (i)"
+ "SoundGenerationPlugin VMMaker-oscog.35 (i)"
 #else
- "SoundGenerationPlugin VMMaker-oscog.20 (e)"
+ "SoundGenerationPlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 

Modified: branches/Cog/src/plugins/SqueakFFIPrims/SqueakFFIPrims.c
===================================================================
--- branches/Cog/src/plugins/SqueakFFIPrims/SqueakFFIPrims.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/SqueakFFIPrims/SqueakFFIPrims.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.21 uuid: f46d3ba4-c310-454b-9be7-30c6341f4486
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- ReentrantIA32FFIPlugin VMMaker-oscog.21 uuid: f46d3ba4-c310-454b-9be7-30c6341f4486
+ ReentrantIA32FFIPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "ReentrantIA32FFIPlugin VMMaker-oscog.21 uuid: f46d3ba4-c310-454b-9be7-30c6341f4486 " __DATE__ ;
+static char __buildInfo[] = "ReentrantIA32FFIPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -130,7 +130,7 @@
 #define ExternalFunctionArgTypesIndex 2
 #define ExternalFunctionFlagsIndex 1
 #define ExternalFunctionStackSizeIndex 3
-#define FFIAtomicTypeMask 251658240
+#define FFIAtomicTypeMask 0xF000000
 #define FFIAtomicTypeShift 24
 #define FFICallTypeApi 1
 #define FFIErrorAddressNotFound 13
@@ -152,11 +152,11 @@
 #define FFIErrorNotFunction 1
 #define FFIErrorStructSize 8
 #define FFIErrorWrongType 7
-#define FFIFlagAtomic 262144
-#define FFIFlagPointer 131072
-#define FFIFlagStructure 65536
+#define FFIFlagAtomic 0x40000
+#define FFIFlagPointer 0x20000
+#define FFIFlagStructure 0x10000
 #define FFINoCalloutAvailable -1
-#define FFIStructSizeMask 65535
+#define FFIStructSizeMask 0xFFFF
 #define FFITypeBool 1
 #define FFITypeDoubleFloat 13
 #define FFITypeSignedByte 3
@@ -261,9 +261,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "SqueakFFIPrims VMMaker-oscog.21 (i)"
+ "SqueakFFIPrims VMMaker-oscog.35 (i)"
 #else
- "SqueakFFIPrims VMMaker-oscog.21 (e)"
+ "SqueakFFIPrims VMMaker-oscog.35 (e)"
 #endif
 ;
 
@@ -1372,8 +1372,7 @@
  stackSize = (requiredStackSize < 0
  ? DefaultMaxStackSize
  : requiredStackSize);
- null;
-;
+ null;
  calloutState = (&theCalloutState);
  memset(calloutState, 0, sizeof(CalloutState));
 ;
@@ -2785,8 +2784,7 @@
  stackSize = (requiredStackSize < 0
  ? DefaultMaxStackSize
  : requiredStackSize);
- null;
-;
+ null;
  calloutState = (&theCalloutState);
  memset(calloutState, 0, sizeof(CalloutState));
 ;
@@ -3127,8 +3125,7 @@
  stackSize = (requiredStackSize < 0
  ? DefaultMaxStackSize
  : requiredStackSize);
- null;
-;
+ null;
  calloutState = (&theCalloutState);
  memset(calloutState, 0, sizeof(CalloutState));
 ;

Modified: branches/Cog/src/plugins/StarSqueakPlugin/StarSqueakPlugin.c
===================================================================
--- branches/Cog/src/plugins/StarSqueakPlugin/StarSqueakPlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/StarSqueakPlugin/StarSqueakPlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- StarSqueakPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ StarSqueakPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "StarSqueakPlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "StarSqueakPlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -37,7 +37,6 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
 
 
@@ -61,9 +60,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "StarSqueakPlugin VMMaker-oscog.8 (i)"
+ "StarSqueakPlugin VMMaker-oscog.35 (i)"
 #else
- "StarSqueakPlugin VMMaker-oscog.8 (e)"
+ "StarSqueakPlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 
@@ -294,7 +293,7 @@
  srcIndex = -1;
  for (y = 0; y <= ((h / patchSize) - 1); y += 1) {
  for (x = 0; x <= ((w / patchSize) - 1); x += 1) {
- level = ((shiftAmount < 0) ? ((usqInt) (src[srcIndex += 1]) >> -shiftAmount) : ((usqInt) (src[srcIndex += 1]) << shiftAmount));
+ level = ((shiftAmount < 0) ? ((usqInt) (src[(srcIndex += 1)]) >> -shiftAmount) : ((usqInt) (src[(srcIndex += 1)]) << shiftAmount));
  if (level > 255) {
  level = 255;
  }

Modified: branches/Cog/src/plugins/ZipPlugin/ZipPlugin.c
===================================================================
--- branches/Cog/src/plugins/ZipPlugin/ZipPlugin.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/plugins/ZipPlugin/ZipPlugin.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- VMPluginCodeGenerator VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ VMPluginCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- DeflatePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61
+ DeflatePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "DeflatePlugin VMMaker-oscog.8 uuid: b336429e-652e-4551-8d38-a00ef67eaa61 " __DATE__ ;
+static char __buildInfo[] = "DeflatePlugin VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 
 
 
@@ -37,17 +37,16 @@
 #include "sqMemoryAccess.h"
 
 
-
 /*** Constants ***/
-#define DeflateHashMask 32767
+#define DeflateHashMask 0x7FFF
 #define DeflateHashShift 5
 #define DeflateHashTableSize 32768
-#define DeflateMaxDistance 32768
+#define DeflateMaxDistance 0x8000
 #define DeflateMaxDistanceCodes 30
-#define DeflateMaxLiteralCodes 286
+#define DeflateMaxLiteralCodes 0x11E
 #define DeflateMaxMatch 258
 #define DeflateMinMatch 3
-#define DeflateWindowMask 32767
+#define DeflateWindowMask 0x7FFF
 #define DeflateWindowSize 32768
 #define MaxBits 16
 #define StateNoMoreData 1
@@ -91,9 +90,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "ZipPlugin VMMaker-oscog.8 (i)"
+ "ZipPlugin VMMaker-oscog.35 (i)"
 #else
- "ZipPlugin VMMaker-oscog.8 (e)"
+ "ZipPlugin VMMaker-oscog.35 (e)"
 #endif
 ;
 static unsigned int zipBaseDistance[] = {
@@ -1553,7 +1552,7 @@
  while (1) {
  /* begin zipNextBits: */
  while (zipBitPos < bitsNeeded) {
- byte = zipSource[zipSourcePos += 1];
+ byte = zipSource[(zipSourcePos += 1)];
  zipBitBuf += byte << zipBitPos;
  zipBitPos += 8;
  }
@@ -1614,7 +1613,7 @@
  oldPos = zipSourcePos;
  value = zipDecodeValueFromsize(zipLitTable, zipLitTableSize);
  if (value < 256) {
- zipCollection[zipReadLimit += 1] = value;
+ zipCollection[(zipReadLimit += 1)] = value;
  }
  else {
  if (value == 256) {
@@ -1658,7 +1657,7 @@
     sqInt byte;
 
  while (zipBitPos < n) {
- byte = zipSource[zipSourcePos += 1];
+ byte = zipSource[(zipSourcePos += 1)];
  zipBitBuf += byte << zipBitPos;
  zipBitPos += 8;
  }

Modified: branches/Cog/src/vm/cogmethod.h
===================================================================
--- branches/Cog/src/vm/cogmethod.h 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/vm/cogmethod.h 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,5 +1,5 @@
 /* Automatically generated by
- CCodeGenerator VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CCodeGenerator VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
 
 typedef struct {

Modified: branches/Cog/src/vm/cointerp.c
===================================================================
--- branches/Cog/src/vm/cointerp.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/vm/cointerp.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CCodeGeneratorGlobalStructure VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- CoInterpreter VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CoInterpreter VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "CoInterpreter VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce " __DATE__ ;
+static char __buildInfo[] = "CoInterpreter VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 char *__interpBuildInfo = __buildInfo;
 
 
@@ -1829,7 +1829,7 @@
  /* 575 */ (void (*)(void))0,
  0 };
 static void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* 4097 */])(void);
-const char *interpreterVersion = "Croquet Closure Cog VM [CoInterpreter VMMaker-oscog.34]";
+const char *interpreterVersion = "Croquet Closure Cog VM [CoInterpreter VMMaker-oscog.35]";
 static volatile int sendTrace;
 
 
@@ -14975,7 +14975,9 @@
 }
 
 
-/* NOTE: copied in InterpreterSimulator, so please duplicate any changes */
+/* NOTE: overridden in various simulator subclasses to add coercion to
+ CArray, so please duplicate any changes
+ */
 
 void *
 firstIndexableField(sqInt oop) {
@@ -14990,57 +14992,54 @@
 
  hdr = longAt(oop);
  fmt = (((usqInt) hdr) >> 8) & 15;
- /* begin lengthOf:baseHeader:format: */
- if ((hdr & TypeMask) == HeaderTypeSizeAndClass) {
- sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
- }
- else {
- sz = hdr & SizeMask;
- }
- sz -= hdr & Size4Bit;
  if (fmt <= 4) {
- totalLength = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
- goto l1;
- }
- if (fmt < 8) {
- totalLength = ((usqInt) (sz - BaseHeaderSize)) >> 2;
- goto l1;
- }
- else {
- totalLength = (sz - BaseHeaderSize) - (fmt & 3);
- goto l1;
- }
-l1: /* end lengthOf:baseHeader:format: */;
- /* begin fixedFieldsOf:format:length: */
- if ((fmt > 4)
- || (fmt == 2)) {
- fixedFields = 0;
- goto l3;
- }
- if (fmt < 2) {
- fixedFields = totalLength;
- goto l3;
- }
- /* begin fetchClassOfNonInt: */
- if (((ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31)) == 0) {
- class = (longAt(oop - BaseHeaderSize)) & AllButTypeMask;
- goto l2;
- }
- else {
- class = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
- goto l2;
- }
-l2: /* end fetchClassOfNonInt: */;
- classFormat = (longAt((class + BaseHeaderSize) + (InstanceSpecificationIndex << ShiftForWord))) - 1;
- fixedFields = (((((usqInt) classFormat) >> 11) & 192) + ((((usqInt) classFormat) >> 2) & 63)) - 1;
-l3: /* end fixedFieldsOf:format:length: */;
- if (fmt < 8) {
- if (fmt == 6) {
- return pointerForOop((oop + BaseHeaderSize) + (fixedFields << 2));
+ /* begin lengthOf:baseHeader:format: */
+ if ((hdr & TypeMask) == HeaderTypeSizeAndClass) {
+ sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
  }
+ else {
+ sz = hdr & SizeMask;
+ }
+ sz -= hdr & Size4Bit;
+ if (fmt <= 4) {
+ totalLength = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
+ goto l1;
+ }
+ if (fmt < 8) {
+ totalLength = ((usqInt) (sz - BaseHeaderSize)) >> 2;
+ goto l1;
+ }
+ else {
+ totalLength = (sz - BaseHeaderSize) - (fmt & 3);
+ goto l1;
+ }
+ l1: /* end lengthOf:baseHeader:format: */;
+ /* begin fixedFieldsOf:format:length: */
+ if ((fmt > 4)
+ || (fmt == 2)) {
+ fixedFields = 0;
+ goto l3;
+ }
+ if (fmt < 2) {
+ fixedFields = totalLength;
+ goto l3;
+ }
+ /* begin fetchClassOfNonInt: */
+ if (((ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31)) == 0) {
+ class = (longAt(oop - BaseHeaderSize)) & AllButTypeMask;
+ goto l2;
+ }
+ else {
+ class = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
+ goto l2;
+ }
+ l2: /* end fetchClassOfNonInt: */;
+ classFormat = (longAt((class + BaseHeaderSize) + (InstanceSpecificationIndex << ShiftForWord))) - 1;
+ fixedFields = (((((usqInt) classFormat) >> 11) & 192) + ((((usqInt) classFormat) >> 2) & 63)) - 1;
+ l3: /* end fixedFieldsOf:format:length: */;
  return pointerForOop((oop + BaseHeaderSize) + (fixedFields << ShiftForWord));
  }
- return pointerForOop((oop + BaseHeaderSize) + fixedFields);
+ return pointerForOop(oop + BaseHeaderSize);
 }
 
 

Modified: branches/Cog/src/vm/cointerp.h
===================================================================
--- branches/Cog/src/vm/cointerp.h 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/vm/cointerp.h 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,5 +1,5 @@
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CCodeGeneratorGlobalStructure VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
 
 

Modified: branches/Cog/src/vm/gcc3x-cointerp.c
===================================================================
--- branches/Cog/src/vm/gcc3x-cointerp.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/vm/gcc3x-cointerp.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -2,11 +2,11 @@
 
 
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CCodeGeneratorGlobalStructure VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- CoInterpreter VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CoInterpreter VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "CoInterpreter VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce " __DATE__ ;
+static char __buildInfo[] = "CoInterpreter VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 char *__interpBuildInfo = __buildInfo;
 
 
@@ -1832,7 +1832,7 @@
  /* 575 */ (void (*)(void))0,
  0 };
 static void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* 4097 */])(void);
-const char *interpreterVersion = "Croquet Closure Cog VM [CoInterpreter VMMaker-oscog.34]";
+const char *interpreterVersion = "Croquet Closure Cog VM [CoInterpreter VMMaker-oscog.35]";
 static volatile int sendTrace;
 
 
@@ -14979,7 +14979,9 @@
 }
 
 
-/* NOTE: copied in InterpreterSimulator, so please duplicate any changes */
+/* NOTE: overridden in various simulator subclasses to add coercion to
+ CArray, so please duplicate any changes
+ */
 
 void *
 firstIndexableField(sqInt oop) {
@@ -14994,57 +14996,54 @@
 
  hdr = longAt(oop);
  fmt = (((usqInt) hdr) >> 8) & 15;
- /* begin lengthOf:baseHeader:format: */
- if ((hdr & TypeMask) == HeaderTypeSizeAndClass) {
- sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
- }
- else {
- sz = hdr & SizeMask;
- }
- sz -= hdr & Size4Bit;
  if (fmt <= 4) {
- totalLength = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
- goto l1;
- }
- if (fmt < 8) {
- totalLength = ((usqInt) (sz - BaseHeaderSize)) >> 2;
- goto l1;
- }
- else {
- totalLength = (sz - BaseHeaderSize) - (fmt & 3);
- goto l1;
- }
-l1: /* end lengthOf:baseHeader:format: */;
- /* begin fixedFieldsOf:format:length: */
- if ((fmt > 4)
- || (fmt == 2)) {
- fixedFields = 0;
- goto l3;
- }
- if (fmt < 2) {
- fixedFields = totalLength;
- goto l3;
- }
- /* begin fetchClassOfNonInt: */
- if (((ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31)) == 0) {
- class = (longAt(oop - BaseHeaderSize)) & AllButTypeMask;
- goto l2;
- }
- else {
- class = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
- goto l2;
- }
-l2: /* end fetchClassOfNonInt: */;
- classFormat = (longAt((class + BaseHeaderSize) + (InstanceSpecificationIndex << ShiftForWord))) - 1;
- fixedFields = (((((usqInt) classFormat) >> 11) & 192) + ((((usqInt) classFormat) >> 2) & 63)) - 1;
-l3: /* end fixedFieldsOf:format:length: */;
- if (fmt < 8) {
- if (fmt == 6) {
- return pointerForOop((oop + BaseHeaderSize) + (fixedFields << 2));
+ /* begin lengthOf:baseHeader:format: */
+ if ((hdr & TypeMask) == HeaderTypeSizeAndClass) {
+ sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
  }
+ else {
+ sz = hdr & SizeMask;
+ }
+ sz -= hdr & Size4Bit;
+ if (fmt <= 4) {
+ totalLength = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
+ goto l1;
+ }
+ if (fmt < 8) {
+ totalLength = ((usqInt) (sz - BaseHeaderSize)) >> 2;
+ goto l1;
+ }
+ else {
+ totalLength = (sz - BaseHeaderSize) - (fmt & 3);
+ goto l1;
+ }
+ l1: /* end lengthOf:baseHeader:format: */;
+ /* begin fixedFieldsOf:format:length: */
+ if ((fmt > 4)
+ || (fmt == 2)) {
+ fixedFields = 0;
+ goto l3;
+ }
+ if (fmt < 2) {
+ fixedFields = totalLength;
+ goto l3;
+ }
+ /* begin fetchClassOfNonInt: */
+ if (((ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31)) == 0) {
+ class = (longAt(oop - BaseHeaderSize)) & AllButTypeMask;
+ goto l2;
+ }
+ else {
+ class = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
+ goto l2;
+ }
+ l2: /* end fetchClassOfNonInt: */;
+ classFormat = (longAt((class + BaseHeaderSize) + (InstanceSpecificationIndex << ShiftForWord))) - 1;
+ fixedFields = (((((usqInt) classFormat) >> 11) & 192) + ((((usqInt) classFormat) >> 2) & 63)) - 1;
+ l3: /* end fixedFieldsOf:format:length: */;
  return pointerForOop((oop + BaseHeaderSize) + (fixedFields << ShiftForWord));
  }
- return pointerForOop((oop + BaseHeaderSize) + fixedFields);
+ return pointerForOop(oop + BaseHeaderSize);
 }
 
 

Modified: branches/Cog/src/vm/interp.h
===================================================================
--- branches/Cog/src/vm/interp.h 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/src/vm/interp.h 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,5 +1,5 @@
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CCodeGeneratorGlobalStructure VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
 
 #define COGVM 1

Modified: branches/Cog/stacksrc/vm/gcc3x-interp.c
===================================================================
--- branches/Cog/stacksrc/vm/gcc3x-interp.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/stacksrc/vm/gcc3x-interp.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -2,11 +2,11 @@
 
 
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CCodeGeneratorGlobalStructure VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- StackInterpreter VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ StackInterpreter VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "StackInterpreter VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce " __DATE__ ;
+static char __buildInfo[] = "StackInterpreter VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 char *__interpBuildInfo = __buildInfo;
 
 
@@ -1621,7 +1621,7 @@
  0 };
 char * breakSelector;
 sqInt breakSelectorLength = -1;
-const char *interpreterVersion = "Croquet Closure Stack VM [StackInterpreter VMMaker-oscog.34]";
+const char *interpreterVersion = "Croquet Closure Stack VM [StackInterpreter VMMaker-oscog.35]";
 static volatile int sendTrace;
 sqInt suppressHeartbeatFlag;
 
@@ -11800,7 +11800,9 @@
 }
 
 
-/* NOTE: copied in InterpreterSimulator, so please duplicate any changes */
+/* NOTE: overridden in various simulator subclasses to add coercion to
+ CArray, so please duplicate any changes
+ */
 
 void *
 firstIndexableField(sqInt oop) {
@@ -11815,57 +11817,54 @@
 
  hdr = longAt(oop);
  fmt = (((usqInt) hdr) >> 8) & 15;
- /* begin lengthOf:baseHeader:format: */
- if ((hdr & TypeMask) == HeaderTypeSizeAndClass) {
- sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
- }
- else {
- sz = hdr & SizeMask;
- }
- sz -= hdr & Size4Bit;
  if (fmt <= 4) {
- totalLength = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
- goto l1;
- }
- if (fmt < 8) {
- totalLength = ((usqInt) (sz - BaseHeaderSize)) >> 2;
- goto l1;
- }
- else {
- totalLength = (sz - BaseHeaderSize) - (fmt & 3);
- goto l1;
- }
-l1: /* end lengthOf:baseHeader:format: */;
- /* begin fixedFieldsOf:format:length: */
- if ((fmt > 4)
- || (fmt == 2)) {
- fixedFields = 0;
- goto l3;
- }
- if (fmt < 2) {
- fixedFields = totalLength;
- goto l3;
- }
- /* begin fetchClassOfNonInt: */
- if (((ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31)) == 0) {
- class = (longAt(oop - BaseHeaderSize)) & AllButTypeMask;
- goto l2;
- }
- else {
- class = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
- goto l2;
- }
-l2: /* end fetchClassOfNonInt: */;
- classFormat = (longAt((class + BaseHeaderSize) + (InstanceSpecificationIndex << ShiftForWord))) - 1;
- fixedFields = (((((usqInt) classFormat) >> 11) & 192) + ((((usqInt) classFormat) >> 2) & 63)) - 1;
-l3: /* end fixedFieldsOf:format:length: */;
- if (fmt < 8) {
- if (fmt == 6) {
- return pointerForOop((oop + BaseHeaderSize) + (fixedFields << 2));
+ /* begin lengthOf:baseHeader:format: */
+ if ((hdr & TypeMask) == HeaderTypeSizeAndClass) {
+ sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
  }
+ else {
+ sz = hdr & SizeMask;
+ }
+ sz -= hdr & Size4Bit;
+ if (fmt <= 4) {
+ totalLength = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
+ goto l1;
+ }
+ if (fmt < 8) {
+ totalLength = ((usqInt) (sz - BaseHeaderSize)) >> 2;
+ goto l1;
+ }
+ else {
+ totalLength = (sz - BaseHeaderSize) - (fmt & 3);
+ goto l1;
+ }
+ l1: /* end lengthOf:baseHeader:format: */;
+ /* begin fixedFieldsOf:format:length: */
+ if ((fmt > 4)
+ || (fmt == 2)) {
+ fixedFields = 0;
+ goto l3;
+ }
+ if (fmt < 2) {
+ fixedFields = totalLength;
+ goto l3;
+ }
+ /* begin fetchClassOfNonInt: */
+ if (((ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31)) == 0) {
+ class = (longAt(oop - BaseHeaderSize)) & AllButTypeMask;
+ goto l2;
+ }
+ else {
+ class = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
+ goto l2;
+ }
+ l2: /* end fetchClassOfNonInt: */;
+ classFormat = (longAt((class + BaseHeaderSize) + (InstanceSpecificationIndex << ShiftForWord))) - 1;
+ fixedFields = (((((usqInt) classFormat) >> 11) & 192) + ((((usqInt) classFormat) >> 2) & 63)) - 1;
+ l3: /* end fixedFieldsOf:format:length: */;
  return pointerForOop((oop + BaseHeaderSize) + (fixedFields << ShiftForWord));
  }
- return pointerForOop((oop + BaseHeaderSize) + fixedFields);
+ return pointerForOop(oop + BaseHeaderSize);
 }
 
 

Modified: branches/Cog/stacksrc/vm/interp.c
===================================================================
--- branches/Cog/stacksrc/vm/interp.c 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/stacksrc/vm/interp.c 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CCodeGeneratorGlobalStructure VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
    from
- StackInterpreter VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ StackInterpreter VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
-static char __buildInfo[] = "StackInterpreter VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce " __DATE__ ;
+static char __buildInfo[] = "StackInterpreter VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa " __DATE__ ;
 char *__interpBuildInfo = __buildInfo;
 
 
@@ -1618,7 +1618,7 @@
  0 };
 char * breakSelector;
 sqInt breakSelectorLength = -1;
-const char *interpreterVersion = "Croquet Closure Stack VM [StackInterpreter VMMaker-oscog.34]";
+const char *interpreterVersion = "Croquet Closure Stack VM [StackInterpreter VMMaker-oscog.35]";
 static volatile int sendTrace;
 sqInt suppressHeartbeatFlag;
 
@@ -11796,7 +11796,9 @@
 }
 
 
-/* NOTE: copied in InterpreterSimulator, so please duplicate any changes */
+/* NOTE: overridden in various simulator subclasses to add coercion to
+ CArray, so please duplicate any changes
+ */
 
 void *
 firstIndexableField(sqInt oop) {
@@ -11811,57 +11813,54 @@
 
  hdr = longAt(oop);
  fmt = (((usqInt) hdr) >> 8) & 15;
- /* begin lengthOf:baseHeader:format: */
- if ((hdr & TypeMask) == HeaderTypeSizeAndClass) {
- sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
- }
- else {
- sz = hdr & SizeMask;
- }
- sz -= hdr & Size4Bit;
  if (fmt <= 4) {
- totalLength = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
- goto l1;
- }
- if (fmt < 8) {
- totalLength = ((usqInt) (sz - BaseHeaderSize)) >> 2;
- goto l1;
- }
- else {
- totalLength = (sz - BaseHeaderSize) - (fmt & 3);
- goto l1;
- }
-l1: /* end lengthOf:baseHeader:format: */;
- /* begin fixedFieldsOf:format:length: */
- if ((fmt > 4)
- || (fmt == 2)) {
- fixedFields = 0;
- goto l3;
- }
- if (fmt < 2) {
- fixedFields = totalLength;
- goto l3;
- }
- /* begin fetchClassOfNonInt: */
- if (((ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31)) == 0) {
- class = (longAt(oop - BaseHeaderSize)) & AllButTypeMask;
- goto l2;
- }
- else {
- class = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
- goto l2;
- }
-l2: /* end fetchClassOfNonInt: */;
- classFormat = (longAt((class + BaseHeaderSize) + (InstanceSpecificationIndex << ShiftForWord))) - 1;
- fixedFields = (((((usqInt) classFormat) >> 11) & 192) + ((((usqInt) classFormat) >> 2) & 63)) - 1;
-l3: /* end fixedFieldsOf:format:length: */;
- if (fmt < 8) {
- if (fmt == 6) {
- return pointerForOop((oop + BaseHeaderSize) + (fixedFields << 2));
+ /* begin lengthOf:baseHeader:format: */
+ if ((hdr & TypeMask) == HeaderTypeSizeAndClass) {
+ sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
  }
+ else {
+ sz = hdr & SizeMask;
+ }
+ sz -= hdr & Size4Bit;
+ if (fmt <= 4) {
+ totalLength = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
+ goto l1;
+ }
+ if (fmt < 8) {
+ totalLength = ((usqInt) (sz - BaseHeaderSize)) >> 2;
+ goto l1;
+ }
+ else {
+ totalLength = (sz - BaseHeaderSize) - (fmt & 3);
+ goto l1;
+ }
+ l1: /* end lengthOf:baseHeader:format: */;
+ /* begin fixedFieldsOf:format:length: */
+ if ((fmt > 4)
+ || (fmt == 2)) {
+ fixedFields = 0;
+ goto l3;
+ }
+ if (fmt < 2) {
+ fixedFields = totalLength;
+ goto l3;
+ }
+ /* begin fetchClassOfNonInt: */
+ if (((ccIndex = (((usqInt) (longAt(oop))) >> 12) & 31)) == 0) {
+ class = (longAt(oop - BaseHeaderSize)) & AllButTypeMask;
+ goto l2;
+ }
+ else {
+ class = longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord));
+ goto l2;
+ }
+ l2: /* end fetchClassOfNonInt: */;
+ classFormat = (longAt((class + BaseHeaderSize) + (InstanceSpecificationIndex << ShiftForWord))) - 1;
+ fixedFields = (((((usqInt) classFormat) >> 11) & 192) + ((((usqInt) classFormat) >> 2) & 63)) - 1;
+ l3: /* end fixedFieldsOf:format:length: */;
  return pointerForOop((oop + BaseHeaderSize) + (fixedFields << ShiftForWord));
  }
- return pointerForOop((oop + BaseHeaderSize) + fixedFields);
+ return pointerForOop(oop + BaseHeaderSize);
 }
 
 

Modified: branches/Cog/stacksrc/vm/interp.h
===================================================================
--- branches/Cog/stacksrc/vm/interp.h 2010-10-01 14:52:47 UTC (rev 2314)
+++ branches/Cog/stacksrc/vm/interp.h 2010-10-04 03:39:37 UTC (rev 2315)
@@ -1,5 +1,5 @@
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker-oscog.34 uuid: ec174a95-5f42-4fe0-88f0-4baff13dd3ce
+ CCodeGeneratorGlobalStructure VMMaker-oscog.35 uuid: cf41affd-7225-42c5-8fa7-257721d041aa
  */
 
 #define STACKVM 1