[commit] r2392 - OSCogVM source as per VMMaker.oscog-eem.72. Fixed Montgommery code in

 
Author: eliot
Date: 2011-06-06 15:07:11 -0700 (Mon, 06 Jun 2011)
New Revision: 2392

Modified:
   branches/Cog/cygwinbuild/Makefile
   branches/Cog/image/VMMaker-Squeak4.1.changes
   branches/Cog/image/VMMaker-Squeak4.1.image
   branches/Cog/nssrc/plugins/LargeIntegers/LargeIntegers.c
   branches/Cog/nssrc/vm/gcc3x-interp.c
   branches/Cog/nssrc/vm/interp.c
   branches/Cog/nssrc/vm/interp.h
   branches/Cog/nssrc/vm/vmCallback.h
   branches/Cog/platforms/win32/vm/sqWin32Prefs.c
   branches/Cog/scripts/uploadvms
   branches/Cog/src/plugins/LargeIntegers/LargeIntegers.c
Log:
OSCogVM source as per VMMaker.oscog-eem.72.  Fixed Montgommery code in
LargeIntegers plugin.  Fixed Newspeak callbacks.  Make the VM_NAME an optional
parameter of the Makefile under cygwin.


Modified: branches/Cog/cygwinbuild/Makefile
===================================================================
--- branches/Cog/cygwinbuild/Makefile 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/cygwinbuild/Makefile 2011-06-06 22:07:11 UTC (rev 2392)
@@ -10,6 +10,7 @@
 
 # The name of the VM to build
 VM:=Croquet
+VM_NAME?=$(VM)
 
 # Is this a Croquet VM (defaults to OGL instead of D3D)?
 CROQUET:=-DCROQUET
@@ -127,7 +128,7 @@
  -mno-rtd -mms-bitfields -mno-accumulate-outgoing-args $(OFLAGS) $(NOBUILTIN)
 DEFS:= -DDEBUGVM=$(DEBUGVM) $(WINVER) -DWIN32 -DWIN32_FILE_SUPPORT -DNO_ISNAN \
  -DNO_SERVICE -DNO_STD_FILE_SUPPORT \
- $(NDEBUG) -DLSB_FIRST -DVM_NAME=\"$(VM)\" -DX86 $(XDEFS) $(CROQUET)
+ $(NDEBUG) -DLSB_FIRST -D'VM_NAME="$(VM_NAME)"' -DX86 $(XDEFS) $(CROQUET)
 XDEFS:= -DSQUEAK_BUILTIN_PLUGIN
 INCLUDES:= -I. -I$(VMDIR) -I$(WIN32DIR) -I$(CROSSDIR) -I$(DXDIR) $(XINC)
 

Modified: branches/Cog/image/VMMaker-Squeak4.1.changes
===================================================================
--- branches/Cog/image/VMMaker-Squeak4.1.changes 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/image/VMMaker-Squeak4.1.changes 2011-06-06 22:07:11 UTC (rev 2392)
@@ -193833,4 +193833,764 @@
 ----STARTUP----{2 June 2011 . 1:14:32 pm} as /Users/eliot/Cog/oscogvm/image/VMMaker-Squeak4.1.image!
 
 
-----QUIT----{2 June 2011 . 1:17:56 pm} VMMaker-Squeak4.1.image priorSource: 8058095!
\ No newline at end of file
+----QUIT----{2 June 2011 . 1:17:56 pm} VMMaker-Squeak4.1.image priorSource: 8058095!
+!NewspeakInterpreter commentStamp: 'tpr 4/3/2006 12:46' prior: 40920697!
+This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.
+
+It has been modernized with 32-bit pointers, better management of Contexts, and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
+
+The latest version has been extend to support 64 bit systems in at least a basic manner - it is possible to create a 64 bit image via a special SystemTracer - and much of the core code has been cleaned up so that it works whether the C compiler thinks integers are 32 or 64 bit in size. There is still some cleanup required.
+
+In addition to SmallInteger arithmetic and Floats, it supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
+
+NOTE:  Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
+
+1.  There are a number of things that should be done the next time we plan to release a copletely incompatible image format.  These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:.  Also, contexts should be given a special format code (see next item).
+
+2.  There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change.  This is necessary because the oops may change during a compaction when the oops are being adjusted.  It's important to be aware of this when writing a new image using the systemTracer.  A better solution would be to reserve one of the format codes for Contexts only.
+
+3.  We have made normal files tolerant to size and positions up to 32 bits.  This has not been done for async files, since they are still experimental.  The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes.
+
+4.  Note that 0 is used in a couple of places as an impossible oop.  This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment).  The places include the method cache and the at cache. !
+
+----STARTUP----{6 June 2011 . 2:37:58 pm} as /Users/eliot/Cog/oscogvm/image/VMMaker-Squeak4.1.image!
+
+!InterpreterPlugin class methodsFor: 'translation' stamp: 'eem 6/3/2011 09:09'!
+shouldBeTranslatedFor: platformName
+ "Is this class intended to be translated as a plugin, perhaps specific to a platform?
+ Most subclasses should answer true, but some such as simulation-only versions
+ should answer false for various reasons."
+ ^self shouldBeTranslated! !
+!VMMakerTool methodsFor: 'generate sources' stamp: 'eem 6/3/2011 08:55' prior: 39484703!
+generateSelectedExternalPlugin
+
+ | pluginName |
+ pluginName := self externalModules
+ at: self currentExternalModuleIndex
+ ifAbsent: [^self inform: 'no such plugin'].
+ vmMaker interpreterClass
+ ifNil: [^self inform: 'please set an interpreter class']
+ ifNotNil: [:interpreterClass| interpreterClass initialize].
+ self checkOK ifTrue:
+ [[(Smalltalk classNamed: pluginName) touch.
+  vmMaker generateExternalPlugin: pluginName; logDateAndTime]
+ on: VMMakerException
+ do: [:ex| self inform: ex messageText]]! !
+!VMMakerTool methodsFor: 'generate sources' stamp: 'eem 6/3/2011 08:55' prior: 39485118!
+generateSelectedInternalPlugin
+
+ | pluginName |
+ pluginName := self internalModules
+ at: self currentExternalModuleIndex
+ ifAbsent: [^self inform: 'no such plugin'].
+ vmMaker interpreterClass
+ ifNil: [^self inform: 'please set an interpreter class']
+ ifNotNil: [:interpreterClass| interpreterClass initialize].
+ self checkOK ifTrue:
+ [[(Smalltalk classNamed: pluginName) touch.
+  vmMaker generateInternalPlugin: pluginName]
+ on: VMMakerException
+ do: [:ex| self inform: ex messageText]]! !
+!NewspeakInterpreter class methodsFor: 'translation' stamp: 'eem 6/3/2011 15:59' prior: 41043062!
+declareCVarsIn: aCCodeGenerator
+
+ aCCodeGenerator
+ addHeaderFile:'<stddef.h> /* for e.g. alloca */';
+ addHeaderFile:'<setjmp.h>';
+ addHeaderFile:'"vmCallback.h"';
+ addHeaderFile:'"dispdbg.h"'.
+ aCCodeGenerator
+ var: #interpreterProxy
+ type: #'struct VirtualMachine*'.
+ aCCodeGenerator
+ declareVar: #sendTrace type: 'volatile int';
+ declareVar: #byteCount type: 'unsigned long'.
+ aCCodeGenerator
+ var: #primitiveTable
+ declareC: 'void *primitiveTable[', (MaxPrimitiveIndex +2) printString, '] = ', self primitiveTableString.
+ aCCodeGenerator
+ var: #primitiveFunctionPointer
+ declareC: 'void (*primitiveFunctionPointer)()'.
+ aCCodeGenerator
+ var: #methodCache
+ declareC: 'long methodCache[', (MethodCacheSize + 1) printString, ']'.
+ aCCodeGenerator
+ var: #atCache
+ declareC: 'sqInt atCache[', (AtCacheTotalSize + 1) printString, ']'.
+ aCCodeGenerator var: #localIP type: #'char*'.
+ aCCodeGenerator var: #localSP type: #'char*'.
+ aCCodeGenerator var: #showSurfaceFn type: #'void*'.
+ "Newspeak as of mid 2011 derives SystemScope systemName from the interpreterVersion (via system attribute 1004)
+ by copying up to but not including the last space, provided the string ends with a digit.  So spaces must be eliminated
+ from the Monitcello version string, and we can't surround it with square brackets.."
+ (aCCodeGenerator shortMonticelloDescriptionForClass: self) last isDigit ifFalse:
+ [self error: 'Newspeak expects interpreterVersion ends with a digit'].
+ aCCodeGenerator
+ var: #interpreterVersion
+ declareC: 'const char *interpreterVersion = "Newspeak Virtual Machine ',
+ ((aCCodeGenerator shortMonticelloDescriptionForClass: self) copyReplaceAll: ' ' with: '_'),
+ '"'.
+ aCCodeGenerator
+ var: #externalPrimitiveTable
+ declareC: 'void *externalPrimitiveTable[', (MaxExternalPrimitiveTableSize + 1) printString, ']'.
+
+ aCCodeGenerator
+ var: #imageFormatVersionNumber
+ declareC: 'sqInt imageFormatVersionNumber = ',
+ (BytesPerWord == 4
+ ifTrue: ['6502']
+ ifFalse: ['68000']).
+ aCCodeGenerator
+ var: #breakSelector type: #'char *';
+ var: #breakSelectorLength
+ declareC: 'sqInt breakSelectorLength = -1';
+ var: #primTraceLogIndex type: #'unsigned char';
+ var: #primTraceLog declareC: 'sqInt primTraceLog[256]';
+ var: #sendTraceLogIndex type: #'unsigned char';
+ var: #sendTraceLog declareC: 'sqInt sendTraceLog[256]'
+! !
+!NewspeakInterpreter class methodsFor: 'initialization' stamp: 'eem 6/3/2011 16:02' prior: 41052785!
+initializeMiscConstants
+
+ super initializeMiscConstants.
+
+ PrimitiveExternalCallIndex := 117. "Primitive index for #primitiveExternalCall"
+ MillisecondClockMask := 16r1FFFFFFF.
+ "Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)"
+ MaxExternalPrimitiveTableSize := 1024. "entries"
+
+ FailImbalancedPrimitives ifNil: [FailImbalancedPrimitives := false].
+ RecordPrimTrace := false.
+ RecordSendTrace := false.
+ TraceLogSize := 256! !
+!NewspeakInterpreter methodsFor: 'message sending' stamp: 'eem 6/6/2011 13:42' prior: 41127420!
+commonSend
+ "Send a message, starting lookup with the receiver's class."
+ "Assume: messageSelector and argumentCount have been set, and that
+ the receiver and arguments have been pushed onto the stack,"
+ "Note: This method is inlined into the interpreter dispatch loop."
+ <sharedCodeNamed: 'commonSend' inCase: 131>
+ self fastLogSend: messageSelector.
+ self sendBreak: messageSelector + BaseHeaderSize
+ point: (self lengthOf: messageSelector)
+ receiver: (self internalStackValue: argumentCount).
+ self internalFindNewMethod.
+ self internalExecuteNewMethod.
+ self fetchNextBytecode! !
+!NewspeakInterpreter methodsFor: 'debug support' stamp: 'eem 6/3/2011 16:03'!
+dumpPrimTraceLog
+ "The prim trace log is a circular buffer of entries. If there is
+ an entry at primTraceLogIndex \\ PrimTraceLogSize it has entries.
+ If there is something at primTraceLogIndex it has wrapped."
+
+ <api>
+ <inline: false>
+ (primTraceLog at: (self safe: primTraceLogIndex - 1 mod: TraceLogSize)) = 0 ifTrue: [^nil].
+ (primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
+ [primTraceLogIndex to: TraceLogSize - 1 do:
+ [:i | self safePrintStringOf: (primTraceLog at: i); cr]].
+ 0 to: primTraceLogIndex - 1 do:
+ [:i | self safePrintStringOf: (primTraceLog at: i); cr]! !
+!NewspeakInterpreter methodsFor: 'debug support' stamp: 'eem 6/3/2011 16:03'!
+dumpSendTraceLog
+ "The send trace log is a circular buffer of entries. If there is
+ an entry at sendTraceLogIndex \\ PrimTraceLogSize it has entries.
+ If there is something at sendTraceLogIndex it has wrapped."
+
+ <api>
+ <inline: false>
+ (sendTraceLog at: (self safe: sendTraceLogIndex - 1 mod: TraceLogSize)) = 0 ifTrue: [^nil].
+ (sendTraceLog at: sendTraceLogIndex) ~= 0 ifTrue:
+ [sendTraceLogIndex to: TraceLogSize - 1 do:
+ [:i | self safePrintStringOf: (sendTraceLog at: i); cr]].
+ 0 to: sendTraceLogIndex - 1 do:
+ [:i | self safePrintStringOf: (sendTraceLog at: i); cr]! !
+!NewspeakInterpreter methodsFor: 'debug support' stamp: 'eem 6/6/2011 13:44'!
+fastLogPrim: aSelector
+ "Fast tracing of named primitives.  primTraceLogIndex is a byte variable.
+ primTraceLog has 256 entries.  In C the + 1 below is hence implicitly modulo 256."
+ <inline: true>
+ RecordPrimTrace ifTrue:
+ [primTraceLog at: primTraceLogIndex put: aSelector.
+ self primTraceLogIndex: primTraceLogIndex + 1]! !
+!NewspeakInterpreter methodsFor: 'debug support' stamp: 'eem 6/6/2011 13:42'!
+fastLogSend: aSelector
+ "Fast tracing of sends.  sendTraceLogIndex is a byte variable.
+ sendTraceLog has 256 entries.  In C the + 1 below is hence implicitly modulo 256."
+ <inline: true>
+ RecordSendTrace ifTrue:
+ [sendTraceLog at: sendTraceLogIndex put: aSelector.
+ self sendTraceLogIndex: sendTraceLogIndex + 1]! !
+!NewspeakInterpreter methodsFor: 'callback support' stamp: 'eem 6/6/2011 13:24' prior: 41201564!
+justActivateNewMethod
+ "Activate the new method but *do not* copy receiver or arguments from activeContext."
+ | methodHeader initialIP newContext tempCount needsLarge where |
+ <inline: true>
+
+ methodHeader := self headerOf: newMethod.
+ needsLarge := methodHeader bitAnd: LargeContextBit.
+ (needsLarge = 0 and: [freeContexts ~= NilContext])
+ ifTrue: [newContext := freeContexts.
+ freeContexts := self fetchPointer: 0 ofObject: newContext]
+ ifFalse: ["Slower call for large contexts or empty free list"
+ newContext := self allocateOrRecycleContext: needsLarge].
+ initialIP := ((LiteralStart + (self literalCountOfHeader: methodHeader)) * BytesPerWord) + 1.
+ tempCount := (methodHeader >> 19) bitAnd: 16r3F.
+
+ "Assume: newContext will be recorded as a root if necessary by the
+ call to newActiveContext: below, so we can use unchecked stores."
+ where := newContext + BaseHeaderSize.
+ self longAt: where + (SenderIndex << ShiftForWord) put: activeContext.
+ self longAt: where + (InstructionPointerIndex << ShiftForWord) put: (self integerObjectOf: initialIP).
+ self longAt: where + (StackPointerIndex << ShiftForWord) put: (self integerObjectOf: tempCount).
+ self longAt: where + (MethodIndex << ShiftForWord) put: newMethod.
+
+ "Set the receiver..."
+ self longAt: where + (ReceiverIndex << ShiftForWord) put: receiver.
+
+ "clear all args and temps to nil in case it has been recycled"
+ needsLarge := nilObj.  "needsLarge here used just as faster (register?) temp"
+ ReceiverIndex + 1 to: tempCount + ReceiverIndex do:
+ [:i | self longAt: where + (i << ShiftForWord) put: needsLarge].
+ reclaimableContextCount := reclaimableContextCount + 1.
+
+ activeContext := newContext.
+ (self oop: newContext isLessThan: youngStart) ifTrue:
+ [self beRootIfOld: newContext].
+ self fetchContextRegisters: activeContext! !
+!NewspeakInterpreter methodsFor: 'message sending' stamp: 'eem 6/6/2011 13:42' prior: 41209227!
+lookupMethodInClass: class
+ | currentClass dictionary found rclass |
+ <inline: false>
+
+ currentClass := class.
+ [currentClass ~= nilObj]
+ whileTrue:
+ [dictionary := self fetchPointer: MessageDictionaryIndex ofObject: currentClass.
+ dictionary = nilObj ifTrue:
+ ["MethodDict pointer is nil (hopefully due a swapped out stub)
+ -- raise exception #cannotInterpret:."
+ self pushRemappableOop: currentClass.  "may cause GC!!"
+ self createActualMessageTo: class.
+ currentClass := self popRemappableOop.
+ messageSelector := self splObj: SelectorCannotInterpret.
+ self fastLogSend: messageSelector.
+ self sendBreak: messageSelector + BaseHeaderSize
+ point: (self lengthOf: messageSelector)
+ receiver: nil.
+ ^ self lookupMethodInClass: (self superclassOf: currentClass)].
+ found := self lookupMethodInDictionary: dictionary.
+ found ifTrue: [^currentClass].
+ currentClass := self superclassOf: currentClass].
+
+ "Could not find #doesNotUnderstand: -- unrecoverable error."
+ messageSelector = (self splObj: SelectorDoesNotUnderstand) ifTrue:
+ [self error: 'Recursive not understood error encountered'].
+
+ "Cound not find a normal message -- raise exception #doesNotUnderstand:"
+ self pushRemappableOop: class.  "may cause GC!!"
+ self createActualMessageTo: class.
+ rclass := self popRemappableOop.
+ messageSelector := self splObj: SelectorDoesNotUnderstand.
+ RecordSendTrace ifTrue:
+ [self fastLogSend: messageSelector].
+ self sendBreak: messageSelector + BaseHeaderSize
+ point: (self lengthOf: messageSelector)
+ receiver: nil.
+ ^ self lookupMethodInClass: rclass! !
+!NewspeakInterpreter methodsFor: 'object memory support' stamp: 'eem 6/3/2011 16:00' prior: 41213370!
+mapInterpreterOops
+ "Map all oops in the interpreter's state to their new values
+ during garbage collection or a become: operation."
+ "Assume: All traced variables contain valid oops."
+ | oop |
+ nilObj := self remap: nilObj.
+ falseObj := self remap: falseObj.
+ trueObj := self remap: trueObj.
+ specialObjectsOop := self remap: specialObjectsOop.
+ stackPointer := stackPointer - activeContext. "*rel to active"
+ activeContext := self remap: activeContext.
+ stackPointer := stackPointer + activeContext. "*rel to active"
+ theHomeContext := self remap: theHomeContext.
+ instructionPointer := instructionPointer - method. "*rel to method"
+ method := self remap: method.
+ instructionPointer := instructionPointer + method. "*rel to method"
+ receiver := self remap: receiver.
+ (self isIntegerObject: messageSelector) ifFalse:
+ [messageSelector := self remap: messageSelector].
+ (self isIntegerObject: newMethod) ifFalse:
+ [newMethod := self remap: newMethod].
+ lkupClass := self remap: lkupClass.
+ 1 to: remapBufferCount do: [:i |
+ oop := remapBuffer at: i.
+ (self isIntegerObject: oop)
+ ifFalse: [remapBuffer at: i put: (self remap: oop)]].
+ self mapTraceLogs! !
+!NewspeakInterpreter methodsFor: 'debug support' stamp: 'eem 6/3/2011 16:01'!
+mapTraceLogs
+ "The prim and send trace logs are circular buffers of selectors. If there is
+ an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
+ If there is something at primTraceLogIndex it has wrapped."
+ <inline: false>
+ | limit |
+ limit := self safe: primTraceLogIndex - 1 mod: TraceLogSize.
+ (primTraceLog at: limit) = 0 ifTrue: [^nil].
+ (primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
+ [limit := TraceLogSize - 1].
+ 0 to: limit do:
+ [:i| | selector |
+ selector := primTraceLog at: i.
+ (self isIntegerObject: selector) ifFalse:
+ [primTraceLog at: i put: (self remap: selector)]].
+ limit := self safe: sendTraceLogIndex - 1 mod: TraceLogSize.
+ (sendTraceLog at: limit) = 0 ifTrue: [^nil].
+ (sendTraceLog at: sendTraceLogIndex) ~= 0 ifTrue:
+ [limit := TraceLogSize - 1].
+ 0 to: limit do:
+ [:i| | selector |
+ selector := sendTraceLog at: i.
+ (self isIntegerObject: selector) ifFalse:
+ [sendTraceLog at: i put: (self remap: selector)]]! !
+!NewspeakInterpreter methodsFor: 'object memory support' stamp: 'eem 6/3/2011 16:04' prior: 41214605!
+markAndTraceInterpreterOops
+ "Mark and trace all oops in the interpreter's state."
+ "Assume: All traced variables contain valid oops."
+ | oop |
+ self markAndTrace: specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
+ self markAndTrace: activeContext.
+ self markAndTrace: messageSelector.
+ self markAndTrace: newMethod.
+ self markAndTrace: lkupClass.
+ 1 to: remapBufferCount do:
+ [:i |
+ oop := remapBuffer at: i.
+ (self isIntegerObject: oop) ifFalse: [self markAndTrace: oop]].
+ self markAndTraceTraceLogs! !
+!NewspeakInterpreter methodsFor: 'debug support' stamp: 'eem 6/6/2011 13:43'!
+markAndTraceTraceLogs
+ "The prim and send trace logs are circular buffers of selectors. If there is
+ an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
+ If there is something at primTraceLogIndex it has wrapped."
+ <inline: false>
+ | limit |
+ RecordPrimTrace ifTrue:
+ [limit := self safe: primTraceLogIndex - 1 mod: TraceLogSize.
+ (primTraceLog at: limit) ~= 0 ifTrue:
+ [(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
+ [limit := TraceLogSize - 1].
+ 0 to: limit do:
+ [:i| | selector |
+ selector := primTraceLog at: i.
+ (self isIntegerObject: selector) ifFalse:
+ [self markAndTrace: selector]]]].
+ RecordSendTrace ifTrue:
+ [limit := self safe: sendTraceLogIndex - 1 mod: TraceLogSize.
+ (sendTraceLog at: limit) ~= 0 ifTrue:
+ [(sendTraceLog at: sendTraceLogIndex) ~= 0 ifTrue:
+ [limit := TraceLogSize - 1].
+ 0 to: limit do:
+ [:i| | selector |
+ selector := sendTraceLog at: i.
+ (self isIntegerObject: selector) ifFalse:
+ [self markAndTrace: selector]]]]! !
+!NewspeakInterpreter methodsFor: 'debug support' stamp: 'eem 6/3/2011 15:58'!
+primTraceLogIndex: aValue
+ <cmacro: '(aValue) (GIV(primTraceLogIndex) = (aValue))'>
+ "N.B. primTraceLogIndex is 8-bits"
+ ^primTraceLogIndex := aValue bitAnd: 16rFF! !
+!NewspeakInterpreter methodsFor: 'control primitives' stamp: 'eem 6/6/2011 13:42' prior: 41329121!
+primitivePerformAt: lookupClass
+ "Common routine used by perform:withArgs: and perform:withArgs:inSuperclass:"
+
+ "NOTE:  The case of doesNotUnderstand: is not a failure to perform.
+ The only failures are arg types and consistency of argumentCount."
+
+ | performSelector argumentArray arraySize index cntxSize performMethod performArgCount |
+ argumentArray := self stackTop.
+ (self isArray: argumentArray) ifFalse:[^self primitiveFail].
+
+ self successful ifTrue:
+ ["Check for enough space in thisContext to push all args"
+ arraySize := self fetchWordLengthOf: argumentArray.
+ cntxSize := self fetchWordLengthOf: activeContext.
+ self success: (self stackPointerIndex + arraySize) < cntxSize].
+ self successful ifFalse: [^nil].
+
+ performSelector := messageSelector.
+ performMethod := newMethod.
+ performArgCount := argumentCount.
+ "pop the arg array and the selector, then push the args out of the array, as if they were on the stack"
+ self popStack.
+ messageSelector := self popStack.
+
+ "Copy the arguments to the stack, and execute"
+ index := 1.
+ [index <= arraySize] whileTrue:
+ [self push: (self fetchPointer: index - 1 ofObject: argumentArray).
+ index := index + 1].
+ argumentCount := arraySize.
+
+ self fastLogSend: messageSelector.
+ self sendBreak: messageSelector + BaseHeaderSize
+ point: (self lengthOf: messageSelector)
+ receiver: receiver.
+ self findNewMethodInClass: lookupClass.
+
+ "Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances"
+ (self isCompiledMethod: newMethod)
+ ifTrue: [self success: (self argumentCountOf: newMethod) = argumentCount].
+
+ self successful
+ ifTrue: [self executeNewMethod.  "Recursive xeq affects successFlag"
+ self initPrimCall]
+ ifFalse: ["Restore the state by popping all those array entries and pushing back the selector and array, and fail"
+ self pop: argumentCount.
+ self push: messageSelector.
+ self push: argumentArray.
+ messageSelector := performSelector.
+ newMethod := performMethod.
+ argumentCount := performArgCount]
+! !
+!NewspeakInterpreter methodsFor: 'callback support' stamp: 'eem 6/6/2011 13:19' prior: 41420088!
+sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr
+ "Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf:
+ to Alien class with the supplied args.  The arguments are raw C addresses
+ and are converted to integer objects on the way."
+ | where |
+ <export: true>
+ self pushRemappableOop: (self positive32BitIntegerFor: jmpBufPtr).
+ self pushRemappableOop: (self positive32BitIntegerFor: regsPtr).
+ self pushRemappableOop: (self positive32BitIntegerFor: stackPtr).
+ self pushRemappableOop: (self positive32BitIntegerFor: thunkPtr).
+ receiver := self splObj: ClassAlien.
+ lkupClass := self fetchClassOfNonInt: receiver.
+ messageSelector := self splObj: SelectorInvokeCallback.
+ (self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
+ [(self lookupMethodNoMNUEtcInClass: lkupClass) ifFalse:
+ [^false]].
+ ((self argumentCountOf: newMethod) = 4
+ and: [primitiveFunctionPointer = 0]) ifFalse:
+ [^false].
+ self storeContextRegisters: activeContext.
+ self justActivateNewMethod.
+ where := activeContext + BaseHeaderSize + (ReceiverIndex << ShiftForWord).
+ self longAt: where + (1 << ShiftForWord) put: self popRemappableOop.
+ self longAt: where + (2 << ShiftForWord) put: self popRemappableOop.
+ self longAt: where + (3 << ShiftForWord) put: self popRemappableOop.
+ self longAt: where + (4 << ShiftForWord) put: self popRemappableOop.
+ self interpret.
+ "not reached"
+ ^true! !
+!NewspeakInterpreter methodsFor: 'callback support' stamp: 'eem 6/6/2011 13:19' prior: 41421658!
+sendInvokeCallbackContext: vmCallbackContext
+ "Send the calllback message to Alien class with the supplied arg(s).  Use either the
+ 1 arg invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf:
+ message, depending on what selector is installed in the specialObjectsArray.
+ Note that if invoking the legacy invokeCallback:stack:registers:jmpbuf: we pass the
+ vmCallbackContext as the jmpbuf argument (see reestablishContextPriorToCallback:).
+ The arguments are raw C addresses and are converted to integer objects on the way."
+ <export: true>
+ <var: #vmCallbackContext type: #'VMCallbackContext *'>
+ | relativeSP |
+ receiver := self splObj: ClassAlien.
+ lkupClass := self fetchClassOfNonInt: receiver.
+ messageSelector := self splObj: SelectorInvokeCallback.
+ (self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
+ [(self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
+ [^false]].
+ primitiveFunctionPointer ~= 0 ifTrue:
+ [^false].
+ self storeContextRegisters: activeContext.
+ self justActivateNewMethod.
+ relativeSP := stackPointer - activeContext.
+ stackPointer := activeContext + BaseHeaderSize + (ReceiverIndex * BytesPerWord).
+ self cppIf: [BytesPerWord = 8]
+ ifTrue:
+ [(self argumentCountOf: newMethod) = 4 ifTrue:
+ [self push: (self positive64BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
+ self push: (self positive64BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
+ self push: (self positive64BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
+ self push: (self positive64BitIntegerFor: vmCallbackContext asUnsignedInteger)]
+ ifFalse:
+ [(self argumentCountOf: newMethod) = 4 ifTrue:
+ [self push: (self positive32BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
+ self push: (self positive32BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
+ self push: (self positive32BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
+ self push: (self positive32BitIntegerFor: vmCallbackContext asUnsignedInteger)].
+ stackPointer := activeContext + relativeSP.
+ self assert: (self validInstructionPointer: instructionPointer inMethod: method).
+ self interpret.
+ "not reached"
+ ^true! !
+!NewspeakInterpreter methodsFor: 'debug support' stamp: 'eem 6/3/2011 15:58'!
+sendTraceLogIndex: aValue
+ <cmacro: '(aValue) (GIV(sendTraceLogIndex) = (aValue))'>
+ "N.B. sendTraceLogIndex is 8-bits"
+ ^sendTraceLogIndex := aValue bitAnd: 16rFF! !
+!NewspeakInterpreter methodsFor: 'primitive support' stamp: 'eem 6/6/2011 13:44' prior: 41439018!
+slowPrimitiveResponse
+ "NB: tpr removed the timer checks here and moved them to the primitiveExternalCall method.
+ We make the possibly unwarranted assumption that numbered prims are quick and external prims are slow."
+
+ | nArgs deltaIfSuccess savedContext |
+ <inline: true>
+ FailImbalancedPrimitives ifTrue:
+ [savedContext := activeContext.
+ nArgs := argumentCount.
+ deltaIfSuccess := stackPointer - (argumentCount * BytesPerOop) - activeContext].
+ self fastLogPrim: messageSelector.
+ self initPrimCall.
+ self dispatchFunctionPointer: primitiveFunctionPointer.
+ (FailImbalancedPrimitives
+ and: [self successful
+ and: [savedContext = activeContext]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
+ [stackPointer - activeContext ~= deltaIfSuccess ifTrue:
+ [self flag: 'Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context'.
+ self warning: 'failing primitive due to unbalanced stack'.
+ "This is necessary but insufficient; the result may still have been written to the stack.
+   At least we'll know something is wrong."
+ stackPointer := activeContext + deltaIfSuccess + (nArgs * BytesPerOop).
+ self failUnbalancedPrimitive]].
+ ^ self successful! !
+!NewspeakInterpreter methodsFor: 'debug support' stamp: 'eem 6/6/2011 12:41' prior: 41460213!
+validInstructionPointer: anInstrPointer inMethod: aMethod
+ ^anInstrPointer >= (aMethod + (self lastPointerOf: aMethod) + 1)
+  and: [anInstrPointer < (aMethod + (self byteLengthOf: aMethod))]! !
+!NewspeakInterpreterSimulator methodsFor: 'initialization' stamp: 'eem 6/3/2011 16:07' prior: 41480171!
+initialize
+
+ "Initialize the NewspeakInterpreterSimulator when running the interpreter inside
+ Smalltalk. The primary responsibility of this method is to allocate
+ Smalltalk Arrays for variables that will be declared as statically-allocated
+ global arrays in the translated code."
+
+ "initialize class variables"
+ ObjectMemory initBytesPerWord: self bytesPerWord.
+ ObjectMemory initialize.
+ NewspeakInterpreter initialize.
+ super initialize.
+
+ "Note: we must initialize ConstMinusOne differently for simulation,
+ due to the fact that the simulator works only with +ve 32-bit values"
+ ConstMinusOne := self integerObjectOf: -1.
+
+ methodCache := Array new: MethodCacheSize.
+ atCache := Array new: AtCacheTotalSize.
+ self flushMethodCache.
+ rootTable := Array new: RootTableSize.
+ weakRoots := Array new: RootTableSize + RemapBufferSize + 100.
+ remapBuffer := Array new: RemapBufferSize.
+ gcSemaphoreIndex := 0.
+ externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
+ primitiveTable := self class primitiveTable.
+ pluginList := #().
+ mappedPluginEntries := #().
+ primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
+ sendTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
+
+ "initialize NewspeakInterpreterSimulator variables used for debugging"
+ byteCount := 0.
+ sendCount := 0.
+ quitBlock := [^ self].
+ traceOn := true.
+ printSends := "printReturns := " printBytecodeAtEachStep := printContextAtEachStep := false.
+ myBitBlt := BitBltSimulator new setInterpreter: self.
+ filesOpen := OrderedCollection new.
+ headerTypeBytes := CArrayAccessor on: HeaderTypeExtraBytes.
+ transcript := Transcript.
+ displayForm := 'Display has not yet been installed' asDisplayText form.
+ ! !
+!Interpreter methodsFor: 'callback support' stamp: 'eem 6/6/2011 13:22' prior: 36202323!
+justActivateNewMethod
+ "Activate the new method but *do not* copy receiver or arguments from activeContext."
+ | methodHeader initialIP newContext tempCount needsLarge where |
+ <inline: true>
+
+ methodHeader := self headerOf: newMethod.
+ needsLarge := methodHeader bitAnd: LargeContextBit.
+ (needsLarge = 0 and: [freeContexts ~= NilContext])
+ ifTrue: [newContext := freeContexts.
+ freeContexts := self fetchPointer: 0 ofObject: newContext]
+ ifFalse: ["Slower call for large contexts or empty free list"
+ newContext := self allocateOrRecycleContext: needsLarge].
+ initialIP := ((LiteralStart + (self literalCountOfHeader: methodHeader)) * BytesPerWord) + 1.
+ tempCount := (methodHeader >> 19) bitAnd: 16r3F.
+
+ "Assume: newContext will be recorded as a root if necessary by the
+ call to newActiveContext: below, so we can use unchecked stores."
+ where := newContext + BaseHeaderSize.
+ self longAt: where + (SenderIndex << ShiftForWord) put: activeContext.
+ self longAt: where + (InstructionPointerIndex << ShiftForWord) put: (self integerObjectOf: initialIP).
+ self longAt: where + (StackPointerIndex << ShiftForWord) put: (self integerObjectOf: tempCount).
+ self longAt: where + (MethodIndex << ShiftForWord) put: newMethod.
+
+ "Set the receiver..."
+ self longAt: where + (ReceiverIndex << ShiftForWord) put: receiver.
+
+ "clear all args and temps to nil in case it has been recycled"
+ needsLarge := nilObj.  "needsLarge here used just as faster (register?) temp"
+ ReceiverIndex + 1 to: tempCount + ReceiverIndex do:
+ [:i | self longAt: where + (i << ShiftForWord) put: needsLarge].
+ reclaimableContextCount := reclaimableContextCount + 1.
+
+ activeContext := newContext.
+ (self oop: newContext isLessThan: youngStart) ifTrue:
+ [self beRootIfOld: newContext].
+ self fetchContextRegisters: activeContext! !
+!Interpreter methodsFor: 'callback support' stamp: 'eem 6/6/2011 13:20' prior: 40443323!
+sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr
+ "Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf:
+ to Alien class with the supplied args.  The arguments are raw C addresses
+ and are converted to integer objects on the way."
+ | where |
+ <export: true>
+ self pushRemappableOop: (self positive32BitIntegerFor: jmpBufPtr).
+ self pushRemappableOop: (self positive32BitIntegerFor: regsPtr).
+ self pushRemappableOop: (self positive32BitIntegerFor: stackPtr).
+ self pushRemappableOop: (self positive32BitIntegerFor: thunkPtr).
+ receiver := self splObj: ClassAlien.
+ lkupClass := self fetchClassOfNonInt: receiver.
+ messageSelector := self splObj: SelectorInvokeCallback.
+ (self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
+ [(self lookupMethodNoMNUEtcInClass: lkupClass) ifFalse:
+ [^false]].
+ primitiveIndex ~= 0 ifTrue:
+ [^false].
+ self storeContextRegisters: activeContext.
+ self justActivateNewMethod.
+ where := activeContext + BaseHeaderSize + (ReceiverIndex << ShiftForWord).
+ self longAt: where + (1 << ShiftForWord) put: self popRemappableOop.
+ self longAt: where + (2 << ShiftForWord) put: self popRemappableOop.
+ self longAt: where + (3 << ShiftForWord) put: self popRemappableOop.
+ self longAt: where + (4 << ShiftForWord) put: self popRemappableOop.
+ self interpret.
+ "not reached"
+ ^true! !
+!LargeIntegersPlugin methodsFor: 'C core' stamp: 'nice 6/4/2011 00:10' prior: 41015293!
+cdigitMontgomery: pBytesFirst
+ len: firstLen
+ times: pBytesSecond
+ len: secondLen
+ modulo: pBytesThird
+ len: thirdLen
+ mInvModB: mInv
+ into: pBytesRes
+
+ | u limit1 limit2 limit3 accum lastByte |
+ <var: #pBytesFirst type: 'unsigned char * '>
+ <var: #pBytesSecond type: 'unsigned char * '>
+ <var: #pBytesThird type: 'unsigned char * '>
+ <var: #pBytesRes type: 'unsigned char * '>
+ <var: #accum type: 'usqInt '>
+ <var: #u type: 'unsigned char  '>
+ <var: #lastByte type: 'unsigned char  '>
+ limit1 := firstLen - 1.
+ limit2 := secondLen - 1.
+ limit3 := thirdLen - 1.
+ lastByte := 0.
+ 0 to: limit1 do:
+ [:i |
+ accum := (pBytesRes at: 0) + ((pBytesFirst at: i)*(pBytesSecond at: 0)).
+ u := accum * mInv bitAnd: 255.
+ accum :=  accum + (u * (pBytesThird at: 0)).
+ 1 to: limit2 do: [:k |
+ accum := (accum >> 8) + (pBytesRes at: k) + ((pBytesFirst at: i)*(pBytesSecond at: k)) + (u * (pBytesThird at: k)).
+ pBytesRes at: k-1 put: (accum bitAnd: 255)].
+ secondLen to: limit3 do: [:k |
+ accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)).
+ pBytesRes at: k-1 put: (accum bitAnd: 255)].
+ accum := (accum >> 8) + lastByte.
+ pBytesRes at: limit3 put: (accum bitAnd: 255).
+ lastByte := accum >> 8].
+ firstLen to: limit3 do:
+ [:i |
+ accum := (pBytesRes at: 0).
+ u := accum * mInv bitAnd: 255.
+ accum := accum + (u * (pBytesThird at: 0)).
+ 1 to: limit3 do: [:k |
+ accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)).
+ pBytesRes at: k-1 put: (accum bitAnd: 255)].
+ accum := (accum >> 8) + lastByte.
+ pBytesRes at: limit3 put: (accum bitAnd: 255).
+ lastByte := accum >> 8].
+ (lastByte = 0 and: [(self cDigitCompare: pBytesThird with: pBytesRes len: thirdLen) = 1]) ifFalse: [
+ "self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes"
+ accum := 0.
+ 0 to: limit3 do:
+ [:i |
+ accum := accum + (pBytesRes at: i) - (pBytesThird at: i).
+ pBytesRes at: i put: accum - (accum // 256 * 256).
+ "sign-tolerant form of (z bitAnd: 255)"
+ accum := accum // 256]].! !
+!InterpreterSimulatorMSB64 methodsFor: 'as yet unclassified' stamp: 'di 6/9/2004 12:17' prior: 41608151!
+byteSwapped: w
+ "Return the given integer with its bytes in the reverse order."
+
+ ^ (super byteSwapped: ((w bitShift: -32) bitAnd: 16rFFFFFFFF)) +
+  ((super byteSwapped: (w bitAnd: 16rFFFFFFFF)) bitShift: 32)! !
+!InterpreterSimulatorMSB64 methodsFor: 'as yet unclassified' stamp: 'di 7/3/2004 10:40' prior: 41608469!
+long32At: byteAddress
+ "Return the 32-bit word at byteAddress which must be 0 mod 4."
+
+ ^ super longAt: byteAddress! !
+!InterpreterSimulatorMSB64 methodsFor: 'as yet unclassified' stamp: 'di 7/3/2004 10:41' prior: 41608693!
+long32At: byteAddress put: a32BitValue
+ "Store the 32-bit value at byteAddress which must be 0 mod 4."
+
+ super longAt: byteAddress put: a32BitValue! !
+!InterpreterSimulatorMSB64 methodsFor: 'as yet unclassified' stamp: 'di 6/9/2004 15:43' prior: 41608949!
+longAt: byteAddress
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+
+ ^ ((super longAt: byteAddress) bitShift: 32) bitOr: (super longAt: byteAddress + 4)! !
+!InterpreterSimulatorMSB64 methodsFor: 'as yet unclassified' stamp: 'di 6/9/2004 15:48' prior: 41609221!
+longAt: byteAddress put: a64BitValue
+ "Note: Adjusted for Smalltalk's 1-based array indexing."
+
+ super longAt: byteAddress put: (a64BitValue bitShift: -32).
+ super longAt: byteAddress + 4 put: (a64BitValue bitAnd: 16rFFFFFFFF).
+ ^ a64BitValue! !
+!InterpreterSimulatorLSB64 methodsFor: 'as yet unclassified' stamp: 'di 6/13/2004 10:56' prior: 41611584!
+long32At: byteAddress
+
+ "Return the 32-bit word at byteAddress which must be 0 mod 4."
+ | lowBits long |
+ lowBits := byteAddress bitAnd: 4.
+ long := self longAt: byteAddress - lowBits.
+ ^ lowBits = 4
+ ifTrue: [ long bitShift: -32 ]
+ ifFalse: [ long bitAnd: 16rFFFFFFFF ].
+! !
+!InterpreterSimulatorLSB64 methodsFor: 'as yet unclassified' stamp: 'di 6/13/2004 11:01' prior: 41611968!
+long32At: byteAddress put: a32BitValue
+ "Store the 32-bit value at byteAddress which must be 0 mod 4."
+ | lowBits long64 longAddress |
+ lowBits := byteAddress bitAnd: 4.
+ lowBits = 0
+ ifTrue:
+ [ "storing into LS word"
+ long64 := self longAt: byteAddress.
+ self longAt: byteAddress
+ put: ((long64 bitAnd: 16rFFFFFFFF00000000) bitOr: a32BitValue)
+ ]
+ ifFalse:
+ [longAddress := byteAddress - 4.
+ long64 := self longAt: longAddress.
+ self longAt: longAddress
+ put: ((long64 bitAnd: 16rFFFFFFFF) bitOr: (a32BitValue bitShift: 32))
+ ]! !
+!VMMaker methodsFor: 'generate sources' stamp: 'eem 6/3/2011 08:54' prior: 39439415!
+interpreterClass
+
+ ^(Smalltalk classNamed: interpreterClassName) ifNotNil:
+ [:interpreterClass| interpreterClass translationClass]! !
+!VMMaker methodsFor: 'initialize' stamp: 'eem 6/3/2011 09:09' prior: 39416634!
+providedPlugins
+ "generate the list by asking the InterpreterPlugins"
+ ^ ((InterpreterPlugin allSubclasses
+ select: [:cl | cl shouldBeTranslatedFor: platformName])
+ collect: [:cl | cl name]) asSortedCollection! !
+
+"VMMaker"!
+
+----QUIT----{6 June 2011 . 2:41:50 pm} VMMaker-Squeak4.1.image priorSource: 8058284!
\ No newline at end of file

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

Modified: branches/Cog/nssrc/plugins/LargeIntegers/LargeIntegers.c
===================================================================
--- branches/Cog/nssrc/plugins/LargeIntegers/LargeIntegers.c 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/nssrc/plugins/LargeIntegers/LargeIntegers.c 2011-06-06 22:07:11 UTC (rev 2392)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.68 uuid: 1fd12e1a-c0b3-4d41-91bb-26f029240bfe
+ SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
    from
- LargeIntegersPlugin VMMaker.oscog-eem.68 uuid: 1fd12e1a-c0b3-4d41-91bb-26f029240bfe
+ LargeIntegersPlugin VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
  */
-static char __buildInfo[] = "LargeIntegersPlugin VMMaker.oscog-eem.68 uuid: 1fd12e1a-c0b3-4d41-91bb-26f029240bfe " __DATE__ ;
+static char __buildInfo[] = "LargeIntegersPlugin VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2 " __DATE__ ;
 
 
 
@@ -124,9 +124,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "LargeIntegers v1.5 VMMaker.oscog-eem.68 (i)"
+ "LargeIntegers v1.5 VMMaker.oscog-eem.72 (i)"
 #else
- "LargeIntegers v1.5 VMMaker.oscog-eem.68 (e)"
+ "LargeIntegers v1.5 VMMaker.oscog-eem.72 (e)"
 #endif
 ;
 static const int  orOpIndex = 1;
@@ -906,17 +906,19 @@
 static void
 cdigitMontgomerylentimeslenmodulolenmInvModBinto(unsigned char *  pBytesFirst, sqInt firstLen, unsigned char *  pBytesSecond, sqInt secondLen, unsigned char *  pBytesThird, sqInt thirdLen, sqInt mInv, unsigned char *  pBytesRes)
 {
- sqInt accum;
+ usqInt  accum;
  sqInt i;
  sqInt k;
+ unsigned char   lastByte;
  sqInt limit1;
  sqInt limit2;
  sqInt limit3;
- sqInt u;
+ unsigned char   u;
 
  limit1 = firstLen - 1;
  limit2 = secondLen - 1;
  limit3 = thirdLen - 1;
+ lastByte = 0;
  for (i = 0; i <= limit1; i += 1) {
  accum = (pBytesRes[0]) + ((pBytesFirst[i]) * (pBytesSecond[0]));
  u = (accum * mInv) & 255;
@@ -929,8 +931,9 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
  for (i = firstLen; i <= limit3; i += 1) {
  accum = pBytesRes[0];
@@ -940,11 +943,21 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
- if (!((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1)) {
- cDigitSublenwithleninto(pBytesThird, thirdLen, pBytesRes, thirdLen, pBytesRes);
+ if (!((lastByte == 0)
+ && ((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1))) {
+
+ /* self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes */
+
+ accum = 0;
+ for (i = 0; i <= limit3; i += 1) {
+ accum = (accum + (pBytesRes[i])) - (pBytesThird[i]);
+ pBytesRes[i] = (accum - ((((sqInt) accum >> 8)) * 256));
+ accum = ((sqInt) accum >> 8);
+ }
  }
 }
 
@@ -1539,10 +1552,11 @@
 static sqInt
 digitMontgomerytimesmodulomInvModB(sqInt firstLarge, sqInt secondLarge, sqInt thirdLarge, sqInt mInv)
 {
- sqInt accum;
+ usqInt  accum;
  sqInt firstLen;
  sqInt i;
  sqInt k;
+ unsigned char   lastByte;
  sqInt limit1;
  sqInt limit2;
  sqInt limit3;
@@ -1553,7 +1567,7 @@
  sqInt prod;
  sqInt secondLen;
  sqInt thirdLen;
- sqInt u;
+ unsigned char   u;
 
  firstLen = interpreterProxy->slotSizeOf(firstLarge);
  secondLen = interpreterProxy->slotSizeOf(secondLarge);
@@ -1583,6 +1597,7 @@
  limit1 = firstLen - 1;
  limit2 = secondLen - 1;
  limit3 = thirdLen - 1;
+ lastByte = 0;
  for (i = 0; i <= limit1; i += 1) {
  accum = (pBytesRes[0]) + ((pBytesFirst[i]) * (pBytesSecond[0]));
  u = (accum * mInv) & 255;
@@ -1595,8 +1610,9 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
  for (i = firstLen; i <= limit3; i += 1) {
  accum = pBytesRes[0];
@@ -1606,11 +1622,21 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
- if (!((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1)) {
- cDigitSublenwithleninto(pBytesThird, thirdLen, pBytesRes, thirdLen, pBytesRes);
+ if (!((lastByte == 0)
+ && ((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1))) {
+
+ /* self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes */
+
+ accum = 0;
+ for (i = 0; i <= limit3; i += 1) {
+ accum = (accum + (pBytesRes[i])) - (pBytesThird[i]);
+ pBytesRes[i] = (accum - ((((sqInt) accum >> 8)) * 256));
+ accum = ((sqInt) accum >> 8);
+ }
  }
  return normalizePositive(prod);
 }
@@ -1751,14 +1777,20 @@
 {
  sqInt firstLen;
  sqInt firstNeg;
+ sqInt i;
  sqInt larger;
  sqInt largerLen;
+ sqInt limit;
  sqInt neg;
+ unsigned char *  pByteLarge;
+ unsigned char *  pByteRes;
+ unsigned char *  pByteSmall;
  sqInt res;
  sqInt resLen;
  sqInt secondLen;
  sqInt smaller;
  sqInt smallerLen;
+ sqInt z;
 
  firstNeg = (interpreterProxy->fetchClassOf(firstInteger)) == (interpreterProxy->classLargeNegativeInteger());
  firstLen = interpreterProxy->slotSizeOf(firstInteger);
@@ -1794,7 +1826,26 @@
  : interpreterProxy->classLargePositiveInteger()), resLen);
  larger = interpreterProxy->popRemappableOop();
  smaller = interpreterProxy->popRemappableOop();
- cDigitSublenwithleninto(interpreterProxy->firstIndexableField(smaller), smallerLen, interpreterProxy->firstIndexableField(larger), largerLen, interpreterProxy->firstIndexableField(res));
+ /* begin cDigitSub:len:with:len:into: */
+ pByteSmall = interpreterProxy->firstIndexableField(smaller);
+ pByteLarge = interpreterProxy->firstIndexableField(larger);
+ pByteRes = interpreterProxy->firstIndexableField(res);
+
+ /* Loop invariant is -1<=z<=1 */
+
+ z = 0;
+ limit = smallerLen - 1;
+ for (i = 0; i <= limit; i += 1) {
+ z = (z + (pByteLarge[i])) - (pByteSmall[i]);
+ pByteRes[i] = (z - ((((sqInt) z >> 8)) * 256));
+ z = ((sqInt) z >> 8);
+ }
+ limit = largerLen - 1;
+ for (i = smallerLen; i <= limit; i += 1) {
+ z += pByteLarge[i];
+ pByteRes[i] = (z - ((((sqInt) z >> 8)) * 256));
+ z = ((sqInt) z >> 8);
+ }
  return (neg
  ? normalizeNegative(res)
  : normalizePositive(res));
@@ -2975,12 +3026,13 @@
 EXPORT(sqInt)
 primMontgomeryTimesModulo(void)
 {
- sqInt accum;
+ usqInt  accum;
  sqInt firstInteger;
  sqInt firstLarge;
  sqInt firstLen;
  sqInt i;
  sqInt k;
+ unsigned char   lastByte;
  sqInt limit1;
  sqInt limit2;
  sqInt limit3;
@@ -2996,7 +3048,7 @@
  sqInt thirdLarge;
  sqInt thirdLen;
  sqInt thirdModuloInteger;
- sqInt u;
+ unsigned char   u;
  sqInt _return_value;
 
  interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(2), "Integer"));
@@ -3081,6 +3133,7 @@
  limit1 = firstLen - 1;
  limit2 = secondLen - 1;
  limit3 = thirdLen - 1;
+ lastByte = 0;
  for (i = 0; i <= limit1; i += 1) {
  accum = (pBytesRes[0]) + ((pBytesFirst[i]) * (pBytesSecond[0]));
  u = (accum * smallInverseInteger) & 255;
@@ -3093,8 +3146,9 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
  for (i = firstLen; i <= limit3; i += 1) {
  accum = pBytesRes[0];
@@ -3104,11 +3158,21 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
- if (!((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1)) {
- cDigitSublenwithleninto(pBytesThird, thirdLen, pBytesRes, thirdLen, pBytesRes);
+ if (!((lastByte == 0)
+ && ((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1))) {
+
+ /* self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes */
+
+ accum = 0;
+ for (i = 0; i <= limit3; i += 1) {
+ accum = (accum + (pBytesRes[i])) - (pBytesThird[i]);
+ pBytesRes[i] = (accum - ((((sqInt) accum >> 8)) * 256));
+ accum = ((sqInt) accum >> 8);
+ }
  }
  _return_value = normalizePositive(prod);
 l1: /* end digitMontgomery:times:modulo:mInvModB: */;

Modified: branches/Cog/nssrc/vm/gcc3x-interp.c
===================================================================
--- branches/Cog/nssrc/vm/gcc3x-interp.c 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/nssrc/vm/gcc3x-interp.c 2011-06-06 22:07:11 UTC (rev 2392)
@@ -2,11 +2,11 @@
 
 
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.70 uuid: 36b63465-1b05-401f-bcb2-f9cae49422b8
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
    from
- NewspeakInterpreter VMMaker.oscog-eem.70 uuid: 36b63465-1b05-401f-bcb2-f9cae49422b8
+ NewspeakInterpreter VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
  */
-static char __buildInfo[] = "NewspeakInterpreter VMMaker.oscog-eem.70 uuid: 36b63465-1b05-401f-bcb2-f9cae49422b8 " __DATE__ ;
+static char __buildInfo[] = "NewspeakInterpreter VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2 " __DATE__ ;
 char *__interpBuildInfo = __buildInfo;
 
 
@@ -213,6 +213,8 @@
 #define ProcessListsIndex 0
 #define ProcessSignalingLowSpace 22
 #define ReceiverIndex 5
+#define RecordPrimTrace 0
+#define RecordSendTrace 0
 #define RemapBufferSize 25
 #define RootBit 0x40000000
 #define RootTableRedZone 2400
@@ -247,6 +249,7 @@
 #define TheInterruptSemaphore 30
 #define TheLowSpaceSemaphore 17
 #define TheTimerSemaphore 29
+#define TraceLogSize 256
 #define TrueObject 2
 #define TypeMask 0x3
 #define Upward 3
@@ -332,6 +335,8 @@
 static sqInt doPrimitiveModby(sqInt rcvr, sqInt arg);
 sqInt doSignalSemaphoreWithIndex(sqInt index);
 static sqInt dummyReferToProxy(void);
+sqInt dumpPrimTraceLog(void);
+sqInt dumpSendTraceLog(void);
 static sqInt existImmutableReferencesToForwardedInRangeFromto(sqInt memStart, sqInt memEnd);
 static sqInt externalQuickPrimitiveResponse(void);
 sqInt failed(void);
@@ -438,6 +443,8 @@
 static sqInt lowestFreeAfter(sqInt chunk);
 sqInt makePointwithxValueyValue(sqInt xValue, sqInt yValue);
 static void mapPointersInObjectsFromto(sqInt memStart, sqInt memEnd);
+static sqInt mapTraceLogs(void);
+static sqInt markAndTraceTraceLogs(void);
 void markAndTrace(sqInt oop);
 static void markPhase(void);
 sqInt maybeSplObj(sqInt index);
@@ -694,6 +701,7 @@
 static sqInt reverseDisplayFromto(sqInt startIndex, sqInt endIndex);
 static sqInt rewriteMethodCacheSelclassprimIndex(sqInt selector, sqInt class, sqInt localPrimIndex);
 static sqInt rewriteMethodCacheSelclassprimIndexprimFunction(sqInt selector, sqInt class, sqInt localPrimIndex, void *localPrimAddress);
+static sqInt safePrintStringOf(sqInt oop);
 EXPORT(sqInt) sendInvokeCallbackContext(VMCallbackContext *vmCallbackContext);
 EXPORT(sqInt) sendInvokeCallbackStackRegistersJmpbuf(sqInt thunkPtr, sqInt stackPtr, sqInt regsPtr, sqInt jmpBufPtr);
 sqInt setBreakSelector(char *aString);
@@ -788,8 +796,10 @@
 _iss sqInt nextPollTick;
 _iss sqInt allocationsBetweenGCs;
 _iss usqInt fwdTableNext;
+_iss unsigned char sendTraceLogIndex;
 _iss sqInt freeContexts;
 _iss sqInt lastHash;
+_iss unsigned char primTraceLogIndex;
 _iss sqInt lowSpaceThreshold;
 _iss usqInt compStart;
 _iss sqInt extraRootCount;
@@ -844,6 +854,8 @@
 _iss sqInt remapBuffer[RemapBufferSize + 1 /* 26 */];
 _iss sqInt rootTable[RootTableSize + 1 /* 2501 */];
 _iss sqInt atCache[65];
+_iss sqInt sendTraceLog[256];
+_iss sqInt primTraceLog[256];
 _iss sqInt* extraRoots[ExtraRootSize + 1 /* 2049 */];
 _iss void *externalPrimitiveTable[1025];
 _iss sqInt weakRoots[WeakRootTableSize + 1 /* 2626 */];
@@ -1452,7 +1464,7 @@
  0 };
 char * breakSelector;
 sqInt breakSelectorLength = -1;
-const char *interpreterVersion = "Newspeak Virtual Machine [NewspeakInterpreter VMMaker.oscog-eem.70]";
+const char *interpreterVersion = "Newspeak Virtual Machine NewspeakInterpreter_VMMaker.oscog-eem.72";
 volatile int sendTrace;
 
 
@@ -1460,8 +1472,10 @@
 #define dispatchFunctionPointer(aFunctionPointer) (aFunctionPointer)()
 #define flush() fflush(stdout)
 #define memory() memory
+#define primTraceLogIndex(aValue) (GIV(primTraceLogIndex) = (aValue))
 #define printFloat(f) printf("%g", f)
 #define remapBufferCount() GIV(remapBufferCount)
+#define sendTraceLogIndex(aValue) (GIV(sendTraceLogIndex) = (aValue))
 #define validate() 0
 
 
@@ -4058,7 +4072,12 @@
  sqInt tmp;
 
  VM_LABEL(0commonSend);
- sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), longAtPointer(localSP - (GIV(argumentCount) * BytesPerWord)));
+ /* begin fastLogSend: */
+ if (RecordSendTrace) {
+ GIV(sendTraceLog)[GIV(sendTraceLogIndex)] = GIV(messageSelector);
+ sendTraceLogIndex(GIV(sendTraceLogIndex) + 1);
+ }
+ sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), longAtPointer(localSP - (GIV(argumentCount) * BytesPerWord)));
  /* begin internalFindNewMethod */
  VM_LABEL(0internalFindNewMethod);
  /* begin lookupInMethodCacheSel:class: */
@@ -4153,6 +4172,11 @@
  nArgs = GIV(argumentCount);
  deltaIfSuccess = (GIV(stackPointer) - (GIV(argumentCount) * BytesPerOop)) - GIV(activeContext);
  }
+ /* begin fastLogPrim: */
+ if (RecordPrimTrace) {
+ GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
+ primTraceLogIndex(GIV(primTraceLogIndex) + 1);
+ }
  /* begin initPrimCall */
  GIV(primFailCode) = 0;
  dispatchFunctionPointer(primitiveFunctionPointer);
@@ -10076,6 +10100,66 @@
 }
 
 
+/* The prim trace log is a circular buffer of entries. If there is
+ an entry at primTraceLogIndex \\ PrimTraceLogSize it has entries.
+ If there is something at primTraceLogIndex it has wrapped. */
+
+sqInt
+dumpPrimTraceLog(void)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt i;
+    sqInt remainder;
+
+ if ((GIV(primTraceLog)[(((remainder = (GIV(primTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder + TraceLogSize
+ : remainder)]) == 0) {
+ return null;
+ }
+ if ((GIV(primTraceLog)[GIV(primTraceLogIndex)]) != 0) {
+ for (i = GIV(primTraceLogIndex); i <= (TraceLogSize - 1); i += 1) {
+ safePrintStringOf(GIV(primTraceLog)[i]);
+ /* begin cr */
+ printf("\n");
+ }
+ }
+ for (i = 0; i <= (GIV(primTraceLogIndex) - 1); i += 1) {
+ safePrintStringOf(GIV(primTraceLog)[i]);
+ /* begin cr */
+ printf("\n");
+ }
+}
+
+
+/* The send trace log is a circular buffer of entries. If there is
+ an entry at sendTraceLogIndex \\ PrimTraceLogSize it has entries.
+ If there is something at sendTraceLogIndex it has wrapped. */
+
+sqInt
+dumpSendTraceLog(void)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt i;
+    sqInt remainder;
+
+ if ((GIV(sendTraceLog)[(((remainder = (GIV(sendTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder + TraceLogSize
+ : remainder)]) == 0) {
+ return null;
+ }
+ if ((GIV(sendTraceLog)[GIV(sendTraceLogIndex)]) != 0) {
+ for (i = GIV(sendTraceLogIndex); i <= (TraceLogSize - 1); i += 1) {
+ safePrintStringOf(GIV(sendTraceLog)[i]);
+ /* begin cr */
+ printf("\n");
+ }
+ }
+ for (i = 0; i <= (GIV(sendTraceLogIndex) - 1); i += 1) {
+ safePrintStringOf(GIV(sendTraceLog)[i]);
+ /* begin cr */
+ printf("\n");
+ }
+}
+
+
 /* Answer if any immutable objects refer to any forwarded objects so that the
  become: primitives can fail if a become would update a reference from an
  immutable object.
@@ -13340,7 +13424,6 @@
 sqInt
 loadInitialContext(void)
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
-    sqInt activeCntx;
     sqInt proc;
     sqInt sched;
     sqInt tmp;
@@ -13353,13 +13436,12 @@
  }
  /* begin fetchContextRegisters: */
  VM_LABEL(1fetchContextRegisters);
- activeCntx = GIV(activeContext);
- tmp = longAt((activeCntx + BaseHeaderSize) + (MethodIndex << ShiftForWord));
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (MethodIndex << ShiftForWord));
  if ((tmp & 1)) {
 
  /* if the MethodIndex field is an integer, activeCntx is a block context */
 
- tmp = longAt((activeCntx + BaseHeaderSize) + (HomeIndex << ShiftForWord));
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (HomeIndex << ShiftForWord));
  if (tmp < GIV(youngStart)) {
  beRootIfOld(tmp);
  }
@@ -13368,7 +13450,7 @@
 
  /* otherwise, it is a method context and is its own home context  */
 
- tmp = activeCntx;
+ tmp = GIV(activeContext);
  }
  GIV(theHomeContext) = tmp;
  GIV(receiver) = longAt((tmp + BaseHeaderSize) + (ReceiverIndex << ShiftForWord));
@@ -13379,13 +13461,13 @@
  -1 because it gets incremented BEFORE fetching currentByte  */
 
  GIV(method) = longAt((tmp + BaseHeaderSize) + (MethodIndex << ShiftForWord));
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
 
  /* the stack pointer is a pointer variable also... */
 
  GIV(instructionPointer) = ((GIV(method) + tmp) + BaseHeaderSize) - 2;
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
- GIV(stackPointer) = (activeCntx + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
+ GIV(stackPointer) = (GIV(activeContext) + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
  GIV(reclaimableContextCount) = 0;
 }
 
@@ -13478,6 +13560,11 @@
  GIV(remapBufferCount) -= 1;
  currentClass = oop;
  GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorCannotInterpret << ShiftForWord));
+ /* begin fastLogSend: */
+ if (RecordSendTrace) {
+ GIV(sendTraceLog)[GIV(sendTraceLogIndex)] = GIV(messageSelector);
+ sendTraceLogIndex(GIV(sendTraceLogIndex) + 1);
+ }
  sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), null);
  return lookupMethodInClass(longAt((currentClass + BaseHeaderSize) + (SuperclassIndex << ShiftForWord)));
  }
@@ -13544,6 +13631,14 @@
  GIV(remapBufferCount) -= 1;
  rclass = oop1;
  GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorDoesNotUnderstand << ShiftForWord));
+ if (RecordSendTrace) {
+ /* begin fastLogSend: */
+ if (RecordSendTrace) {
+ GIV(sendTraceLog)[GIV(sendTraceLogIndex)] = GIV(messageSelector);
+ sendTraceLogIndex(GIV(sendTraceLogIndex) + 1);
+ }
+ }
+ sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), null);
  return lookupMethodInClass(rclass);
 }
 
@@ -13735,6 +13830,7 @@
  GIV(remapBuffer)[i1] = (remap(oop1));
  }
  }
+ mapTraceLogs();
  for (i = 1; i <= GIV(extraRootCount); i += 1) {
  oop = (GIV(extraRoots)[i])[0];
  if (!((oop & 1))) {
@@ -13765,6 +13861,100 @@
 }
 
 
+/* The prim and send trace logs are circular buffers of selectors. If there
+ is an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has
+ entries. If there is something at primTraceLogIndex it has wrapped. */
+
+static sqInt
+mapTraceLogs(void)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt i;
+    sqInt limit;
+    sqInt remainder;
+    sqInt remainder1;
+    sqInt selector;
+
+ limit = (((remainder = (GIV(primTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder + TraceLogSize
+ : remainder);
+ if ((GIV(primTraceLog)[limit]) == 0) {
+ return null;
+ }
+ if ((GIV(primTraceLog)[GIV(primTraceLogIndex)]) != 0) {
+ limit = TraceLogSize - 1;
+ }
+ for (i = 0; i <= limit; i += 1) {
+ selector = GIV(primTraceLog)[i];
+ if (!((selector & 1))) {
+ GIV(primTraceLog)[i] = (remap(selector));
+ }
+ }
+ limit = (((remainder1 = (GIV(sendTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder1 + TraceLogSize
+ : remainder1);
+ if ((GIV(sendTraceLog)[limit]) == 0) {
+ return null;
+ }
+ if ((GIV(sendTraceLog)[GIV(sendTraceLogIndex)]) != 0) {
+ limit = TraceLogSize - 1;
+ }
+ for (i = 0; i <= limit; i += 1) {
+ selector = GIV(sendTraceLog)[i];
+ if (!((selector & 1))) {
+ GIV(sendTraceLog)[i] = (remap(selector));
+ }
+ }
+}
+
+
+/* The prim and send trace logs are circular buffers of selectors. If there
+ is an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has
+ entries. If there is something at primTraceLogIndex it has wrapped. */
+
+static sqInt
+markAndTraceTraceLogs(void)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt i;
+    sqInt limit;
+    sqInt remainder;
+    sqInt remainder1;
+    sqInt selector;
+
+ if (RecordPrimTrace) {
+ limit = (((remainder = (GIV(primTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder + TraceLogSize
+ : remainder);
+ if ((GIV(primTraceLog)[limit]) != 0) {
+ if ((GIV(primTraceLog)[GIV(primTraceLogIndex)]) != 0) {
+ limit = TraceLogSize - 1;
+ }
+ for (i = 0; i <= limit; i += 1) {
+ selector = GIV(primTraceLog)[i];
+ if (!((selector & 1))) {
+ markAndTrace(selector);
+ }
+ }
+ }
+ }
+ if (RecordSendTrace) {
+ limit = (((remainder1 = (GIV(sendTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder1 + TraceLogSize
+ : remainder1);
+ if ((GIV(sendTraceLog)[limit]) != 0) {
+ if ((GIV(sendTraceLog)[GIV(sendTraceLogIndex)]) != 0) {
+ limit = TraceLogSize - 1;
+ }
+ for (i = 0; i <= limit; i += 1) {
+ selector = GIV(sendTraceLog)[i];
+ if (!((selector & 1))) {
+ markAndTrace(selector);
+ }
+ }
+ }
+ }
+}
+
+
 /* Mark all objects reachable from the given one.
  Trace from the given object even if it is old.
  Do not trace if it is already marked.
@@ -14170,6 +14360,7 @@
  markAndTrace(oop1);
  }
  }
+ markAndTraceTraceLogs();
 
  /* trace the roots */
 
@@ -17864,6 +18055,11 @@
  nArgs = GIV(argumentCount);
  deltaIfSuccess = (GIV(stackPointer) - (GIV(argumentCount) * BytesPerOop)) - GIV(activeContext);
  }
+ /* begin fastLogPrim: */
+ if (RecordPrimTrace) {
+ GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
+ primTraceLogIndex(GIV(primTraceLogIndex) + 1);
+ }
  /* begin initPrimCall */
  GIV(primFailCode) = 0;
  dispatchFunctionPointer(primitiveFunctionPointer);
@@ -23476,6 +23672,11 @@
  index += 1;
  }
  GIV(argumentCount) = arraySize;
+ /* begin fastLogSend: */
+ if (RecordSendTrace) {
+ GIV(sendTraceLog)[GIV(sendTraceLogIndex)] = GIV(messageSelector);
+ sendTraceLogIndex(GIV(sendTraceLogIndex) + 1);
+ }
  sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), GIV(receiver));
  findNewMethodInClass(lookupClass);
  if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
@@ -28921,6 +29122,56 @@
 }
 
 
+/* Version of printStringOf: that copes with forwarding during garbage
+ collection.
+ */
+
+static sqInt
+safePrintStringOf(sqInt oop)
+{
+    sqInt cnt;
+    sqInt fmt;
+    sqInt fwdBlock;
+    sqInt header;
+    sqInt header1;
+    sqInt i;
+
+ if ((oop & 1)) {
+ return null;
+ }
+ if (!(((oop >= memory) && (oop <= GIV(freeBlock))))) {
+ return null;
+ }
+ if ((oop & (BytesPerWord - 1)) != 0) {
+ return null;
+ }
+ /* begin headerWhileForwardingOf: */
+ header1 = longAt(oop);
+ if ((header1 & MarkBit) != 0) {
+
+ /* oop is forwarded; get its real header from its forwarding table entry */
+
+ fwdBlock = (header1 & AllButMarkBitAndTypeMask) << 1;
+ assert(fwdBlockValid(fwdBlock));
+ header1 = longAt(fwdBlock + BytesPerWord);
+ }
+ header = header1;
+ fmt = (((usqInt) header) >> 8) & 15;
+ if (fmt < 8) {
+ return null;
+ }
+ cnt = ((100 < (lengthOfbaseHeaderformat(oop, header, fmt))) ? 100 : (lengthOfbaseHeaderformat(oop, header, fmt)));
+ i = 0;
+ while (i < cnt) {
+ /* begin printChar: */
+ putchar(byteAt((oop + BaseHeaderSize) + i));
+ i += 1;
+ }
+ flush();
+ return oop;
+}
+
+
 /* Send the calllback message to Alien class with the supplied arg(s). Use
  either the
  1 arg invokeCallbackContext: or the 4 arg
@@ -28935,7 +29186,6 @@
 EXPORT(sqInt)
 sendInvokeCallbackContext(VMCallbackContext *vmCallbackContext)
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
-    sqInt activeCntx;
     sqInt ccIndex;
     sqInt i;
     sqInt initialIP;
@@ -28950,6 +29200,7 @@
     sqInt object5;
     sqInt object6;
     sqInt object7;
+    sqInt relativeSP;
     sqInt sp;
     sqInt sp1;
     sqInt sp2;
@@ -29021,6 +29272,44 @@
  }
  GIV(reclaimableContextCount) += 1;
  GIV(activeContext) = newContext;
+ if ((((usqInt) newContext)) < (((usqInt) GIV(youngStart)))) {
+ beRootIfOld(newContext);
+ }
+ /* begin fetchContextRegisters: */
+ VM_LABEL(15fetchContextRegisters);
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (MethodIndex << ShiftForWord));
+ if ((tmp & 1)) {
+
+ /* if the MethodIndex field is an integer, activeCntx is a block context */
+
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (HomeIndex << ShiftForWord));
+ if (tmp < GIV(youngStart)) {
+ beRootIfOld(tmp);
+ }
+ }
+ else {
+
+ /* otherwise, it is a method context and is its own home context  */
+
+ tmp = GIV(activeContext);
+ }
+ GIV(theHomeContext) = tmp;
+ GIV(receiver) = longAt((tmp + BaseHeaderSize) + (ReceiverIndex << ShiftForWord));
+
+ /* the instruction pointer is a pointer variable equal to
+ method oop + ip + BaseHeaderSize
+ -1 for 0-based addressing of fetchByte
+ -1 because it gets incremented BEFORE fetching currentByte  */
+
+ GIV(method) = longAt((tmp + BaseHeaderSize) + (MethodIndex << ShiftForWord));
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
+
+ /* the stack pointer is a pointer variable also... */
+
+ GIV(instructionPointer) = ((GIV(method) + tmp) + BaseHeaderSize) - 2;
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
+ GIV(stackPointer) = (GIV(activeContext) + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ relativeSP = GIV(stackPointer) - GIV(activeContext);
  GIV(stackPointer) = (GIV(activeContext) + BaseHeaderSize) + (ReceiverIndex * BytesPerWord);
 
 #  if BytesPerWord == 8
@@ -29065,41 +29354,8 @@
 
 #  endif /* BytesPerWord == 8 */
 
- /* begin fetchContextRegisters: */
- VM_LABEL(15fetchContextRegisters);
- activeCntx = GIV(activeContext);
- tmp = longAt((activeCntx + BaseHeaderSize) + (MethodIndex << ShiftForWord));
- if ((tmp & 1)) {
-
- /* if the MethodIndex field is an integer, activeCntx is a block context */
-
- tmp = longAt((activeCntx + BaseHeaderSize) + (HomeIndex << ShiftForWord));
- if (tmp < GIV(youngStart)) {
- beRootIfOld(tmp);
- }
- }
- else {
-
- /* otherwise, it is a method context and is its own home context  */
-
- tmp = activeCntx;
- }
- GIV(theHomeContext) = tmp;
- GIV(receiver) = longAt((tmp + BaseHeaderSize) + (ReceiverIndex << ShiftForWord));
-
- /* the instruction pointer is a pointer variable equal to
- method oop + ip + BaseHeaderSize
- -1 for 0-based addressing of fetchByte
- -1 because it gets incremented BEFORE fetching currentByte  */
-
- GIV(method) = longAt((tmp + BaseHeaderSize) + (MethodIndex << ShiftForWord));
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
-
- /* the stack pointer is a pointer variable also... */
-
- GIV(instructionPointer) = ((GIV(method) + tmp) + BaseHeaderSize) - 2;
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
- GIV(stackPointer) = (activeCntx + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ GIV(stackPointer) = GIV(activeContext) + relativeSP;
+ assert(validInstructionPointerinMethod(GIV(instructionPointer), GIV(method)));
  interpret();
  return 1;
 }
@@ -29113,7 +29369,6 @@
 EXPORT(sqInt)
 sendInvokeCallbackStackRegistersJmpbuf(sqInt thunkPtr, sqInt stackPtr, sqInt regsPtr, sqInt jmpBufPtr)
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
-    sqInt activeCntx;
     sqInt ccIndex;
     sqInt i;
     sqInt initialIP;
@@ -29205,20 +29460,17 @@
  }
  GIV(reclaimableContextCount) += 1;
  GIV(activeContext) = newContext;
- where = (GIV(activeContext) + BaseHeaderSize) + (ReceiverIndex << ShiftForWord);
- longAtput(where + (1 << ShiftForWord), popRemappableOop());
- longAtput(where + (2 << ShiftForWord), popRemappableOop());
- longAtput(where + (3 << ShiftForWord), popRemappableOop());
- longAtput(where + (4 << ShiftForWord), popRemappableOop());
+ if ((((usqInt) newContext)) < (((usqInt) GIV(youngStart)))) {
+ beRootIfOld(newContext);
+ }
  /* begin fetchContextRegisters: */
  VM_LABEL(16fetchContextRegisters);
- activeCntx = GIV(activeContext);
- tmp = longAt((activeCntx + BaseHeaderSize) + (MethodIndex << ShiftForWord));
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (MethodIndex << ShiftForWord));
  if ((tmp & 1)) {
 
  /* if the MethodIndex field is an integer, activeCntx is a block context */
 
- tmp = longAt((activeCntx + BaseHeaderSize) + (HomeIndex << ShiftForWord));
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (HomeIndex << ShiftForWord));
  if (tmp < GIV(youngStart)) {
  beRootIfOld(tmp);
  }
@@ -29227,7 +29479,7 @@
 
  /* otherwise, it is a method context and is its own home context  */
 
- tmp = activeCntx;
+ tmp = GIV(activeContext);
  }
  GIV(theHomeContext) = tmp;
  GIV(receiver) = longAt((tmp + BaseHeaderSize) + (ReceiverIndex << ShiftForWord));
@@ -29238,13 +29490,18 @@
  -1 because it gets incremented BEFORE fetching currentByte  */
 
  GIV(method) = longAt((tmp + BaseHeaderSize) + (MethodIndex << ShiftForWord));
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
 
  /* the stack pointer is a pointer variable also... */
 
  GIV(instructionPointer) = ((GIV(method) + tmp) + BaseHeaderSize) - 2;
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
- GIV(stackPointer) = (activeCntx + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
+ GIV(stackPointer) = (GIV(activeContext) + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ where = (GIV(activeContext) + BaseHeaderSize) + (ReceiverIndex << ShiftForWord);
+ longAtput(where + (1 << ShiftForWord), popRemappableOop());
+ longAtput(where + (2 << ShiftForWord), popRemappableOop());
+ longAtput(where + (3 << ShiftForWord), popRemappableOop());
+ longAtput(where + (4 << ShiftForWord), popRemappableOop());
  interpret();
  return 1;
 }
@@ -29918,6 +30175,11 @@
  nArgs = GIV(argumentCount);
  deltaIfSuccess = (GIV(stackPointer) - (GIV(argumentCount) * BytesPerOop)) - GIV(activeContext);
  }
+ /* begin fastLogPrim: */
+ if (RecordPrimTrace) {
+ GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
+ primTraceLogIndex(GIV(primTraceLogIndex) + 1);
+ }
  /* begin initPrimCall */
  GIV(primFailCode) = 0;
  dispatchFunctionPointer(primitiveFunctionPointer);
@@ -30647,6 +30909,7 @@
  markAndTrace(oop);
  }
  }
+ markAndTraceTraceLogs();
 
  /* Finally unmark the rootArray and all root objects. */
 
@@ -31809,8 +32072,8 @@
 sqInt
 validInstructionPointerinMethod(sqInt anInstrPointer, sqInt aMethod)
 {
- return (anInstrPointer >= (((aMethod + (lastPointerOf(aMethod))) + BytesPerWord) - 1))
- && (anInstrPointer < ((aMethod + (byteLengthOf(aMethod))) + BaseHeaderSize));
+ return (anInstrPointer >= ((aMethod + (lastPointerOf(aMethod))) + 1))
+ && (anInstrPointer < (aMethod + (byteLengthOf(aMethod))));
 }
 
 static void

Modified: branches/Cog/nssrc/vm/interp.c
===================================================================
--- branches/Cog/nssrc/vm/interp.c 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/nssrc/vm/interp.c 2011-06-06 22:07:11 UTC (rev 2392)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.70 uuid: 36b63465-1b05-401f-bcb2-f9cae49422b8
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
    from
- NewspeakInterpreter VMMaker.oscog-eem.70 uuid: 36b63465-1b05-401f-bcb2-f9cae49422b8
+ NewspeakInterpreter VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
  */
-static char __buildInfo[] = "NewspeakInterpreter VMMaker.oscog-eem.70 uuid: 36b63465-1b05-401f-bcb2-f9cae49422b8 " __DATE__ ;
+static char __buildInfo[] = "NewspeakInterpreter VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2 " __DATE__ ;
 char *__interpBuildInfo = __buildInfo;
 
 
@@ -210,6 +210,8 @@
 #define ProcessListsIndex 0
 #define ProcessSignalingLowSpace 22
 #define ReceiverIndex 5
+#define RecordPrimTrace 0
+#define RecordSendTrace 0
 #define RemapBufferSize 25
 #define RootBit 0x40000000
 #define RootTableRedZone 2400
@@ -244,6 +246,7 @@
 #define TheInterruptSemaphore 30
 #define TheLowSpaceSemaphore 17
 #define TheTimerSemaphore 29
+#define TraceLogSize 256
 #define TrueObject 2
 #define TypeMask 0x3
 #define Upward 3
@@ -329,6 +332,8 @@
 static sqInt doPrimitiveModby(sqInt rcvr, sqInt arg);
 sqInt doSignalSemaphoreWithIndex(sqInt index);
 static sqInt dummyReferToProxy(void);
+sqInt dumpPrimTraceLog(void);
+sqInt dumpSendTraceLog(void);
 static sqInt existImmutableReferencesToForwardedInRangeFromto(sqInt memStart, sqInt memEnd);
 static sqInt externalQuickPrimitiveResponse(void);
 sqInt failed(void);
@@ -435,6 +440,8 @@
 static sqInt lowestFreeAfter(sqInt chunk);
 sqInt makePointwithxValueyValue(sqInt xValue, sqInt yValue);
 static void mapPointersInObjectsFromto(sqInt memStart, sqInt memEnd);
+static sqInt mapTraceLogs(void);
+static sqInt markAndTraceTraceLogs(void);
 void markAndTrace(sqInt oop);
 static void markPhase(void);
 sqInt maybeSplObj(sqInt index);
@@ -691,6 +698,7 @@
 static sqInt reverseDisplayFromto(sqInt startIndex, sqInt endIndex);
 static sqInt rewriteMethodCacheSelclassprimIndex(sqInt selector, sqInt class, sqInt localPrimIndex);
 static sqInt rewriteMethodCacheSelclassprimIndexprimFunction(sqInt selector, sqInt class, sqInt localPrimIndex, void *localPrimAddress);
+static sqInt safePrintStringOf(sqInt oop);
 EXPORT(sqInt) sendInvokeCallbackContext(VMCallbackContext *vmCallbackContext);
 EXPORT(sqInt) sendInvokeCallbackStackRegistersJmpbuf(sqInt thunkPtr, sqInt stackPtr, sqInt regsPtr, sqInt jmpBufPtr);
 sqInt setBreakSelector(char *aString);
@@ -785,8 +793,10 @@
 _iss sqInt nextPollTick;
 _iss sqInt allocationsBetweenGCs;
 _iss usqInt fwdTableNext;
+_iss unsigned char sendTraceLogIndex;
 _iss sqInt freeContexts;
 _iss sqInt lastHash;
+_iss unsigned char primTraceLogIndex;
 _iss sqInt lowSpaceThreshold;
 _iss usqInt compStart;
 _iss sqInt extraRootCount;
@@ -841,6 +851,8 @@
 _iss sqInt remapBuffer[RemapBufferSize + 1 /* 26 */];
 _iss sqInt rootTable[RootTableSize + 1 /* 2501 */];
 _iss sqInt atCache[65];
+_iss sqInt sendTraceLog[256];
+_iss sqInt primTraceLog[256];
 _iss sqInt* extraRoots[ExtraRootSize + 1 /* 2049 */];
 _iss void *externalPrimitiveTable[1025];
 _iss sqInt weakRoots[WeakRootTableSize + 1 /* 2626 */];
@@ -1449,7 +1461,7 @@
  0 };
 char * breakSelector;
 sqInt breakSelectorLength = -1;
-const char *interpreterVersion = "Newspeak Virtual Machine [NewspeakInterpreter VMMaker.oscog-eem.70]";
+const char *interpreterVersion = "Newspeak Virtual Machine NewspeakInterpreter_VMMaker.oscog-eem.72";
 volatile int sendTrace;
 
 
@@ -1457,8 +1469,10 @@
 #define dispatchFunctionPointer(aFunctionPointer) (aFunctionPointer)()
 #define flush() fflush(stdout)
 #define memory() memory
+#define primTraceLogIndex(aValue) (GIV(primTraceLogIndex) = (aValue))
 #define printFloat(f) printf("%g", f)
 #define remapBufferCount() GIV(remapBufferCount)
+#define sendTraceLogIndex(aValue) (GIV(sendTraceLogIndex) = (aValue))
 #define validate() 0
 
 
@@ -4054,7 +4068,12 @@
  sqInt tmp;
 
  VM_LABEL(0commonSend);
- sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), longAtPointer(localSP - (GIV(argumentCount) * BytesPerWord)));
+ /* begin fastLogSend: */
+ if (RecordSendTrace) {
+ GIV(sendTraceLog)[GIV(sendTraceLogIndex)] = GIV(messageSelector);
+ sendTraceLogIndex(GIV(sendTraceLogIndex) + 1);
+ }
+ sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), longAtPointer(localSP - (GIV(argumentCount) * BytesPerWord)));
  /* begin internalFindNewMethod */
  VM_LABEL(0internalFindNewMethod);
  /* begin lookupInMethodCacheSel:class: */
@@ -4149,6 +4168,11 @@
  nArgs = GIV(argumentCount);
  deltaIfSuccess = (GIV(stackPointer) - (GIV(argumentCount) * BytesPerOop)) - GIV(activeContext);
  }
+ /* begin fastLogPrim: */
+ if (RecordPrimTrace) {
+ GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
+ primTraceLogIndex(GIV(primTraceLogIndex) + 1);
+ }
  /* begin initPrimCall */
  GIV(primFailCode) = 0;
  dispatchFunctionPointer(primitiveFunctionPointer);
@@ -10072,6 +10096,66 @@
 }
 
 
+/* The prim trace log is a circular buffer of entries. If there is
+ an entry at primTraceLogIndex \\ PrimTraceLogSize it has entries.
+ If there is something at primTraceLogIndex it has wrapped. */
+
+sqInt
+dumpPrimTraceLog(void)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt i;
+    sqInt remainder;
+
+ if ((GIV(primTraceLog)[(((remainder = (GIV(primTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder + TraceLogSize
+ : remainder)]) == 0) {
+ return null;
+ }
+ if ((GIV(primTraceLog)[GIV(primTraceLogIndex)]) != 0) {
+ for (i = GIV(primTraceLogIndex); i <= (TraceLogSize - 1); i += 1) {
+ safePrintStringOf(GIV(primTraceLog)[i]);
+ /* begin cr */
+ printf("\n");
+ }
+ }
+ for (i = 0; i <= (GIV(primTraceLogIndex) - 1); i += 1) {
+ safePrintStringOf(GIV(primTraceLog)[i]);
+ /* begin cr */
+ printf("\n");
+ }
+}
+
+
+/* The send trace log is a circular buffer of entries. If there is
+ an entry at sendTraceLogIndex \\ PrimTraceLogSize it has entries.
+ If there is something at sendTraceLogIndex it has wrapped. */
+
+sqInt
+dumpSendTraceLog(void)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt i;
+    sqInt remainder;
+
+ if ((GIV(sendTraceLog)[(((remainder = (GIV(sendTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder + TraceLogSize
+ : remainder)]) == 0) {
+ return null;
+ }
+ if ((GIV(sendTraceLog)[GIV(sendTraceLogIndex)]) != 0) {
+ for (i = GIV(sendTraceLogIndex); i <= (TraceLogSize - 1); i += 1) {
+ safePrintStringOf(GIV(sendTraceLog)[i]);
+ /* begin cr */
+ printf("\n");
+ }
+ }
+ for (i = 0; i <= (GIV(sendTraceLogIndex) - 1); i += 1) {
+ safePrintStringOf(GIV(sendTraceLog)[i]);
+ /* begin cr */
+ printf("\n");
+ }
+}
+
+
 /* Answer if any immutable objects refer to any forwarded objects so that the
  become: primitives can fail if a become would update a reference from an
  immutable object.
@@ -13336,7 +13420,6 @@
 sqInt
 loadInitialContext(void)
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
-    sqInt activeCntx;
     sqInt proc;
     sqInt sched;
     sqInt tmp;
@@ -13349,13 +13432,12 @@
  }
  /* begin fetchContextRegisters: */
  VM_LABEL(1fetchContextRegisters);
- activeCntx = GIV(activeContext);
- tmp = longAt((activeCntx + BaseHeaderSize) + (MethodIndex << ShiftForWord));
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (MethodIndex << ShiftForWord));
  if ((tmp & 1)) {
 
  /* if the MethodIndex field is an integer, activeCntx is a block context */
 
- tmp = longAt((activeCntx + BaseHeaderSize) + (HomeIndex << ShiftForWord));
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (HomeIndex << ShiftForWord));
  if (tmp < GIV(youngStart)) {
  beRootIfOld(tmp);
  }
@@ -13364,7 +13446,7 @@
 
  /* otherwise, it is a method context and is its own home context  */
 
- tmp = activeCntx;
+ tmp = GIV(activeContext);
  }
  GIV(theHomeContext) = tmp;
  GIV(receiver) = longAt((tmp + BaseHeaderSize) + (ReceiverIndex << ShiftForWord));
@@ -13375,13 +13457,13 @@
  -1 because it gets incremented BEFORE fetching currentByte  */
 
  GIV(method) = longAt((tmp + BaseHeaderSize) + (MethodIndex << ShiftForWord));
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
 
  /* the stack pointer is a pointer variable also... */
 
  GIV(instructionPointer) = ((GIV(method) + tmp) + BaseHeaderSize) - 2;
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
- GIV(stackPointer) = (activeCntx + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
+ GIV(stackPointer) = (GIV(activeContext) + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
  GIV(reclaimableContextCount) = 0;
 }
 
@@ -13474,6 +13556,11 @@
  GIV(remapBufferCount) -= 1;
  currentClass = oop;
  GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorCannotInterpret << ShiftForWord));
+ /* begin fastLogSend: */
+ if (RecordSendTrace) {
+ GIV(sendTraceLog)[GIV(sendTraceLogIndex)] = GIV(messageSelector);
+ sendTraceLogIndex(GIV(sendTraceLogIndex) + 1);
+ }
  sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), null);
  return lookupMethodInClass(longAt((currentClass + BaseHeaderSize) + (SuperclassIndex << ShiftForWord)));
  }
@@ -13540,6 +13627,14 @@
  GIV(remapBufferCount) -= 1;
  rclass = oop1;
  GIV(messageSelector) = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (SelectorDoesNotUnderstand << ShiftForWord));
+ if (RecordSendTrace) {
+ /* begin fastLogSend: */
+ if (RecordSendTrace) {
+ GIV(sendTraceLog)[GIV(sendTraceLogIndex)] = GIV(messageSelector);
+ sendTraceLogIndex(GIV(sendTraceLogIndex) + 1);
+ }
+ }
+ sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), null);
  return lookupMethodInClass(rclass);
 }
 
@@ -13731,6 +13826,7 @@
  GIV(remapBuffer)[i1] = (remap(oop1));
  }
  }
+ mapTraceLogs();
  for (i = 1; i <= GIV(extraRootCount); i += 1) {
  oop = (GIV(extraRoots)[i])[0];
  if (!((oop & 1))) {
@@ -13761,6 +13857,100 @@
 }
 
 
+/* The prim and send trace logs are circular buffers of selectors. If there
+ is an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has
+ entries. If there is something at primTraceLogIndex it has wrapped. */
+
+static sqInt
+mapTraceLogs(void)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt i;
+    sqInt limit;
+    sqInt remainder;
+    sqInt remainder1;
+    sqInt selector;
+
+ limit = (((remainder = (GIV(primTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder + TraceLogSize
+ : remainder);
+ if ((GIV(primTraceLog)[limit]) == 0) {
+ return null;
+ }
+ if ((GIV(primTraceLog)[GIV(primTraceLogIndex)]) != 0) {
+ limit = TraceLogSize - 1;
+ }
+ for (i = 0; i <= limit; i += 1) {
+ selector = GIV(primTraceLog)[i];
+ if (!((selector & 1))) {
+ GIV(primTraceLog)[i] = (remap(selector));
+ }
+ }
+ limit = (((remainder1 = (GIV(sendTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder1 + TraceLogSize
+ : remainder1);
+ if ((GIV(sendTraceLog)[limit]) == 0) {
+ return null;
+ }
+ if ((GIV(sendTraceLog)[GIV(sendTraceLogIndex)]) != 0) {
+ limit = TraceLogSize - 1;
+ }
+ for (i = 0; i <= limit; i += 1) {
+ selector = GIV(sendTraceLog)[i];
+ if (!((selector & 1))) {
+ GIV(sendTraceLog)[i] = (remap(selector));
+ }
+ }
+}
+
+
+/* The prim and send trace logs are circular buffers of selectors. If there
+ is an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has
+ entries. If there is something at primTraceLogIndex it has wrapped. */
+
+static sqInt
+markAndTraceTraceLogs(void)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt i;
+    sqInt limit;
+    sqInt remainder;
+    sqInt remainder1;
+    sqInt selector;
+
+ if (RecordPrimTrace) {
+ limit = (((remainder = (GIV(primTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder + TraceLogSize
+ : remainder);
+ if ((GIV(primTraceLog)[limit]) != 0) {
+ if ((GIV(primTraceLog)[GIV(primTraceLogIndex)]) != 0) {
+ limit = TraceLogSize - 1;
+ }
+ for (i = 0; i <= limit; i += 1) {
+ selector = GIV(primTraceLog)[i];
+ if (!((selector & 1))) {
+ markAndTrace(selector);
+ }
+ }
+ }
+ }
+ if (RecordSendTrace) {
+ limit = (((remainder1 = (GIV(sendTraceLogIndex) - 1) % TraceLogSize)) < 0
+ ? remainder1 + TraceLogSize
+ : remainder1);
+ if ((GIV(sendTraceLog)[limit]) != 0) {
+ if ((GIV(sendTraceLog)[GIV(sendTraceLogIndex)]) != 0) {
+ limit = TraceLogSize - 1;
+ }
+ for (i = 0; i <= limit; i += 1) {
+ selector = GIV(sendTraceLog)[i];
+ if (!((selector & 1))) {
+ markAndTrace(selector);
+ }
+ }
+ }
+ }
+}
+
+
 /* Mark all objects reachable from the given one.
  Trace from the given object even if it is old.
  Do not trace if it is already marked.
@@ -14166,6 +14356,7 @@
  markAndTrace(oop1);
  }
  }
+ markAndTraceTraceLogs();
 
  /* trace the roots */
 
@@ -17860,6 +18051,11 @@
  nArgs = GIV(argumentCount);
  deltaIfSuccess = (GIV(stackPointer) - (GIV(argumentCount) * BytesPerOop)) - GIV(activeContext);
  }
+ /* begin fastLogPrim: */
+ if (RecordPrimTrace) {
+ GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
+ primTraceLogIndex(GIV(primTraceLogIndex) + 1);
+ }
  /* begin initPrimCall */
  GIV(primFailCode) = 0;
  dispatchFunctionPointer(primitiveFunctionPointer);
@@ -23472,6 +23668,11 @@
  index += 1;
  }
  GIV(argumentCount) = arraySize;
+ /* begin fastLogSend: */
+ if (RecordSendTrace) {
+ GIV(sendTraceLog)[GIV(sendTraceLogIndex)] = GIV(messageSelector);
+ sendTraceLogIndex(GIV(sendTraceLogIndex) + 1);
+ }
  sendBreakpointreceiver(GIV(messageSelector) + BaseHeaderSize, lengthOf(GIV(messageSelector)), GIV(receiver));
  findNewMethodInClass(lookupClass);
  if (((((usqInt) (longAt(GIV(newMethod)))) >> 8) & 15) >= 12) {
@@ -28917,6 +29118,56 @@
 }
 
 
+/* Version of printStringOf: that copes with forwarding during garbage
+ collection.
+ */
+
+static sqInt
+safePrintStringOf(sqInt oop)
+{
+    sqInt cnt;
+    sqInt fmt;
+    sqInt fwdBlock;
+    sqInt header;
+    sqInt header1;
+    sqInt i;
+
+ if ((oop & 1)) {
+ return null;
+ }
+ if (!(((oop >= memory) && (oop <= GIV(freeBlock))))) {
+ return null;
+ }
+ if ((oop & (BytesPerWord - 1)) != 0) {
+ return null;
+ }
+ /* begin headerWhileForwardingOf: */
+ header1 = longAt(oop);
+ if ((header1 & MarkBit) != 0) {
+
+ /* oop is forwarded; get its real header from its forwarding table entry */
+
+ fwdBlock = (header1 & AllButMarkBitAndTypeMask) << 1;
+ assert(fwdBlockValid(fwdBlock));
+ header1 = longAt(fwdBlock + BytesPerWord);
+ }
+ header = header1;
+ fmt = (((usqInt) header) >> 8) & 15;
+ if (fmt < 8) {
+ return null;
+ }
+ cnt = ((100 < (lengthOfbaseHeaderformat(oop, header, fmt))) ? 100 : (lengthOfbaseHeaderformat(oop, header, fmt)));
+ i = 0;
+ while (i < cnt) {
+ /* begin printChar: */
+ putchar(byteAt((oop + BaseHeaderSize) + i));
+ i += 1;
+ }
+ flush();
+ return oop;
+}
+
+
 /* Send the calllback message to Alien class with the supplied arg(s). Use
  either the
  1 arg invokeCallbackContext: or the 4 arg
@@ -28931,7 +29182,6 @@
 EXPORT(sqInt)
 sendInvokeCallbackContext(VMCallbackContext *vmCallbackContext)
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
-    sqInt activeCntx;
     sqInt ccIndex;
     sqInt i;
     sqInt initialIP;
@@ -28946,6 +29196,7 @@
     sqInt object5;
     sqInt object6;
     sqInt object7;
+    sqInt relativeSP;
     sqInt sp;
     sqInt sp1;
     sqInt sp2;
@@ -29017,6 +29268,44 @@
  }
  GIV(reclaimableContextCount) += 1;
  GIV(activeContext) = newContext;
+ if ((((usqInt) newContext)) < (((usqInt) GIV(youngStart)))) {
+ beRootIfOld(newContext);
+ }
+ /* begin fetchContextRegisters: */
+ VM_LABEL(15fetchContextRegisters);
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (MethodIndex << ShiftForWord));
+ if ((tmp & 1)) {
+
+ /* if the MethodIndex field is an integer, activeCntx is a block context */
+
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (HomeIndex << ShiftForWord));
+ if (tmp < GIV(youngStart)) {
+ beRootIfOld(tmp);
+ }
+ }
+ else {
+
+ /* otherwise, it is a method context and is its own home context  */
+
+ tmp = GIV(activeContext);
+ }
+ GIV(theHomeContext) = tmp;
+ GIV(receiver) = longAt((tmp + BaseHeaderSize) + (ReceiverIndex << ShiftForWord));
+
+ /* the instruction pointer is a pointer variable equal to
+ method oop + ip + BaseHeaderSize
+ -1 for 0-based addressing of fetchByte
+ -1 because it gets incremented BEFORE fetching currentByte  */
+
+ GIV(method) = longAt((tmp + BaseHeaderSize) + (MethodIndex << ShiftForWord));
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
+
+ /* the stack pointer is a pointer variable also... */
+
+ GIV(instructionPointer) = ((GIV(method) + tmp) + BaseHeaderSize) - 2;
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
+ GIV(stackPointer) = (GIV(activeContext) + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ relativeSP = GIV(stackPointer) - GIV(activeContext);
  GIV(stackPointer) = (GIV(activeContext) + BaseHeaderSize) + (ReceiverIndex * BytesPerWord);
 
 #  if BytesPerWord == 8
@@ -29061,41 +29350,8 @@
 
 #  endif /* BytesPerWord == 8 */
 
- /* begin fetchContextRegisters: */
- VM_LABEL(15fetchContextRegisters);
- activeCntx = GIV(activeContext);
- tmp = longAt((activeCntx + BaseHeaderSize) + (MethodIndex << ShiftForWord));
- if ((tmp & 1)) {
-
- /* if the MethodIndex field is an integer, activeCntx is a block context */
-
- tmp = longAt((activeCntx + BaseHeaderSize) + (HomeIndex << ShiftForWord));
- if (tmp < GIV(youngStart)) {
- beRootIfOld(tmp);
- }
- }
- else {
-
- /* otherwise, it is a method context and is its own home context  */
-
- tmp = activeCntx;
- }
- GIV(theHomeContext) = tmp;
- GIV(receiver) = longAt((tmp + BaseHeaderSize) + (ReceiverIndex << ShiftForWord));
-
- /* the instruction pointer is a pointer variable equal to
- method oop + ip + BaseHeaderSize
- -1 for 0-based addressing of fetchByte
- -1 because it gets incremented BEFORE fetching currentByte  */
-
- GIV(method) = longAt((tmp + BaseHeaderSize) + (MethodIndex << ShiftForWord));
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
-
- /* the stack pointer is a pointer variable also... */
-
- GIV(instructionPointer) = ((GIV(method) + tmp) + BaseHeaderSize) - 2;
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
- GIV(stackPointer) = (activeCntx + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ GIV(stackPointer) = GIV(activeContext) + relativeSP;
+ assert(validInstructionPointerinMethod(GIV(instructionPointer), GIV(method)));
  interpret();
  return 1;
 }
@@ -29109,7 +29365,6 @@
 EXPORT(sqInt)
 sendInvokeCallbackStackRegistersJmpbuf(sqInt thunkPtr, sqInt stackPtr, sqInt regsPtr, sqInt jmpBufPtr)
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
-    sqInt activeCntx;
     sqInt ccIndex;
     sqInt i;
     sqInt initialIP;
@@ -29201,20 +29456,17 @@
  }
  GIV(reclaimableContextCount) += 1;
  GIV(activeContext) = newContext;
- where = (GIV(activeContext) + BaseHeaderSize) + (ReceiverIndex << ShiftForWord);
- longAtput(where + (1 << ShiftForWord), popRemappableOop());
- longAtput(where + (2 << ShiftForWord), popRemappableOop());
- longAtput(where + (3 << ShiftForWord), popRemappableOop());
- longAtput(where + (4 << ShiftForWord), popRemappableOop());
+ if ((((usqInt) newContext)) < (((usqInt) GIV(youngStart)))) {
+ beRootIfOld(newContext);
+ }
  /* begin fetchContextRegisters: */
  VM_LABEL(16fetchContextRegisters);
- activeCntx = GIV(activeContext);
- tmp = longAt((activeCntx + BaseHeaderSize) + (MethodIndex << ShiftForWord));
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (MethodIndex << ShiftForWord));
  if ((tmp & 1)) {
 
  /* if the MethodIndex field is an integer, activeCntx is a block context */
 
- tmp = longAt((activeCntx + BaseHeaderSize) + (HomeIndex << ShiftForWord));
+ tmp = longAt((GIV(activeContext) + BaseHeaderSize) + (HomeIndex << ShiftForWord));
  if (tmp < GIV(youngStart)) {
  beRootIfOld(tmp);
  }
@@ -29223,7 +29475,7 @@
 
  /* otherwise, it is a method context and is its own home context  */
 
- tmp = activeCntx;
+ tmp = GIV(activeContext);
  }
  GIV(theHomeContext) = tmp;
  GIV(receiver) = longAt((tmp + BaseHeaderSize) + (ReceiverIndex << ShiftForWord));
@@ -29234,13 +29486,18 @@
  -1 because it gets incremented BEFORE fetching currentByte  */
 
  GIV(method) = longAt((tmp + BaseHeaderSize) + (MethodIndex << ShiftForWord));
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (InstructionPointerIndex << ShiftForWord))) >> 1);
 
  /* the stack pointer is a pointer variable also... */
 
  GIV(instructionPointer) = ((GIV(method) + tmp) + BaseHeaderSize) - 2;
- tmp = ((longAt((activeCntx + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
- GIV(stackPointer) = (activeCntx + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ tmp = ((longAt((GIV(activeContext) + BaseHeaderSize) + (StackPointerIndex << ShiftForWord))) >> 1);
+ GIV(stackPointer) = (GIV(activeContext) + BaseHeaderSize) + (((TempFrameStart + tmp) - 1) * BytesPerWord);
+ where = (GIV(activeContext) + BaseHeaderSize) + (ReceiverIndex << ShiftForWord);
+ longAtput(where + (1 << ShiftForWord), popRemappableOop());
+ longAtput(where + (2 << ShiftForWord), popRemappableOop());
+ longAtput(where + (3 << ShiftForWord), popRemappableOop());
+ longAtput(where + (4 << ShiftForWord), popRemappableOop());
  interpret();
  return 1;
 }
@@ -29914,6 +30171,11 @@
  nArgs = GIV(argumentCount);
  deltaIfSuccess = (GIV(stackPointer) - (GIV(argumentCount) * BytesPerOop)) - GIV(activeContext);
  }
+ /* begin fastLogPrim: */
+ if (RecordPrimTrace) {
+ GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
+ primTraceLogIndex(GIV(primTraceLogIndex) + 1);
+ }
  /* begin initPrimCall */
  GIV(primFailCode) = 0;
  dispatchFunctionPointer(primitiveFunctionPointer);
@@ -30643,6 +30905,7 @@
  markAndTrace(oop);
  }
  }
+ markAndTraceTraceLogs();
 
  /* Finally unmark the rootArray and all root objects. */
 
@@ -31805,8 +32068,8 @@
 sqInt
 validInstructionPointerinMethod(sqInt anInstrPointer, sqInt aMethod)
 {
- return (anInstrPointer >= (((aMethod + (lastPointerOf(aMethod))) + BytesPerWord) - 1))
- && (anInstrPointer < ((aMethod + (byteLengthOf(aMethod))) + BaseHeaderSize));
+ return (anInstrPointer >= ((aMethod + (lastPointerOf(aMethod))) + 1))
+ && (anInstrPointer < (aMethod + (byteLengthOf(aMethod))));
 }
 
 static void

Modified: branches/Cog/nssrc/vm/interp.h
===================================================================
--- branches/Cog/nssrc/vm/interp.h 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/nssrc/vm/interp.h 2011-06-06 22:07:11 UTC (rev 2392)
@@ -1,5 +1,5 @@
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.70 uuid: 36b63465-1b05-401f-bcb2-f9cae49422b8
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
  */
 
 #define NewspeakVM 1

Modified: branches/Cog/nssrc/vm/vmCallback.h
===================================================================
--- branches/Cog/nssrc/vm/vmCallback.h 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/nssrc/vm/vmCallback.h 2011-06-06 22:07:11 UTC (rev 2392)
@@ -1,5 +1,5 @@
 /* Automatically generated by
- CCodeGeneratorGlobalStructure VMMaker.oscog-eem.70 uuid: 36b63465-1b05-401f-bcb2-f9cae49422b8
+ CCodeGeneratorGlobalStructure VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
  */
 
 #define VM_CALLBACK_INC 1

Modified: branches/Cog/platforms/win32/vm/sqWin32Prefs.c
===================================================================
--- branches/Cog/platforms/win32/vm/sqWin32Prefs.c 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/platforms/win32/vm/sqWin32Prefs.c 2011-06-06 22:07:11 UTC (rev 2392)
@@ -196,8 +196,13 @@
 
   /* get the window class name from the ini file */
   GetPrivateProfileString(U_GLOBAL, TEXT("WindowClassName"),
-  TEXT("SqueakWindowClass"), windowClassName,
-  MAX_PATH, squeakIniName);
+#if NewspeakVM
+ TEXT(VM_NAME"WindowClass"),
+#else
+ TEXT("SqueakWindowClass"),
+#endif
+ windowClassName,
+ MAX_PATH, squeakIniName);
   fRunSingleApp =
     GetPrivateProfileInt(U_GLOBAL, TEXT("RunSingleApp"),
  fRunSingleApp, squeakIniName);

Modified: branches/Cog/scripts/uploadvms
===================================================================
--- branches/Cog/scripts/uploadvms 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/scripts/uploadvms 2011-06-06 22:07:11 UTC (rev 2392)
@@ -3,4 +3,4 @@
 echo $VER
 test -f README.$VER || vi README.$VER
 ssh -x [hidden email] mkdir mirandabanda.org/files/Cog/VM/VM.r$VER
-scp README.$VER Cog.app.tgz coglinux.tgz cogwin.zip Newspeak\ Virtual\ Machine.app.zip nsvmwin.zip [hidden email]:mirandabanda.org/files/Cog/VM/VM.r$VER
+scp README.$VER Cog.app.tgz coglinux.tgz cogwin.zip Newspeak\ Virtual\ Machine.app.tgz nsvmwin.zip [hidden email]:mirandabanda.org/files/Cog/VM/VM.r$VER

Modified: branches/Cog/src/plugins/LargeIntegers/LargeIntegers.c
===================================================================
--- branches/Cog/src/plugins/LargeIntegers/LargeIntegers.c 2011-06-06 22:05:17 UTC (rev 2391)
+++ branches/Cog/src/plugins/LargeIntegers/LargeIntegers.c 2011-06-06 22:07:11 UTC (rev 2392)
@@ -1,9 +1,9 @@
 /* Automatically generated by
- SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.69 uuid: fd9c171e-3731-4093-912d-ad8fefb4800c
+ SmartSyntaxPluginCodeGenerator VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
    from
- LargeIntegersPlugin VMMaker.oscog-eem.69 uuid: fd9c171e-3731-4093-912d-ad8fefb4800c
+ LargeIntegersPlugin VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2
  */
-static char __buildInfo[] = "LargeIntegersPlugin VMMaker.oscog-eem.69 uuid: fd9c171e-3731-4093-912d-ad8fefb4800c " __DATE__ ;
+static char __buildInfo[] = "LargeIntegersPlugin VMMaker.oscog-eem.72 uuid: dcc88b7d-4b47-4bf1-8400-d1c6499e87d2 " __DATE__ ;
 
 
 
@@ -124,9 +124,9 @@
 struct VirtualMachine* interpreterProxy;
 static const char *moduleName =
 #ifdef SQUEAK_BUILTIN_PLUGIN
- "LargeIntegers v1.5 VMMaker.oscog-eem.69 (i)"
+ "LargeIntegers v1.5 VMMaker.oscog-eem.72 (i)"
 #else
- "LargeIntegers v1.5 VMMaker.oscog-eem.69 (e)"
+ "LargeIntegers v1.5 VMMaker.oscog-eem.72 (e)"
 #endif
 ;
 static const int  orOpIndex = 1;
@@ -906,17 +906,19 @@
 static void
 cdigitMontgomerylentimeslenmodulolenmInvModBinto(unsigned char *  pBytesFirst, sqInt firstLen, unsigned char *  pBytesSecond, sqInt secondLen, unsigned char *  pBytesThird, sqInt thirdLen, sqInt mInv, unsigned char *  pBytesRes)
 {
- sqInt accum;
+ usqInt  accum;
  sqInt i;
  sqInt k;
+ unsigned char   lastByte;
  sqInt limit1;
  sqInt limit2;
  sqInt limit3;
- sqInt u;
+ unsigned char   u;
 
  limit1 = firstLen - 1;
  limit2 = secondLen - 1;
  limit3 = thirdLen - 1;
+ lastByte = 0;
  for (i = 0; i <= limit1; i += 1) {
  accum = (pBytesRes[0]) + ((pBytesFirst[i]) * (pBytesSecond[0]));
  u = (accum * mInv) & 255;
@@ -929,8 +931,9 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
  for (i = firstLen; i <= limit3; i += 1) {
  accum = pBytesRes[0];
@@ -940,11 +943,21 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
- if (!((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1)) {
- cDigitSublenwithleninto(pBytesThird, thirdLen, pBytesRes, thirdLen, pBytesRes);
+ if (!((lastByte == 0)
+ && ((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1))) {
+
+ /* self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes */
+
+ accum = 0;
+ for (i = 0; i <= limit3; i += 1) {
+ accum = (accum + (pBytesRes[i])) - (pBytesThird[i]);
+ pBytesRes[i] = (accum - ((((sqInt) accum >> 8)) * 256));
+ accum = ((sqInt) accum >> 8);
+ }
  }
 }
 
@@ -1539,10 +1552,11 @@
 static sqInt
 digitMontgomerytimesmodulomInvModB(sqInt firstLarge, sqInt secondLarge, sqInt thirdLarge, sqInt mInv)
 {
- sqInt accum;
+ usqInt  accum;
  sqInt firstLen;
  sqInt i;
  sqInt k;
+ unsigned char   lastByte;
  sqInt limit1;
  sqInt limit2;
  sqInt limit3;
@@ -1553,7 +1567,7 @@
  sqInt prod;
  sqInt secondLen;
  sqInt thirdLen;
- sqInt u;
+ unsigned char   u;
 
  firstLen = interpreterProxy->slotSizeOf(firstLarge);
  secondLen = interpreterProxy->slotSizeOf(secondLarge);
@@ -1583,6 +1597,7 @@
  limit1 = firstLen - 1;
  limit2 = secondLen - 1;
  limit3 = thirdLen - 1;
+ lastByte = 0;
  for (i = 0; i <= limit1; i += 1) {
  accum = (pBytesRes[0]) + ((pBytesFirst[i]) * (pBytesSecond[0]));
  u = (accum * mInv) & 255;
@@ -1595,8 +1610,9 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
  for (i = firstLen; i <= limit3; i += 1) {
  accum = pBytesRes[0];
@@ -1606,11 +1622,21 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
- if (!((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1)) {
- cDigitSublenwithleninto(pBytesThird, thirdLen, pBytesRes, thirdLen, pBytesRes);
+ if (!((lastByte == 0)
+ && ((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1))) {
+
+ /* self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes */
+
+ accum = 0;
+ for (i = 0; i <= limit3; i += 1) {
+ accum = (accum + (pBytesRes[i])) - (pBytesThird[i]);
+ pBytesRes[i] = (accum - ((((sqInt) accum >> 8)) * 256));
+ accum = ((sqInt) accum >> 8);
+ }
  }
  return normalizePositive(prod);
 }
@@ -1751,14 +1777,20 @@
 {
  sqInt firstLen;
  sqInt firstNeg;
+ sqInt i;
  sqInt larger;
  sqInt largerLen;
+ sqInt limit;
  sqInt neg;
+ unsigned char *  pByteLarge;
+ unsigned char *  pByteRes;
+ unsigned char *  pByteSmall;
  sqInt res;
  sqInt resLen;
  sqInt secondLen;
  sqInt smaller;
  sqInt smallerLen;
+ sqInt z;
 
  firstNeg = (interpreterProxy->fetchClassOf(firstInteger)) == (interpreterProxy->classLargeNegativeInteger());
  firstLen = interpreterProxy->slotSizeOf(firstInteger);
@@ -1794,7 +1826,26 @@
  : interpreterProxy->classLargePositiveInteger()), resLen);
  larger = interpreterProxy->popRemappableOop();
  smaller = interpreterProxy->popRemappableOop();
- cDigitSublenwithleninto(interpreterProxy->firstIndexableField(smaller), smallerLen, interpreterProxy->firstIndexableField(larger), largerLen, interpreterProxy->firstIndexableField(res));
+ /* begin cDigitSub:len:with:len:into: */
+ pByteSmall = interpreterProxy->firstIndexableField(smaller);
+ pByteLarge = interpreterProxy->firstIndexableField(larger);
+ pByteRes = interpreterProxy->firstIndexableField(res);
+
+ /* Loop invariant is -1<=z<=1 */
+
+ z = 0;
+ limit = smallerLen - 1;
+ for (i = 0; i <= limit; i += 1) {
+ z = (z + (pByteLarge[i])) - (pByteSmall[i]);
+ pByteRes[i] = (z - ((((sqInt) z >> 8)) * 256));
+ z = ((sqInt) z >> 8);
+ }
+ limit = largerLen - 1;
+ for (i = smallerLen; i <= limit; i += 1) {
+ z += pByteLarge[i];
+ pByteRes[i] = (z - ((((sqInt) z >> 8)) * 256));
+ z = ((sqInt) z >> 8);
+ }
  return (neg
  ? normalizeNegative(res)
  : normalizePositive(res));
@@ -2975,12 +3026,13 @@
 EXPORT(sqInt)
 primMontgomeryTimesModulo(void)
 {
- sqInt accum;
+ usqInt  accum;
  sqInt firstInteger;
  sqInt firstLarge;
  sqInt firstLen;
  sqInt i;
  sqInt k;
+ unsigned char   lastByte;
  sqInt limit1;
  sqInt limit2;
  sqInt limit3;
@@ -2996,7 +3048,7 @@
  sqInt thirdLarge;
  sqInt thirdLen;
  sqInt thirdModuloInteger;
- sqInt u;
+ unsigned char   u;
  sqInt _return_value;
 
  interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(2), "Integer"));
@@ -3081,6 +3133,7 @@
  limit1 = firstLen - 1;
  limit2 = secondLen - 1;
  limit3 = thirdLen - 1;
+ lastByte = 0;
  for (i = 0; i <= limit1; i += 1) {
  accum = (pBytesRes[0]) + ((pBytesFirst[i]) * (pBytesSecond[0]));
  u = (accum * smallInverseInteger) & 255;
@@ -3093,8 +3146,9 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
  for (i = firstLen; i <= limit3; i += 1) {
  accum = pBytesRes[0];
@@ -3104,11 +3158,21 @@
  accum = ((((usqInt) accum) >> 8) + (pBytesRes[k])) + (u * (pBytesThird[k]));
  pBytesRes[k - 1] = (accum & 255);
  }
- accum = ((usqInt) accum) >> 8;
+ accum = (((usqInt) accum) >> 8) + lastByte;
  pBytesRes[limit3] = (accum & 255);
+ lastByte = ((usqInt) accum) >> 8;
  }
- if (!((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1)) {
- cDigitSublenwithleninto(pBytesThird, thirdLen, pBytesRes, thirdLen, pBytesRes);
+ if (!((lastByte == 0)
+ && ((cDigitComparewithlen(pBytesThird, pBytesRes, thirdLen)) == 1))) {
+
+ /* self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes */
+
+ accum = 0;
+ for (i = 0; i <= limit3; i += 1) {
+ accum = (accum + (pBytesRes[i])) - (pBytesThird[i]);
+ pBytesRes[i] = (accum - ((((sqInt) accum >> 8)) * 256));
+ accum = ((sqInt) accum >> 8);
+ }
  }
  _return_value = normalizePositive(prod);
 l1: /* end digitMontgomery:times:modulo:mInvModB: */;