Vm-dev September 2013

vm-dev@lists.squeakfoundation.org

31 participants
155 discussions

Cog code compaction crash when stepping in the debugger
by Eliot Miranda 25 Sep '13

25 Sep '13

Hi All, I'm seeing an occasional crash in Cog when stepping the simulator when working on Spur. The crash comes about when the system executes primitiveStoreStackp (primitive 76) as part of ContextPart>>push:, and a code compaction occurs within the primitive. The crash.dmp file looks like the following (eliding for brevity): Bus error Sat Sep 21 06:03:12 2013 ... C stack backtrace: 0 Squeak 0x000700a1 reportStackState + 145 1 Squeak 0x00070a32 sigsegv + 306 2 libSystem.B.dylib 0x99fa105b _sigtramp + 43 3 ??? 0xffffffff 0x0 + 4294967295 4 Squeak 0x00101d9a interpret + 2970 ... Smalltalk stack dump: 0xbffe2ae8 M MethodContext(ContextPart)>push: 0x1d95abac: a(n) MethodContext 0xbffe2b0c M MethodContext(ContextPart)>return:from: 0x1d95ab50: a(n) MethodContext 0xbffe2b34 I MethodContext(ContextPart)>methodReturnReceiver 0x1d95ab50: a(n) MethodContext 0xbffe2b5c M MethodContext(InstructionStream)>interpretNextInstructionFor: 0x1d95ab50: a(n) MethodContext 0xbffe2b78 M MethodContext(ContextPart)>step 0x1d95ab50: a(n) MethodContext ... Most recent primitives ... primitiveWait at:put: signal @ basicNew shallowCopy findSubstring:in:startingAt:matchTable: indexOfAscii:inString:startingAt: perform: objectAt: at: findNextUnwindContextUpTo: at:put: at:put: stackp: **CompactCode** But this isn't telling me enough. Firstly I've just committed changes to http://www.squeakvm.org/svn/squeak/branches/Cog/platforms/Mac%20OS/vm/sqMac… http://www.squeakvm.org/svn/squeak/branches/Cog/platforms/unix/vm/sqUnixMai… also print the register state when the VM segfaults or gets sent SGUSR1 etc. I can't test on FreeBSD. If anyone builds with these changes on Free BSD can they please let me know if they work or not? Secondly perhaps someone has a reproducible case coming from running e.g. ContextPart>>runAtEachStep: type code? If so, please can I have a copy? Lastly, if anyone has a crash that matches the above, but with the new crash dump info, I'd love to see the crash.dmp file. Thanks, Eliot

1 0

VM Maker: VMMaker.oscog-eem.412.mcz
by commits＠source.squeak.org 25 Sep '13

25 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.412.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.412 Author: eem Time: 25 September 2013, 12:18:41.931 pm UUID: 6b66ad04-58bc-4be6-8790-cb2f11fc34e8 Ancestors: VMMaker.oscog-eem.411 Sionara the explicit noAtCache at:[put:] machinery in CoInterpreter now that the atCache is confined to the interreter's special selector at:[put:] bytecodes. Add some missing subclass responsibility implementations to SMM. Add primitiveMakeEphemeron for testing. =============== Diff against VMMaker.oscog-eem.411 =============== Item was changed: ----- Method: CoInterpreter>>functionPointerForCompiledMethod:primitiveIndex: (in category 'cog jit support') ----- functionPointerForCompiledMethod: methodObj primitiveIndex: primIndex <api> <returnTypeC: 'void (*functionPointerForCompiledMethodprimitiveIndex(sqInt methodObj, sqInt primIndex))(void)'> | functionPointer | <var: #functionPointer declareC: #'void (*functionPointer)(void)'> functionPointer := self functionPointerFor: primIndex inClass: nil. - functionPointer == #primitiveAt ifTrue: - [^#primitiveNoAtCacheAt]. - functionPointer == #primitiveAtPut ifTrue: - [^#primitiveNoAtCacheAtPut]. - functionPointer == #primitiveStringAt ifTrue: - [^#primitiveNoAtCacheStringAt]. - functionPointer == #primitiveStringAtPut ifTrue: - [^#primitiveNoAtCacheStringAtPut]. functionPointer == #primitiveCalloutToFFI ifTrue: [^self functionForPrimitiveCallout]. functionPointer == #primitiveExternalCall ifTrue: [^self functionForPrimitiveExternalCall: methodObj]. ^functionPointer! Item was removed: - ----- Method: CoInterpreter>>noAtCacheCommonAt: (in category 'indexing primitive support') ----- - noAtCacheCommonAt: stringy - "This code is called if the receiver responds primitively to at:. - The cogit can implement at: & at:put: quickly in machine code, and needs a backup - that provides error codes. But it does not want the at cache so it does not have to - waste time assigning messageSelector and lkupClass." - | index rcvr result | - self initPrimCall. - rcvr := self stackValue: 1. - (objectMemory isNonIntegerObject: rcvr) ifFalse: - [^self primitiveFailFor: PrimErrInappropriate]. - index := self stackTop. - "No need to test for large positive integers here. No object has 1g elements" - (objectMemory isIntegerObject: index) ifFalse: - [^self primitiveFailFor: PrimErrBadArgument]. - index := objectMemory integerValueOf: index. - result := self stObject: rcvr at: index. - self successful ifTrue: - [stringy ifTrue: [result := self characterForAscii: (objectMemory integerValueOf: result)]. - ^ self pop: argumentCount+1 thenPush: result]! Item was removed: - ----- Method: CoInterpreter>>noAtCacheCommonAtPut: (in category 'indexing primitive support') ----- - noAtCacheCommonAtPut: stringy - "This code is called if the receiver responds primitively to at:Put:. - The cogit can implement at: & at:put: quickly in machine code, and needs a backup - that provides error codes. But it does not want the at cache so it does not have to - waste time assigning messageSelector and lkupClass." - | value index rcvr | - value := self stackTop. - self initPrimCall. - rcvr := self stackValue: 2. - (objectMemory isNonIntegerObject: rcvr) ifFalse: - [^self primitiveFailFor: PrimErrInappropriate]. - index := self stackValue: 1. - "No need to test for large positive integers here. No object has 1g elements" - (objectMemory isIntegerObject: index) ifFalse: - [^self primitiveFailFor: PrimErrBadArgument]. - index := objectMemory integerValueOf: index. - stringy - ifTrue: [self stObject: rcvr at: index put: (self asciiOfCharacter: value)] - ifFalse: [self stObject: rcvr at: index put: value]. - self successful ifTrue: - [^ self pop: argumentCount+1 thenPush: value]! Item was removed: - ----- Method: CoInterpreterPrimitives>>primitiveNoAtCacheAt (in category 'indexing primitives') ----- - primitiveNoAtCacheAt - - self noAtCacheCommonAt: false.! Item was removed: - ----- Method: CoInterpreterPrimitives>>primitiveNoAtCacheAtPut (in category 'indexing primitives') ----- - primitiveNoAtCacheAtPut - - self noAtCacheCommonAtPut: false.! Item was removed: - ----- Method: CoInterpreterPrimitives>>primitiveNoAtCacheStringAt (in category 'indexing primitives') ----- - primitiveNoAtCacheStringAt - - self noAtCacheCommonAt: true.! Item was removed: - ----- Method: CoInterpreterPrimitives>>primitiveNoAtCacheStringAtPut (in category 'indexing primitives') ----- - primitiveNoAtCacheStringAtPut - - self noAtCacheCommonAtPut: true.! Item was added: + ----- Method: SpurMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- + allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex + "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header + will have been filled-in but not the contents." + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>tagMask (in category 'word size') ----- + tagMask + ^self subclassResponsibility! Item was added: + ----- Method: SpurMemoryManager>>wordSize (in category 'word size') ----- + wordSize + "Answer the manager's word size, whjich is the size of an oop, and which + is assumed to be equivslent to the underlying machine's word size." + ^self subclassResponsibility! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveMakeEphemeron (in category 'system control primitives') ----- + primitiveMakeEphemeron + "Turn the receiver into an ephemeron. + TEMPORARY. For testing ephemeron handling in the VM only. + Ephemerons should be instantiated from a suitable class." + <export: true> + <option: #Spur> + ((objectMemory isNonImmediate: self stackTop) + and: [objectMemory isFixedSizePointerFormat: (objectMemory formatOf: self stackTop)]) ifFalse: + [^self primitiveFailFor: (argumentCount = 0 + ifTrue: [PrimErrBadReceiver] + ifFalse: [PrimErrBadArgument])]. + objectMemory + setFormatOf: self stackTop + to: objectMemory ephemeronFormat. + self pop: argumentCount!

1 0

[commit][2785] If possible, print the register state when printing the stack on
by commits＠squeakvm.org 25 Sep '13

25 Sep '13

Revision: 2785 Author: eliot Date: 2013-09-25 11:55:57 -0700 (Wed, 25 Sep 2013) Log Message: ----------- If possible, print the register state when printing the stack on exceptions, SIGUSR1 etc. Eliminate a compiler warning on Mac OS. Modified Paths: -------------- branches/Cog/platforms/Mac OS/vm/sqMacMain.c branches/Cog/platforms/unix/vm/sqUnixMain.c Modified: branches/Cog/platforms/Mac OS/vm/sqMacMain.c =================================================================== --- branches/Cog/platforms/Mac OS/vm/sqMacMain.c 2013-09-19 01:07:31 UTC (rev 2784) +++ branches/Cog/platforms/Mac OS/vm/sqMacMain.c 2013-09-25 18:55:57 UTC (rev 2785) @@ -161,6 +161,8 @@ /* Print an error message, possibly a stack trace, do /not/ exit. * Allows e.g. writing to a log file and stderr. */ +static void printRegisterState(ucontext_t *uap); + static void reportStackState(char *msg, char *date, int printAll, ucontext_t *uap) { @@ -175,6 +177,7 @@ printf("%s\n\n", getVersionInfo(1)); #if !defined(NOEXECINFO) + printRegisterState(uap); printf("C stack backtrace:\n"); fflush(stdout); /* backtrace_symbols_fd uses unbuffered i/o */ depth = backtrace(addrs, BACKTRACE_DEPTH); @@ -246,6 +249,27 @@ fflush(stdout); } +/* Attempt to dump the registers to stdout. Only do so if we know how. */ +static void +printRegisterState(ucontext_t *uap) +{ +#if __DARWIN_UNIX03 && __APPLE__ && __MACH__ && __i386__ + _STRUCT_X86_THREAD_STATE32 *regs = &uap->uc_mcontext->__ss; + printf( "eax 0x%8x ebx 0x%8x ecx 0x%8x edx 0x%8x\n" + "edi 0x%8x esi 0x%8x ebp 0x%8x esp 0x%8x\n", + regs->__eax, regs->__ebx, regs->__ecx, regs->__edx, + regs->__edi, regs->__edi, regs->__ebp, regs->__esp); +#elif __APPLE__ && __MACH__ && __i386__ + _STRUCT_X86_THREAD_STATE32 *regs = &uap->uc_mcontext->ss; + printf( "eax 0x%8x ebx 0x%8x ecx 0x%8x edx 0x%8x\n" + "edi 0x%8x esi 0x%8x ebp 0x%8x esp 0x%8x\n", + regs->eax, regs->ebx, regs->ecx, regs->edx, + regs->edi, regs->edi, regs->ebp, regs->esp); +#else + printf("don't know how to derive register state from a ucontext_t on this platform\n"); +#endif +} + int blockOnError = 0; /* to allow attaching gdb on fatal error */ static void @@ -276,8 +300,10 @@ static void getCrashDumpFilenameInto(char *buf) { - strcpy(buf,vmLogDirA); - vmLogDirA[0] && strcat(buf, "/"); + if (vmLogDirA[0]) { + strcpy(buf,vmLogDirA); + strcat(buf, "/"); + } strcat(buf, "crash.dmp"); } Modified: branches/Cog/platforms/unix/vm/sqUnixMain.c =================================================================== --- branches/Cog/platforms/unix/vm/sqUnixMain.c 2013-09-19 01:07:31 UTC (rev 2784) +++ branches/Cog/platforms/unix/vm/sqUnixMain.c 2013-09-25 18:55:57 UTC (rev 2785) @@ -786,6 +786,8 @@ /* Print an error message, possibly a stack trace, do /not/ exit. * Allows e.g. writing to a log file and stderr. */ +static void printRegisterState(ucontext_t *uap); + static void reportStackState(char *msg, char *date, int printAll, ucontext_t *uap) { @@ -800,6 +802,7 @@ printf("%s\n\n", getVersionInfo(1)); #if !defined(NOEXECINFO) + printRegisterState(uap); printf("C stack backtrace:\n"); fflush(stdout); /* backtrace_symbols_fd uses unbuffered i/o */ depth = backtrace(addrs, BACKTRACE_DEPTH); @@ -866,6 +869,27 @@ fflush(stdout); } +/* Attempt to dump the registers to stdout. Only do so if we know how. */ +static void +printRegisterState(ucontext_t *uap) +{ +#if __linux__ && __i386__ + gregset_t *regs = &uap->uc_mcontext.gregs; + printf( "eax 0x%8x ebx 0x%8x ecx 0x%8x edx 0x%8x\n" + "edi 0x%8x esi 0x%8x ebp 0x%8x esp 0x%8x\n", + regs[REG_EAX], regs[REG_EBX], regs[REG_ECX], regs[REG_EDX], + regs[REG_EDI], regs[REG_EDI], regs[REG_EBP], regs[REG_ESP]); +#elif __FreeBSD__ && __i386__ + struct mcontext *regs = &uap->uc_mcontext; + printf( "eax 0x%8x ebx 0x%8x ecx 0x%8x edx 0x%8x\n" + "edi 0x%8x esi 0x%8x ebp 0x%8x esp 0x%8x\n", + regs->mc_eax, regs->mc_ebx, regs->mc_ecx, regs->mc_edx, + regs->mc_edi, regs->mc_edi, regs->mc_ebp, regs->mc_esp); +#else + printf("don't know how to derive register state from a ucontext_t on this platform\n"); +#endif +} + int blockOnError = 0; /* to allow attaching gdb on fatal error */ static void

1 0

VM Maker: VMMaker.oscog-eem.411.mcz
by commits＠source.squeak.org 25 Sep '13

25 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.411.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.411 Author: eem Time: 25 September 2013, 12:32:01.928 am UUID: b0984765-98da-4a23-9bf3-abb88371db54 Ancestors: VMMaker.oscog-eem.410 Fix assert in eeInstantiateClassIndex:format:numSlots:. Bootstrapped Spur image now evaluates 3+4. Fix assignment of memory in sqGrowMemory:By: in obj mem sims. Nuke unused methods in interpreter sims (now memory is accessed only by objectMemory). =============== Diff against VMMaker.oscog-eem.410 =============== Item was removed: - ----- Method: CogVMSimulator>>sqGrowMemory:By: (in category 'memory access') ----- - sqGrowMemory: oldLimit By: delta - - transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr. - objectMemory memory: objectMemory memory , (objectMemory memory class new: delta // 4). - ^ objectMemory memory size * 4! Item was changed: ----- Method: NewCoObjectMemorySimulator>>sqGrowMemory:By: (in category 'memory access') ----- sqGrowMemory: oldLimit By: delta | newMemory | coInterpreter transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr. memory size * 4 < (oldLimit + delta) ifTrue: [newMemory := (memory class new: oldLimit + delta + 3 // 4). newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1. + memory := newMemory]. - coInterpreter objectMemory memory: (memory := newMemory)]. ^memory size * 4! Item was changed: ----- Method: NewObjectMemorySimulator>>sqGrowMemory:By: (in category 'memory access') ----- sqGrowMemory: oldLimit By: delta | newMemory | coInterpreter transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr. memory size * 4 < (oldLimit + delta) ifTrue: [newMemory := (memory class new: oldLimit + delta + 3 // 4). newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1. + memory := newMemory]. - coInterpreter memory: (memory := newMemory)]. ^memory size * 4! Item was changed: ----- Method: SpurMemoryManager>>eeInstantiateClassIndex:format:numSlots: (in category 'instantiation') ----- eeInstantiateClassIndex: knownClassIndex format: objFormat numSlots: numSlots "Instantiate an instance of a compact class. ee stands for execution engine and implies that this allocation will *NOT* cause a GC. N.B. the instantiated object IS NOT FILLED and must be completed before returning it to Smalltalk. Since this call is used in routines that do just that we are safe. Break this rule and die in GC. Result is guaranteed to be young." <inline: true> + self assert: (numSlots >= 0 and: [knownClassIndex ~= 0]). - self assert: (numSlots > 0 and: [knownClassIndex ~= 0]). self assert: (objFormat < self firstByteFormat ifTrue: [objFormat] ifFalse: [objFormat bitAnd: self byteFormatMask]) = (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)). ^self allocateNewSpaceSlots: numSlots format: objFormat classIndex: knownClassIndex! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." | sel | sel := thisContext sender method selector. (#( DoIt DoItIn: on:do: "from the debugger" makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: printContext: compare31or32Bits:equal: signed64BitValueOf: primDigitMultiply:negative: digitLength: isNegativeIntegerValueOf: magnitude64BitValueOf: primitiveMakePoint primitiveAsCharacter primitiveInputSemaphore baseFrameReturn primitiveExternalCall primDigitCompare: isLiveContext: numPointerSlotsOf: fileValueOf: loadBitBltDestForm fetchIntOrFloat:ofObject:ifNil: fetchIntOrFloat:ofObject: loadBitBltSourceForm loadPoint:from: primDigitAdd: primDigitSubtract: positive64BitValueOf: digitBitLogic:with:opIndex: signed32BitValueOf: isNormalized: primDigitDiv:negative: + bytesOrInt:growTo: + primitiveNewMethod) includes: sel) ifFalse: - bytesOrInt:growTo:) includes: sel) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was changed: ----- Method: SpurMemoryManager>>isNonIntegerObject: (in category 'object testing') ----- isNonIntegerObject: oop "This list records the valid senders of isNonIntegerObject: as we replace uses of isNonIntegerObject: by isNonImmediate: where appropriate." + (#( reverseDisplayFrom:to: + primitiveObjectAtPut) includes: thisContext sender method selector) ifFalse: - (#(reverseDisplayFrom:to:) includes: thisContext sender method selector) ifFalse: [self halt]. ^(oop bitAnd: 1) = 0! Item was removed: - ----- Method: StackInterpreterSimulator>>sqGrowMemory:By: (in category 'memory access') ----- - sqGrowMemory: oldLimit By: delta - - transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr. - objectMemory memory: objectMemory memory , (objectMemory memory class new: delta // 4). - ^ objectMemory memory size * 4!

1 0

VM Maker: VMMaker.oscog-eem.410.mcz
by commits＠source.squeak.org 25 Sep '13

25 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.410.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.410 Author: eem Time: 25 September 2013, 12:05:46.443 am UUID: 44528c31-6609-4ea6-8817-4935e5166568 Ancestors: VMMaker.oscog-eem.409 Fix bug in SpurMemMgr>>allocateOldSpaceChunkOfBytes: so it won't try to create slivers of size 8 byets when splitting free chunks. Fix nonIndexablePointerFormat to answer the right value. Explicitly comment the result guaranteed to be young property of the eeInstantiate* routines. Implement allocateNewSpaceSlots:format:classIndex: for SpurMemMgr & implement its eeInstantiate* routines using it. Adapt createActualMessage: to Spur (fast alloc given class indices). Eliminate padding from shortPrintOop: =============== Diff against VMMaker.oscog-eem.409 =============== Item was changed: ----- Method: NewObjectMemory>>eeInstantiateClassIndex:format:numSlots: (in category 'interpreter access') ----- eeInstantiateClassIndex: compactClassIndex format: objFormat numSlots: numSlots "Instantiate an instance of a compact class. ee stands for execution engine and implies that this allocation will *NOT* cause a GC. N.B. the instantiated object IS NOT FILLED and must be completed before returning it to Smalltalk. Since this + call is used in routines that do just that we are safe. Break this rule and die in GC. + Result is guaranteed to be young." - call is used in routines that do just that we are safe. Break this rule and die in GC." <api> | hash header1 header2 byteSize header3 hdrSize | <inline: false> "cannot have a negative indexable field count" self assert: (numSlots >= 0 and: [compactClassIndex ~= 0]). self assert: (objFormat < self firstByteFormat ifTrue: [objFormat] ifFalse: [objFormat bitAnd: self byteFormatMask]) = (self instSpecOfClass: (self compactClassAt: compactClassIndex)). hash := self newObjectHash. "Low 2 bits are 0" header1 := (objFormat << self instFormatFieldLSB bitOr: compactClassIndex << 12) bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset. self assert: "sizeHiBits" ((self formatOfClass: (self compactClassAt: compactClassIndex)) bitAnd: 16r60000) >> 9 = 0. self flag: #sizeLowBits. "size in bytes -- low 2 bits are 0; may need another shift if 64-bits. strangely, size includes size of header, but only of single header. why include header size at all? gives us an extra word." byteSize := numSlots << (ShiftForWord + (ShiftForWord-2)) + BaseHeaderSize. (BytesPerWord = 8 "David, please check this!!!!" and: [objFormat >= self firstLongFormat "32-bit longs and byte objects" and: [(numSlots bitAnd: 1) ~= 0]]) ifTrue: ["extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)" header1 := header1 bitOr: 4]. byteSize > 255 "requires size header word/full header" ifTrue: [header3 := byteSize. hdrSize := 3. header2 := self compactClassAt: compactClassIndex] ifFalse: [header1 := header1 bitOr: byteSize. hdrSize := 1]. ^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3! Item was changed: ----- Method: NewObjectMemory>>eeInstantiateMethodContextSlots: (in category 'interpreter access') ----- eeInstantiateMethodContextSlots: numSlots "This version of instantiateClass assumes that the total object size is under 256 bytes, the limit for objects with only one or two header words. Note that the size is specified in bytes and should include four bytes for the base header word. + Will *not* cause a GC. Result is guaranteed to be young." - Will *not* cause a GC." | sizeInBytes hash header1 | self assert: (numSlots = SmallContextSlots or: [numSlots = LargeContextSlots]). sizeInBytes := numSlots * BytesPerOop + BaseHeaderSize. self assert: sizeInBytes <= SizeMask. hash := self newObjectHash. header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: self formatOfMethodContextMinusSize. self assert: (header1 bitAnd: CompactClassMask) > 0. "contexts must be compact" self assert: (header1 bitAnd: SizeMask) = 0. "OR size into header1. Must not do this if size > SizeMask" header1 := header1 + sizeInBytes. ^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: nil h3: nil! Item was changed: ----- Method: NewObjectMemory>>eeInstantiateSmallClass:numSlots: (in category 'interpreter access') ----- eeInstantiateSmallClass: classPointer numSlots: numSlots + "This version of instantiateClass assumes that the total object size is under + 256 bytes, the limit for objects with only one or two header words. - "This version of instantiateClass assumes that the total object - size is under 256 bytes, the limit for objects with only one or - two header words. NOTE this code will only work for sizes that are an integral number of words + (hence not a 32-bit LargeInteger in a 64-bit system). - (like not a 32-bit LargeInteger in a 64-bit system). - Will *not* cause a GC. Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak. + Since this call is used in routines that do just that we are safe. Break this rule and die in GC. + Will *not* cause a GC. Result is guaranteed to be young." - Since this call is used in routines that do just that we are safe. Break this rule and die." | sizeInBytes hash header1 header2 hdrSize | sizeInBytes := numSlots << ShiftForWord + BaseHeaderSize. self assert: sizeInBytes <= 252. hash := self newObjectHash. header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: (self formatOfClass: classPointer). header2 := classPointer. hdrSize := (header1 bitAnd: CompactClassMask) > 0 "is this a compact class" ifTrue: [1] ifFalse: [2]. header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)). ^self eeAllocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: 0! Item was changed: ----- Method: Spur32BitMMLESimulator>>scavengingGC (in category 'generation scavenging') ----- scavengingGC "Run the scavenger." + self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19) + ifTrue: ['th'] + ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'. - self halt: (statScavenges + 1) printString, (#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th'), ' scavenge'. ^super scavengingGC! Item was added: + ----- Method: Spur32BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') ----- + allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex + | numBytes newObj | + "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), + 16 bytes otherwise (num slots in preceeding word). + Objects always have at least one slot, for the forwarding pointer, + and are multiples of 8 bytes in length." + numSlots >= self numSlotsMask + ifTrue: + [newObj := freeStart + self baseHeaderSize. + numBytes := self baseHeaderSize + self baseHeaderSize "double header" + + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit" + ifFalse: + [newObj := freeStart. + numBytes := self baseHeaderSize "single header" + + (numSlots <= 1 + ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" + ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit" + freeStart + numBytes > scavengeThreshold ifTrue: + [needGCFlag ifFalse: [self scheduleScavenge]. + freeStart + numBytes > scavenger eden limit ifTrue: + [^self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:']]. + numSlots >= self numSlotsMask + ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" + [self flag: #endianness. + self longAt: freeStart put: numSlots. + self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] + ifFalse: + [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. + self assert: numBytes \\ self allocationUnit = 0. + self assert: newObj \\ self allocationUnit = 0. + freeStart := freeStart + numBytes. + ^newObj! Item was added: + ----- Method: Spur64BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') ----- + allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex + | numBytes newObj | + "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), + 16 bytes otherwise (num slots in preceeding word). + Objects always have at least one slot, for the forwarding pointer, + and are multiples of 8 bytes in length." + numSlots >= self numSlotsMask + ifTrue: + [numSlots > 16rffffffff ifTrue: + [^nil]. + newObj := freeStart + self baseHeaderSize. + numBytes := (self baseHeaderSize + self baseHeaderSize) "double header" + + (numSlots * self bytesPerSlot)] + ifFalse: + [newObj := freeStart. + numBytes := self baseHeaderSize "single header" + + (numSlots < 1 + ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" + ifFalse: [numSlots * self bytesPerSlot])]. + + freeStart + numBytes > scavengeThreshold ifTrue: + [needGCFlag ifFalse: [self scheduleScavenge]. + freeStart + numBytes > scavenger eden limit ifTrue: + [^self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:']]. + numSlots >= self numSlotsMask + ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" + [self flag: #endianness. + self longAt: freeStart put: numSlots. + self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] + ifFalse: + [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. + self assert: numBytes \\ self allocationUnit = 0. + self assert: newObj \\ self allocationUnit = 0. + freeStart := freeStart + numBytes. + ^newObj! Item was added: + ----- Method: SpurMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') ----- + allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex + self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes "Answer a chunk of oldSpace from the free lists, if available, otherwise answer nil. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." | initialIndex chunk index nodeBytes parent child smaller larger | "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" initialIndex := chunkBytes / self allocationUnit. (initialIndex < NumFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue: [(chunk := freeLists at: initialIndex) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). ^self unlinkFreeChunk: chunk atIndex: initialIndex]. freeListsMask := freeListsMask - (1 << initialIndex). "first search for free chunks of a multiple of chunkBytes in size" index := initialIndex. [(index := index + index) < NumFreeLists and: [1 << index <= freeListsMask]] whileTrue: [((freeListsMask anyMask: 1 << index) and: [(chunk := freeLists at: index) ~= 0]) ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = (index * self allocationUnit). self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]]. + "now get desperate and use the first that'll fit. + Note that because the minimum free size is 16 bytes (2 * allocationUnit), to + leave room for the forwarding pointer/next free link, we can only break chunks + that are at least 16 bytes larger, hence start at initialIndex + 2." + index := initialIndex + 1. - "now get desperate and use the first that'll fit" - index := initialIndex. [(index := index + 1) < NumFreeLists and: [1 << index <= freeListsMask]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = (index * self allocationUnit). self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "Large chunk, or no space on small free lists. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks. When the search ends parent should hold the smallest chunk at least as large as chunkBytes, or 0 if none." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [| childBytes | self assert: (self isFreeObject: child). childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). ^self startOfObject: chunk]. child := 0]. "break out of loop to remove interior node" childBytes < chunkBytes ifTrue: "walk down the tree" [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] ifFalse: [parent := child. nodeBytes := childBytes. child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]. parent = 0 ifTrue: [totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" self halt]. "self printFreeChunk: parent" self assert: nodeBytes >= chunkBytes. self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. "no list; remove an interior node; reorder tree simply. two cases (which have mirrors, for four total): case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | S | _/_ | S | case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. add the left subtree to the bottom left of the right subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | R | _/_ _\_ _/_ | L | | R | | L |" chunk := parent. smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. parent = 0 ifTrue: "no parent; stitch the subnodes back into the root" [smaller = 0 ifTrue: [freeLists at: 0 put: larger] ifFalse: [freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]] ifFalse: "parent; stitch back into appropriate side of parent." [smaller = 0 ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent withValue: larger] ifFalse: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) ofFreeChunk: parent withValue: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]]. "if there's space left over, add the fragment back." chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk! Item was changed: + ----- Method: SpurMemoryManager>>eeInstantiateClassIndex:format:numSlots: (in category 'instantiation') ----- - ----- Method: SpurMemoryManager>>eeInstantiateClassIndex:format:numSlots: (in category 'allocation') ----- eeInstantiateClassIndex: knownClassIndex format: objFormat numSlots: numSlots "Instantiate an instance of a compact class. ee stands for execution engine and implies that this allocation will *NOT* cause a GC. N.B. the instantiated object IS NOT FILLED and must be completed before returning it to Smalltalk. Since this + call is used in routines that do just that we are safe. Break this rule and die in GC. + Result is guaranteed to be young." - call is used in routines that do just that we are safe. Break this rule and die in GC." <inline: true> self assert: (numSlots > 0 and: [knownClassIndex ~= 0]). self assert: (objFormat < self firstByteFormat ifTrue: [objFormat] ifFalse: [objFormat bitAnd: self byteFormatMask]) = (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)). + ^self allocateNewSpaceSlots: numSlots format: objFormat classIndex: knownClassIndex! - ^self allocateSlots: numSlots format: objFormat classIndex: knownClassIndex! Item was changed: + ----- Method: SpurMemoryManager>>eeInstantiateMethodContextSlots: (in category 'instantiation') ----- - ----- Method: SpurMemoryManager>>eeInstantiateMethodContextSlots: (in category 'allocation') ----- eeInstantiateMethodContextSlots: numSlots + "Allocate a new MethodContext. ee stands for execution engine and + implies that this allocation will *NOT* cause a GC. N.B. the instantiated object + IS NOT FILLED and must be completed before returning it to Smalltalk. Since this + call is used in routines that do just that we are safe. Break this rule and die in GC. + Result is guaranteed to be young." <inline: true> + <inline: true> ^self + allocateNewSpaceSlots: numSlots - allocateSlots: numSlots format: self indexablePointersFormat classIndex: ClassMethodContextCompactIndex! Item was changed: + ----- Method: SpurMemoryManager>>eeInstantiateSmallClass:numSlots: (in category 'instantiation') ----- - ----- Method: SpurMemoryManager>>eeInstantiateSmallClass:numSlots: (in category 'allocation') ----- eeInstantiateSmallClass: classObj numSlots: numSlots + "Instantiate an instance of a class, with only a few slots. ee stands for execution + engine and implies that this allocation will *NOT* cause a GC. N.B. the instantiated + object IS NOT FILLED and must be completed before returning it to Smalltalk. Since + this call is used in routines that do just that we are safe. Break this rule and die in GC. + Result is guaranteed to be young." | classIndex | <inline: true> classIndex := self ensureBehaviorHash: classObj. ^self eeInstantiateClassIndex: classIndex format: (self instSpecOfClass: classObj) numSlots: numSlots! Item was changed: ----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') ----- enterIntoClassTable: aBehavior "Enter aBehavior into the class table and answer 0. Otherwise answer a primitive failure code." + <inline: false> | initialMajorIndex majorIndex minorIndex page | majorIndex := classTableIndex >> self classTableMajorIndexShift. initialMajorIndex := majorIndex. "classTableIndex should never index the first page; it's reserved for known classes" self assert: initialMajorIndex > 0. minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask. [page := self fetchPointer: majorIndex ofObject: classTableRootObj. page = nilObj ifTrue: [page := self allocateSlotsInOldSpace: self classTablePageSize format: self arrayFormat classIndex: self arrayClassIndexPun. page ifNil: [^PrimErrNoMemory]. self fillObj: page numSlots: self classTablePageSize with: nilObj. self storePointer: majorIndex ofObject: classTableRootObj withValue: page. minorIndex := 0]. minorIndex to: self classTablePageSize - 1 do: [:i| (self fetchPointer: i ofObject: page) = nilObj ifTrue: [classTableIndex := majorIndex << self classTableMajorIndexShift + i. self storePointer: i ofObject: page withValue: aBehavior. self setHashBitsOf: aBehavior to: classTableIndex. self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior. "now fault-in method lookup chain." self scanClassPostBecome: aBehavior effects: BecamePointerObjectFlag+BecameCompiledMethodFlag. ^0]]. majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1. majorIndex = initialMajorIndex ifTrue: "wrapped; table full" [^PrimErrLimitExceeded]] repeat! Item was changed: + ----- Method: SpurMemoryManager>>instantiateClass: (in category 'instantiation') ----- - ----- Method: SpurMemoryManager>>instantiateClass: (in category 'allocation') ----- instantiateClass: classObj | instSpec classFormat numSlots classIndex newObj | classFormat := self formatOfClass: classObj. instSpec := self instSpecOfClassFormat: classFormat. (self isFixedSizePointerFormat: instSpec) ifFalse: [^nil]. classIndex := self ensureBehaviorHash: classObj. classIndex < 0 ifTrue: [coInterpreter primitiveFailFor: classIndex negated. ^nil]. numSlots := self fixedFieldsOfClassFormat: classFormat. newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex. newObj ifNotNil: [self fillObj: newObj numSlots: numSlots with: nilObj]. ^newObj! Item was changed: + ----- Method: SpurMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') ----- - ----- Method: SpurMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') ----- instantiateClass: classObj indexableSize: nElements ^self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') ----- isIntegerObject: oop "This list records the valid senders of isIntegerObject: as we replace uses of isIntegerObject: by isImmediate: where appropriate." | sel | sel := thisContext sender method selector. (#( DoIt DoItIn: on:do: "from the debugger" makeBaseFrameFor: quickFetchInteger:ofObject: frameOfMarriedContext: objCouldBeClassObj: isMarriedOrWidowedContext: shortPrint: bytecodePrimAt bytecodePrimAtPut commonAt: commonAtPut: loadFloatOrIntFrom: positive32BitValueOf: primitiveExternalCall checkedIntegerValueOf: bytecodePrimAtPut commonAtPut: primitiveVMParameter checkIsStillMarriedContext:currentFP: displayBitsOf:Left:Top:Right:Bottom: fetchStackPointerOf: primitiveContextAt primitiveContextAtPut subscript:with:storing:format: printContext: compare31or32Bits:equal: signed64BitValueOf: primDigitMultiply:negative: digitLength: isNegativeIntegerValueOf: magnitude64BitValueOf: primitiveMakePoint primitiveAsCharacter primitiveInputSemaphore baseFrameReturn primitiveExternalCall primDigitCompare: isLiveContext: numPointerSlotsOf: fileValueOf: loadBitBltDestForm fetchIntOrFloat:ofObject:ifNil: fetchIntOrFloat:ofObject: loadBitBltSourceForm loadPoint:from: primDigitAdd: primDigitSubtract: positive64BitValueOf: digitBitLogic:with:opIndex: signed32BitValueOf: isNormalized: + primDigitDiv:negative: + bytesOrInt:growTo:) includes: sel) ifFalse: - primDigitDiv:negative:) includes: sel) ifFalse: [self halt]. ^(oop bitAnd: 1) ~= 0! Item was changed: ----- Method: SpurMemoryManager>>nonIndexablePointerFormat (in category 'header format') ----- nonIndexablePointerFormat + ^1! - ^2! Item was changed: ----- Method: StackInterpreter>>createActualMessageTo: (in category 'message sending') ----- createActualMessageTo: lookupClass "Bundle up the selector, arguments and lookupClass into a Message object. In the process it pops the arguments off the stack, and pushes the message object. This can then be presented as the argument of e.g. #doesNotUnderstand:" | argumentArray message | <inline: false> "This is a useful break-point" self assert: ((objectMemory isImmediate: messageSelector) or: [objectMemory addressCouldBeObj: messageSelector]). + objectMemory hasSpurMemoryManagerAPI + ifTrue: + [argumentArray := objectMemory + eeInstantiateClassIndex: ClassArrayCompactIndex + format: objectMemory arrayFormat + numSlots: argumentCount. + message := objectMemory + eeInstantiateClassIndex: ClassMessageCompactIndex + format: objectMemory nonIndexablePointerFormat + numSlots: MessageLookupClassIndex + 1] + ifFalse: + [argumentArray := objectMemory + eeInstantiateClass: (objectMemory splObj: ClassArray) + indexableSize: argumentCount. + message := objectMemory + eeInstantiateClass: (objectMemory splObj: ClassMessage) + indexableSize: 0]. - argumentArray := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount. - message := objectMemory eeInstantiateClass: (objectMemory splObj: ClassMessage) indexableSize: 0. "Since the array is new can use unchecked stores." + (argumentCount - 1) * BytesPerOop to: 0 by: BytesPerOop negated do: - (argumentCount - 1) * BytesPerWord to: 0 by: BytesPerWord negated do: [:i| self longAt: argumentArray + objectMemory baseHeaderSize + i put: self popStack]. "Since message is new can use unchecked stores." objectMemory storePointerUnchecked: MessageSelectorIndex ofObject: message withValue: messageSelector; storePointerUnchecked: MessageArgumentsIndex ofObject: message withValue: argumentArray; storePointerUnchecked: MessageLookupClassIndex ofObject: message withValue: lookupClass. self push: message. argumentCount := 1.! Item was changed: ----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') ----- shortPrintOop: oop <inline: false> + self printHexnp: oop. - self printHex: oop. (objectMemory isImmediate: oop) ifTrue: [(objectMemory isImmediateCharacter: oop) ifTrue: [^self cCode: 'printf("=$%ld ($%c)\n", (long)characterValueOf(oop), (long)characterValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]]. ^self cCode: 'printf("=%ld\n", (long)integerValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]]. (objectMemory addressCouldBeObj: oop) ifFalse: [self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [' is misaligned'] ifFalse: [' is not on the heap']); cr. ^nil]. ((objectMemory isFreeObject: oop) or: [objectMemory isForwarded: oop]) ifTrue: [^self printOop: oop]. self print: ': a(n) '. self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5. self cr!

1 0

VM Maker: Cog-eem.101.mcz
by commits＠source.squeak.org 25 Sep '13

25 Sep '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.101.mcz ==================== Summary ==================== Name: Cog-eem.101 Author: eem Time: 24 September 2013, 11:47:09.097 pm UUID: 0e43bfd4-7860-4b18-b7f3-3ef0a17c0ce8 Ancestors: Cog-eem.100 SpurBootstrap Add a method for digitValue: that doesn't use CharacterTable. N.B. uses such as this in RePattern pattern _ (aString, (Character characterTable at: 1) asString). "Must be Zero-Terminated" must change. In the above case the following is equivalent and faster: pattern _ (aString, (ByteString new: 1). "Must be Zero-Terminated" =============== Diff against Cog-eem.100 =============== Item was added: + ----- Method: SpurBootstrap class>>CharacterclassPROTOTYPEdigitValue: (in category 'method prototypes') ----- + CharacterclassPROTOTYPEdigitValue: x + "Answer the Character whose digit value is x. For example, + answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35." + + | n | + n := x asInteger. + ^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])!

1 0

VM Maker: VMMaker.oscog-eem.409.mcz
by commits＠source.squeak.org 25 Sep '13

25 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.409.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.409 Author: eem Time: 24 September 2013, 5:13:52.723 pm UUID: 00fb78b3-11aa-450f-ba56-3eb8c3f9f082 Ancestors: VMMaker.oscog-eem.408 Fix wrong index bugs in allocateOldSpaceChunkOfBytes:. Implement removing interior nodes from the free tree there-in. Bootstrap of startreader image now hits assert failure when trying to free an 8-byte sliver, instead of corrupting the free space lists. Refactor the oldSpace allocation chain to avoid duplications of bytesInObject: and/or objectBytesForSlots: calculations. Abstract out free space check to its own method. Add (more) asserts to some free space routines. =============== Diff against VMMaker.oscog-eem.408 =============== Item was changed: ----- Method: InterpreterPrimitives>>primitiveNewWithArg (in category 'object access primitives') ----- primitiveNewWithArg "Allocate a new indexable instance. Fail if the allocation would leave less than lowSpaceThreshold bytes free. May cause a GC." | size spaceOkay | size := self positive32BitValueOf: self stackTop. + self cppIf: NewspeakVM + ifTrue: "For the mirror prims check that the class obj is actually a valid class." + [(argumentCount < 2 + or: [self addressCouldBeClassObj: (self stackValue: 1)]) ifFalse: + [self primitiveFailFor: PrimErrBadArgument]]. (self successful and: [size >= 0]) ifTrue: [objectMemory hasSpurMemoryManagerAPI ifTrue: [(objectMemory instantiateClass: (self stackValue: 1) indexableSize: size) ifNotNil: [:obj| self pop: argumentCount + 1 thenPush: obj] ifNil: [self primitiveFailFor: PrimErrNoMemory]] ifFalse: [spaceOkay := objectMemory sufficientSpaceToInstantiate: (self stackValue: 1) indexableSize: size. spaceOkay ifTrue: [self pop: argumentCount + 1 thenPush: (objectMemory instantiateClass: (self stackValue: 1) indexableSize: size)] ifFalse: [self primitiveFailFor: PrimErrNoMemory]]] ifFalse: [self primitiveFailFor: PrimErrBadArgument]! Item was changed: ----- Method: Spur32BitMMLESimulator>>longAt:put: (in category 'memory access') ----- longAt: byteAddress put: a32BitValue "Note: Adjusted for Smalltalk's 1-based array indexing." + "(byteAddress = 16r1614CB8 and: [a32BitValue = 16rA000035]) ifTrue: - "(byteAddress = 16r11D8240 and: [a32BitValue = 16r1D8368]) ifTrue: [self halt]." byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError]. ^memory at: byteAddress // 4 + 1 put: a32BitValue! Item was changed: ----- Method: Spur32BitMMLESimulator>>longLongAt:put: (in category 'memory access') ----- longLongAt: byteAddress put: a64BitValue - "memory is a Bitmap, a 32-bit indexable array of bits" byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError]. + self + longAt: byteAddress put: (a64BitValue bitAnd: 16rffffffff); + longAt: byteAddress + 4 put: a64BitValue >> 32. - "(byteAddress = 16r11D8240 and: [(a64BitValue bitAnd: 16rffffffff) = 16r1D8368]) ifTrue: - [self halt]." - memory - at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff); - at: byteAddress // 4 + 2 put: a64BitValue >> 32. ^a64BitValue! Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | numBytes newObj | "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), 16 bytes otherwise (num slots in preceeding word). Objects always have at least one slot, for the forwarding pointer, and are multiples of 8 bytes in length." numSlots >= self numSlotsMask ifTrue: [newObj := freeStart + self baseHeaderSize. numBytes := self baseHeaderSize + self baseHeaderSize "double header" + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit" ifFalse: [newObj := freeStart. numBytes := self baseHeaderSize "single header" + (numSlots <= 1 ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit" freeStart + numBytes > scavengeThreshold ifTrue: [needGCFlag ifFalse: [self scheduleScavenge]. freeStart + numBytes > scavenger eden limit ifTrue: + [^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]]. - [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: freeStart put: numSlots. self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] ifFalse: [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. self assert: numBytes \\ self allocationUnit = 0. self assert: newObj \\ self allocationUnit = 0. freeStart := freeStart + numBytes. ^newObj! Item was added: + ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- + allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex + "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header + will have been filled-in but not the contents." + | chunk | + chunk := self allocateOldSpaceChunkOfBytes: totalBytes. + self checkFreeSpace. + chunk ifNil: + [^nil]. + numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" + [self flag: #endianness. + self longAt: chunk put: numSlots. + self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift. + self longLongAt: chunk + self baseHeaderSize + put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). + ^chunk + self baseHeaderSize]. + self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). + ^chunk! Item was removed: - ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') ----- - allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex - "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header - will have been filled-in but not the contents." - | bytes chunk | - bytes := self objectBytesForSlots: numSlots. - chunk := self allocateOldSpaceChunkOfBytes: bytes. - self assert: totalFreeOldSpace = self totalFreeListBytes. - chunk ifNil: - [^nil]. - numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" - [self flag: #endianness. - self longAt: chunk put: numSlots. - self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift. - self longLongAt: chunk + self baseHeaderSize - put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). - ^chunk + self baseHeaderSize]. - self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). - ^chunk! Item was changed: ----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') ----- instantiateClass: classObj indexableSize: nElements | instSpec classFormat numSlots classIndex newObj fillValue | classFormat := self formatOfClass: classObj. instSpec := self instSpecOfClassFormat: classFormat. fillValue := 0. instSpec caseOf: { [self arrayFormat] -> [numSlots := nElements. fillValue := nilObj]. [self indexablePointersFormat] -> [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. fillValue := nilObj]. [self weakArrayFormat] -> [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. fillValue := nilObj]. [self sixtyFourBitIndexableFormat] -> [numSlots := nElements * 2]. [self firstLongFormat] -> [numSlots := nElements]. [self firstShortFormat] -> [numSlots := nElements + 1 // 2. instSpec := instSpec + (nElements bitAnd: 1)]. [self firstByteFormat] -> [numSlots := nElements + 3 // 4. instSpec := instSpec + (4 - nElements bitAnd: 3)]. [self firstCompiledMethodFormat] -> [numSlots := nElements + 3 // 4. instSpec := instSpec + (4 - nElements bitAnd: 3)] } + otherwise: ["some Squeak images include funky fixed subclasses of abstract variable + superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection. + Allow fixed classes to be instantiated here iff nElements = 0." + numSlots := self fixedFieldsOfClassFormat: classFormat. + nElements ~= 0 ifTrue: + [^nil]]. "non-indexable" - otherwise: [^nil]. "non-indexable" classIndex := self ensureBehaviorHash: classObj. classIndex < 0 ifTrue: [coInterpreter primitiveFailFor: classIndex negated. ^nil]. newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex. newObj ifNotNil: [self fillObj: newObj numSlots: numSlots with: fillValue]. ^newObj! Item was changed: ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') ----- allocateSlots: numSlots format: formatField classIndex: classIndex | numBytes newObj | "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow), 16 bytes otherwise (num slots in preceeding word). Objects always have at least one slot, for the forwarding pointer, and are multiples of 8 bytes in length." numSlots >= self numSlotsMask ifTrue: [numSlots > 16rffffffff ifTrue: [^nil]. newObj := freeStart + self baseHeaderSize. numBytes := (self baseHeaderSize + self baseHeaderSize) "double header" + (numSlots * self bytesPerSlot)] ifFalse: [newObj := freeStart. numBytes := self baseHeaderSize "single header" + (numSlots < 1 ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer" ifFalse: [numSlots * self bytesPerSlot])]. freeStart + numBytes > scavengeThreshold ifTrue: [needGCFlag ifFalse: [self scheduleScavenge]. freeStart + numBytes > scavenger eden limit ifTrue: + [^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]]. - [^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: freeStart put: numSlots. self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift. self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)] ifFalse: [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)]. self assert: numBytes \\ self allocationUnit = 0. self assert: newObj \\ self allocationUnit = 0. freeStart := freeStart + numBytes. ^newObj! Item was added: + ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') ----- + allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex + "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header + will have been filled-in but not the contents." + | chunk | + chunk := self allocateOldSpaceChunkOfBytes: totalBytes. + chunk ifNil: + [^nil]. + numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" + [self longAt: chunk + put: numSlots + (self numSlotsMask << self numSlotsFullShift). + self longAt: chunk + self baseHeaderSize + put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). + ^chunk + self baseHeaderSize]. + self longAt: chunk + put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). + ^chunk! Item was removed: - ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') ----- - allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex - "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header - will have been filled-in but not the contents." - | bytes chunk | - bytes := self objectBytesForSlots: numSlots. - chunk := self allocateOldSpaceChunkOfBytes: bytes. - chunk ifNil: - [^nil]. - numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" - [self longAt: chunk - put: numSlots + (self numSlotsMask << self numSlotsFullShift). - self longAt: chunk + self baseHeaderSize - put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). - ^chunk + self baseHeaderSize]. - self longAt: chunk - put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). - ^chunk! Item was removed: - ----- Method: SpurMemoryManager>>addToFreeList: (in category 'free space') ----- - addToFreeList: freeChunk - | chunkBytes childBytes parent child index | - "coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk." - chunkBytes := self bytesInObject: freeChunk. - index := chunkBytes / self allocationUnit. - index < NumFreeLists ifTrue: - [self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index). - freeLists at: index put: freeChunk. - freeListsMask := freeListsMask bitOr: 1 << index. - ^self]. - freeListsMask := freeListsMask bitOr: 1. - self - storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0; - storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0; - storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0; - storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0. - "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. - Beneath the node are smaller and larger blocks." - parent := 0. - child := freeLists at: 0. - [child ~= 0] whileTrue: - [childBytes := self bytesInObject: child. - childBytes = chunkBytes ifTrue: "size match; add to list at node." - [self storePointer: self freeChunkNextIndex - ofFreeChunk: freeChunk - withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); - storePointer: self freeChunkNextIndex - ofFreeChunk: child - withValue: freeChunk. - ^self]. - "walk down the tree" - parent := child. - child := self fetchPointer: (childBytes > chunkBytes - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofObject: child]. - parent = 0 ifTrue: - [self assert: (freeLists at: 0) = 0. - freeLists at: 0 put: freeChunk. - ^self]. - "insert in tree" - self storePointer: self freeChunkParentIndex - ofFreeChunk: freeChunk - withValue: parent. - self storePointer: (childBytes > chunkBytes - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofFreeChunk: parent - withValue: freeChunk! Item was added: + ----- Method: SpurMemoryManager>>addToFreeList:bytes: (in category 'free space') ----- + addToFreeList: freeChunk bytes: chunkBytes + | childBytes parent child index | + "coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk." + self assert: (self isFreeObject: freeChunk). + self assert: chunkBytes = (self bytesInObject: freeChunk). + index := chunkBytes / self allocationUnit. + index < NumFreeLists ifTrue: + [self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index). + freeLists at: index put: freeChunk. + freeListsMask := freeListsMask bitOr: 1 << index. + ^self]. + freeListsMask := freeListsMask bitOr: 1. + self + storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0; + storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0. + "Large chunk list organized as a tree, each node of which is a list of chunks of the same size. + Beneath the node are smaller and larger blocks." + parent := 0. + child := freeLists at: 0. + [child ~= 0] whileTrue: + [childBytes := self bytesInObject: child. + childBytes = chunkBytes ifTrue: "size match; add to list at node." + [self storePointer: self freeChunkNextIndex + ofFreeChunk: freeChunk + withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child); + storePointer: self freeChunkNextIndex + ofFreeChunk: child + withValue: freeChunk. + ^self]. + "walk down the tree" + parent := child. + child := self fetchPointer: (childBytes > chunkBytes + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofObject: child]. + parent = 0 ifTrue: + [self assert: (freeLists at: 0) = 0. + freeLists at: 0 put: freeChunk. + ^self]. + "insert in tree" + self storePointer: self freeChunkParentIndex + ofFreeChunk: freeChunk + withValue: parent. + self storePointer: (childBytes > chunkBytes + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: parent + withValue: freeChunk! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes "Answer a chunk of oldSpace from the free lists, if available, otherwise answer nil. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." + | initialIndex chunk index nodeBytes parent child smaller larger | - | index chunk nextIndex nodeBytes parent child smaller larger | "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" + initialIndex := chunkBytes / self allocationUnit. + (initialIndex < NumFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue: + [(chunk := freeLists at: initialIndex) ~= 0 ifTrue: - index := chunkBytes / self allocationUnit. - (index < NumFreeLists and: [1 << index <= freeListsMask]) ifTrue: - [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). + ^self unlinkFreeChunk: chunk atIndex: initialIndex]. + freeListsMask := freeListsMask - (1 << initialIndex). - ^self unlinkFreeChunk: chunk atIndex: index]. "first search for free chunks of a multiple of chunkBytes in size" + index := initialIndex. + [(index := index + index) < NumFreeLists + and: [1 << index <= freeListsMask]] whileTrue: - nextIndex := index. - [1 << index <= freeListsMask - and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue: [((freeListsMask anyMask: 1 << index) and: [(chunk := freeLists at: index) ~= 0]) ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. + self assert: (self bytesInObject: chunk) = (index * self allocationUnit). - self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]]. "now get desperate and use the first that'll fit" + index := initialIndex. + [(index := index + 1) < NumFreeLists + and: [1 << index <= freeListsMask]] whileTrue: - nextIndex := index. - [1 << index >= freeListsMask - and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. + self assert: (self bytesInObject: chunk) = (index * self allocationUnit). - self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "Large chunk, or no space on small free lists. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks of the same size. Beneath the node are smaller and larger blocks. When the search ends parent should hold the smallest chunk at least as large as chunkBytes, or 0 if none." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: [| childBytes | + self assert: (self isFreeObject: child). childBytes := self bytesInObject: child. childBytes = chunkBytes ifTrue: "size match; try to remove from list at node." [chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: child withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). ^self startOfObject: chunk]. child := 0]. "break out of loop to remove interior node" childBytes < chunkBytes ifTrue: "walk down the tree" [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] ifFalse: [parent := child. nodeBytes := childBytes. child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]. parent = 0 ifTrue: [totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" self halt]. "self printFreeChunk: parent" self assert: nodeBytes >= chunkBytes. self assert: (self bytesInObject: parent) = nodeBytes. "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. + "no list; remove an interior node; reorder tree simply. two cases (which have mirrors, for four total): - "no list; remove an interior node" - chunk := parent. - - smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. - larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. - parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. - - "no parent; stitch the subnodes back into the root" - parent = 0 ifTrue: - [smaller = 0 - ifTrue: [freeLists at: 0 put: larger] - ifFalse: - [freeLists at: 0 put: smaller. - larger ~= 0 ifTrue: - [self addFreeSubTree: larger]]. - "coInterpreter transcript ensureCr. - coInterpreter print: 'new free tree root '. - (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)]. - coInterpreter cr." - chunkBytes ~= nodeBytes ifTrue: - [self freeChunkWithBytes: nodeBytes - chunkBytes - at: (self startOfObject: chunk) + chunkBytes]. - ^self startOfObject: chunk]. - - "remove node from tree; reorder tree simply. two cases (which have mirrors, for four total): case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | S | _/_ | S | case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. add the left subtree to the bottom left of the right subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | R | _/_ _\_ _/_ | L | | R | | L |" + chunk := parent. + smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. + larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. + parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. + parent = 0 + ifTrue: "no parent; stitch the subnodes back into the root" + [smaller = 0 + ifTrue: [freeLists at: 0 put: larger] + ifFalse: + [freeLists at: 0 put: smaller. + larger ~= 0 ifTrue: + [self addFreeSubTree: larger]]] + ifFalse: "parent; stitch back into appropriate side of parent." + [smaller = 0 + ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: parent + withValue: larger] + ifFalse: + [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: parent + withValue: smaller. + larger ~= 0 ifTrue: + [self addFreeSubTree: larger]]]. + "if there's space left over, add the fragment back." - smaller = 0 - ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofFreeChunk: parent - withValue: larger] - ifFalse: - [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofFreeChunk: parent - withValue: smaller. - larger ~= 0 ifTrue: - [self addFreeSubTree: larger]]. chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk! Item was changed: ----- Method: SpurMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') ----- allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex + <inline: true> + ^self + allocateSlotsInOldSpace: numSlots + bytes: (self objectBytesForSlots: numSlots) + format: formatField + classIndex: classIndex! - self subclassResponsibility! Item was changed: ----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') ----- bytesInFreeTree: freeNode + | freeBytes bytesInObject listNode | - | freeBytes bytesInObject next | freeNode = 0 ifTrue: [^0]. freeBytes := 0. bytesInObject := self bytesInObject: freeNode. self assert: bytesInObject / self allocationUnit >= NumFreeLists. + self assert: (self isFreeObject: freeNode). + listNode := freeNode. + [listNode ~= 0] whileTrue: - next := freeNode. - [next ~= 0] whileTrue: [freeBytes := freeBytes + bytesInObject. + self assert: bytesInObject = (self bytesInObject: listNode). + listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode]. - self assert: bytesInObject = (self bytesInObject: next). - next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next]. ^freeBytes + (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeNode)) + (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeNode))! Item was added: + ----- Method: SpurMemoryManager>>checkFreeSpace (in category 'debug support') ----- + checkFreeSpace + self assert: totalFreeOldSpace = self totalFreeListBytes! Item was changed: ----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') ----- freeChunkWithBytes: bytes at: address <inline: true> | freeChunk | freeChunk := self initFreeChunkWithBytes: bytes at: address. + self addToFreeList: freeChunk bytes: bytes. - self addToFreeList: freeChunk. ^freeChunk! Item was changed: ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') ----- initializeOldSpaceFirstFree: startOfFreeOldSpace <var: 'startOfFreeOldSpace' type: #usqLong> | freeOldStart freeChunk | <var: 'freeOldStart' type: #usqLong> endOfMemory > startOfFreeOldSpace ifTrue: [totalFreeOldSpace := totalFreeOldSpace + (endOfMemory - startOfFreeOldSpace). freeOldStart := startOfFreeOldSpace. [endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue: [freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart. freeOldStart := freeOldStart + (2 raisedTo: 32). self assert: freeOldStart = (self addressAfter: freeChunk)]. freeOldStart < endOfMemory ifTrue: [freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. self assert: (self addressAfter: freeChunk) = endOfMemory]]. freeOldSpaceStart := endOfMemory. + self checkFreeSpace! - self assert: totalFreeOldSpace = self totalFreeListBytes! Item was changed: ----- Method: SpurMemoryManager>>scavengingGC (in category 'generation scavenging') ----- scavengingGC "Run the scavenger." self assert: remapBufferCount = 0. + self checkFreeSpace. - self assert: self totalFreeListBytes = totalFreeOldSpace. "coInterpreter printCallStackFP: coInterpreter framePointer" self runLeakCheckerForFullGC: false. coInterpreter preGCAction: GCModeIncr. needGCFlag := false. gcStartUsecs := coInterpreter ioUTCMicrosecondsNow. scavengeInProgress := true. pastSpaceStart := scavenger scavenge. self assert: (self oop: pastSpaceStart isGreaterThanOrEqualTo: scavenger pastSpace start andLessThanOrEqualTo: scavenger pastSpace limit). freeStart := scavenger eden start. self initSpaceForAllocationCheck: scavenger eden. scavengeInProgress := false. statScavenges := statScavenges + 1. statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow. statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs. statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs. coInterpreter postGCAction. self runLeakCheckerForFullGC: false. + self checkFreeSpace! - self assert: self totalFreeListBytes = totalFreeOldSpace! Item was added: + ----- Method: SpurMemoryManager>>statScavenges (in category 'accessing') ----- + statScavenges + ^statScavenges! Item was changed: ----- Method: SpurMemoryManager>>storePointer:ofFreeChunk:withValue: (in category 'heap management') ----- storePointer: fieldIndex ofFreeChunk: objOop withValue: valuePointer self assert: (self isFreeObject: objOop). + self assert: (valuePointer = 0 or: [self isFreeObject: objOop]). ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer! Item was changed: ----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') ----- totalFreeListBytes | freeBytes bytesInObject obj | freeBytes := 0. 1 to: NumFreeLists - 1 do: [:i| bytesInObject := i * self allocationUnit. obj := freeLists at: i. [obj ~= 0] whileTrue: [freeBytes := freeBytes + bytesInObject. self assert: bytesInObject = (self bytesInObject: obj). + self assert: (self isFreeObject: obj). obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]]. ^freeBytes + (self bytesInFreeTree: (freeLists at: 0))! Item was changed: ----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex: (in category 'free space') ----- unlinkFreeChunk: chunk atIndex: index <inline: true> + self assert: ((self bytesInObject: chunk) = (index * self allocationUnit) - self assert: ((self bytesInObject: chunk) = index * self allocationUnit and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit"]). freeLists at: index put: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). ^chunk!

1 0

VM Maker: VMMaker.oscog-eem.408.mcz
by commits＠source.squeak.org 25 Sep '13

25 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.408.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.408 Author: eem Time: 24 September 2013, 3:03:59.462 pm UUID: d156deea-74a3-4c80-8a1c-b7ead517f77f Ancestors: VMMaker.oscog-eem.407 Implement tree reorganization on removing an interior node of the free chunk tree. Plus fix the tree traversal which was nonsense. Add an assert to allocateSlotsInOldSpace:format:classIndex: to check that totalFreeOldSpace is maintained correctly. Remember to set the identityHash in the copy when scavenging. More protocol. =============== Diff against VMMaker.oscog-eem.407 =============== Item was changed: ----- Method: BalloonEngineBase>>loadTransformFrom:into:length: (in category 'loading state') ----- loadTransformFrom: transformOop into: destPtr length: n "Load a transformation from transformOop into the float array defined by destPtr. The transformation is assumed to be either an array or a FloatArray of length n." <inline: false> <var: #destPtr type:'float *'> transformOop = interpreterProxy nilObject ifTrue:[^false]. + (interpreterProxy isImmediate: transformOop) - (interpreterProxy isIntegerObject: transformOop) ifTrue:[^interpreterProxy primitiveFail]. (interpreterProxy slotSizeOf: transformOop) = n ifFalse:[^interpreterProxy primitiveFail]. (interpreterProxy isWords: transformOop) ifTrue:[self loadWordTransformFrom: transformOop into: destPtr length: n] ifFalse:[self loadArrayTransformFrom: transformOop into: destPtr length: n]. ^true! Item was added: + ----- Method: Spur32BitMMLESimulator>>floatValueOf: (in category 'simulation only') ----- + floatValueOf: obj + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter floatValueOf: obj! Item was added: + ----- Method: Spur32BitMMLESimulator>>halfWordHighInLong32: (in category 'memory access') ----- + halfWordHighInLong32: long32 + "Used by Balloon" + + ^long32 bitAnd: 16rFFFF! Item was added: + ----- Method: Spur32BitMMLESimulator>>halfWordLowInLong32: (in category 'memory access') ----- + halfWordLowInLong32: long32 + "Used by Balloon" + + ^long32 bitShift: -16! Item was added: + ----- Method: Spur32BitMMLESimulator>>isFloatObject: (in category 'simulation only') ----- + isFloatObject: oop + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter isFloatObject: oop! Item was added: + ----- Method: Spur32BitMMLESimulator>>pushFloat: (in category 'simulation only') ----- + pushFloat: f + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter pushFloat: f! Item was added: + ----- Method: Spur32BitMMLESimulator>>stackFloatValue: (in category 'simulation only') ----- + stackFloatValue: offset + "hack around the CoInterpreter/ObjectMemory split refactoring" + ^coInterpreter stackFloatValue: offset! Item was changed: ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') ----- allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header will have been filled-in but not the contents." | bytes chunk | bytes := self objectBytesForSlots: numSlots. chunk := self allocateOldSpaceChunkOfBytes: bytes. + self assert: totalFreeOldSpace = self totalFreeListBytes. chunk ifNil: [^nil]. numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word" [self flag: #endianness. self longAt: chunk put: numSlots. self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift. self longLongAt: chunk + self baseHeaderSize put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex). ^chunk + self baseHeaderSize]. self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex). ^chunk! Item was changed: ----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'scavenger') ----- copyAndForward: survivor "copyAndForward: survivor copies a survivor object either to futureSurvivorSpace or, if it is to be promoted, to oldSpace. It leaves a forwarding pointer behind." <inline: true> + | bytesInObject newLocation hash | - | bytesInObject newLocation | bytesInObject := manager bytesInObject: survivor. newLocation := ((self shouldBeTenured: survivor) or: [futureSurvivorStart + bytesInObject > futureSpace limit]) ifTrue: [self copyToOldSpace: survivor] ifFalse: [self copyToFutureSpace: survivor bytes: bytesInObject]. + hash := manager rawHashBitsOf: survivor. + hash ~= 0 ifTrue: + [manager setHashBitsOf: newLocation to: hash]. manager forward: survivor to: newLocation. ^newLocation! Item was changed: ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') ----- allocateOldSpaceChunkOfBytes: chunkBytes "Answer a chunk of oldSpace from the free lists, if available, otherwise answer nil. N.B. the chunk is simply a pointer, it has no valid header. The caller *must* fill in the header correctly." | index chunk nextIndex nodeBytes parent child smaller larger | + "for debugging:" "totalFreeOldSpace := self totalFreeListBytes" totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)" index := chunkBytes / self allocationUnit. (index < NumFreeLists and: [1 << index <= freeListsMask]) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). ^self unlinkFreeChunk: chunk atIndex: index]. "first search for free chunks of a multiple of chunkBytes in size" nextIndex := index. [1 << index <= freeListsMask and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue: [((freeListsMask anyMask: 1 << index) and: [(chunk := freeLists at: index) ~= 0]) ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]]. "now get desperate and use the first that'll fit" nextIndex := index. [1 << index >= freeListsMask and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue: [(freeListsMask anyMask: 1 << index) ifTrue: [(chunk := freeLists at: index) ~= 0 ifTrue: [self assert: chunk = (self startOfObject: chunk). self unlinkFreeChunk: chunk atIndex: index. self assert: (self bytesInObject: chunk) = index * self allocationUnit. self freeChunkWithBytes: index * self allocationUnit - chunkBytes at: (self startOfObject: chunk) + chunkBytes. ^chunk]. freeListsMask := freeListsMask - (1 << index)]]]. "Large chunk, or no space on small free lists. Search the large chunk list. Large chunk list organized as a tree, each node of which is a list of chunks + of the same size. Beneath the node are smaller and larger blocks. + When the search ends parent should hold the smallest chunk at least as + large as chunkBytes, or 0 if none." - of the same size. Beneath the node are smaller and larger blocks." parent := 0. child := freeLists at: 0. [child ~= 0] whileTrue: + [| childBytes | + childBytes := self bytesInObject: child. + childBytes = chunkBytes ifTrue: "size match; try to remove from list at node." + [chunk := self fetchPointer: self freeChunkNextIndex + ofFreeChunk: child. + chunk ~= 0 ifTrue: + [self storePointer: self freeChunkNextIndex + ofFreeChunk: child + withValue: (self fetchPointer: self freeChunkNextIndex + ofFreeChunk: chunk). + ^self startOfObject: chunk]. + child := 0]. "break out of loop to remove interior node" + childBytes < chunkBytes + ifTrue: "walk down the tree" + [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child] + ifFalse: + [parent := child. + nodeBytes := childBytes. + child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]. - [nodeBytes := self bytesInObject: child. - parent := child. - nodeBytes = chunkBytes - ifTrue: "size match; try to remove from list at node." - [chunk := self fetchPointer: self freeChunkNextIndex - ofFreeChunk: child. - chunk ~= 0 ifTrue: - [self storePointer: self freeChunkNextIndex - ofFreeChunk: child - withValue: (self fetchPointer: self freeChunkNextIndex - ofFreeChunk: chunk). - ^self startOfObject: chunk]. - child := 0] "break out of loop to remove interior node" - ifFalse:"walk down the tree" - [child := self fetchPointer: (nodeBytes > chunkBytes - ifTrue: [self freeChunkSmallerIndex] - ifFalse: [self freeChunkLargerIndex]) - ofFreeChunk: child]]. parent = 0 ifTrue: [totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded" self halt]. "self printFreeChunk: parent" + self assert: nodeBytes >= chunkBytes. self assert: (self bytesInObject: parent) = nodeBytes. + "attempt to remove from list" chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent. chunk ~= 0 ifTrue: [self storePointer: self freeChunkNextIndex ofFreeChunk: parent withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk). chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. + "no list; remove an interior node" chunk := parent. + + smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. + larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk. + "no parent; stitch the subnodes back into the root" parent = 0 ifTrue: + [smaller = 0 - [smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk. - larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk. - smaller = 0 ifTrue: [freeLists at: 0 put: larger] ifFalse: [freeLists at: 0 put: smaller. larger ~= 0 ifTrue: [self addFreeSubTree: larger]]. "coInterpreter transcript ensureCr. coInterpreter print: 'new free tree root '. (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)]. coInterpreter cr." chunkBytes ~= nodeBytes ifTrue: [self freeChunkWithBytes: nodeBytes - chunkBytes at: (self startOfObject: chunk) + chunkBytes]. ^self startOfObject: chunk]. + "remove node from tree; reorder tree simply. two cases (which have mirrors, for four total): case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | S | _/_ + | S | + + case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. - | S |" - self halt. - "case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree. add the left subtree to the bottom left of the right subtree (mirrored for large vs small) ___ ___ | P | | P | _/_ _/_ | N | => | R | _/_ _\_ _/_ | L | | R | | L |" + + smaller = 0 + ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: parent + withValue: larger] + ifFalse: + [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent) + ifTrue: [self freeChunkSmallerIndex] + ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: parent + withValue: smaller. + larger ~= 0 ifTrue: + [self addFreeSubTree: larger]]. + chunkBytes ~= nodeBytes ifTrue: + [self freeChunkWithBytes: nodeBytes - chunkBytes + at: (self startOfObject: chunk) + chunkBytes]. + ^self startOfObject: chunk! - self halt! Item was changed: ----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') ----- bytesInFreeTree: freeNode | freeBytes bytesInObject next | freeNode = 0 ifTrue: [^0]. freeBytes := 0. bytesInObject := self bytesInObject: freeNode. self assert: bytesInObject / self allocationUnit >= NumFreeLists. next := freeNode. [next ~= 0] whileTrue: [freeBytes := freeBytes + bytesInObject. self assert: bytesInObject = (self bytesInObject: next). next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next]. ^freeBytes + + (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeNode)) + + (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeNode))! - + (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: next)) - + (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: next))! Item was changed: ----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') ----- printFreeChunk: freeChunk <doNotGenerate> | numBytes | numBytes := self bytesInObject: freeChunk. coInterpreter + print: 'freeChunk '; printHexPtrnp: freeChunk; - print: 'freeChunk @ '; printHexPtr: freeChunk; print: ' bytes '; printNum: numBytes; + print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex + ofFreeChunk: freeChunk). - print: ' next '; print: (self fetchPointer: self freeChunkNextIndex - ofFreeChunk: freeChunk) hex. numBytes / self allocationUnit > NumFreeLists ifTrue: [coInterpreter + print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex + ofFreeChunk: freeChunk); + print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex + ofFreeChunk: freeChunk); + print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex + ofFreeChunk: freeChunk)]. - print: ' ^ '; print: (self fetchPointer: self freeChunkParentIndex - ofFreeChunk: freeChunk) hex; - print: ' < '; print: (self fetchPointer: self freeChunkSmallerIndex - ofFreeChunk: freeChunk) hex; - print: ' > '; print: (self fetchPointer: self freeChunkLargerIndex - ofFreeChunk: freeChunk) hex]. coInterpreter cr! Item was changed: ----- Method: StackInterpreter>>printHexPtr: (in category 'debug printing') ----- printHexPtr: p + "Print p in hex, padded to 10 characters in the form ' 0x1234'" - "Print p in hex, passed to 10 characters in the form ' 0x1234'" <inline: true> <var: #p type: #'void *'> self printHex: (self oopForPointer: p)! Item was added: + ----- Method: StackInterpreter>>printHexPtrnp: (in category 'debug printing') ----- + printHexPtrnp: p + "Print p in hex, unpadded, in the form '0x1234'" + <inline: true> + <var: #p type: #'void *'> + self printHexnp: (self oopForPointer: p)!

1 0

Re: [Vm-dev] VM Maker: Cog-eem.100.mcz
by tim Rowledge 24 Sep '13

24 Sep '13

On 24-09-2013, at 8:24 PM, commits(a)source.squeak.org wrote: > Name: Cog-eem.100 > Author: eem > Time: 24 September 2013, 1:24:54.567 pm > UUID: 95a46b20-6f47-408d-8ff0-9b1903ef860c > Ancestors: Cog-eem.99 > > Fix a typo in a prootype method. It's no good; you cannot escape the embrace of Tpyos! tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Half the people you know are below average.

1 0

VM Maker: VMMaker.oscog-eem.407.mcz
by commits＠source.squeak.org 24 Sep '13

24 Sep '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.407.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.407 Author: eem Time: 24 September 2013, 1:26:38.972 pm UUID: dc40b325-054d-4337-8d8b-a6402f3845ad Ancestors: VMMaker.oscog-eem.406 Comment SpurGenerationScavenger =============== Diff against VMMaker.oscog-eem.406 =============== Item was changed: CogClass subclass: #SpurGenerationScavenger instanceVariableNames: 'coInterpreter manager eden futureSpace pastSpace futureSurvivorStart rememberedSet rememberedSetSize tenuringThreshold tenuringProportion' classVariableNames: 'RememberedSetLimit RememberedSetRedZone' poolDictionaries: '' category: 'VMMaker-SpurMemoryManager'! + + !SpurGenerationScavenger commentStamp: 'eem 9/24/2013 13:04' prior: 0! + SpurGenerationScavenger is an implementation of David Ungar's Generation Scavenging garbage collection algorithm. See + Generation Scavenging, A Non-disruptive, High-Performance Storage Reclamation Algorithm + David Ungar + Proceeding + SDE 1 Proceedings of the first ACM SIGSOFT/SIGPLAN software engineering symposium on Practical software development environments + Pages 157 - 167 + ACM New York, NY, USA ©1984 + ISBN:0-89791-131-8 + + Also relevant are + An adaptive tenuring policy for generation scavengers + David Ungar & Frank Jackson + ACM Transactions on Programming Languages and Systems (TOPLAS) TOPLAS Homepage archive + Volume 14 Issue 1, Jan. 1992 + Pages 1 - 27 + ACM New York, NY, USA + + Instance Variables + coInterpreter: <StackInterpreterSimulator|CogVMSimulator> + eden: <SpurNewSpaceSpace> + futureSpace: <SpurNewSpaceSpace> + futureSurvivorStart: <Integer address> + manager: <SpurMemoryManager|Spur32BitMMLESimulator et al> + pastSpace: <SpurNewSpaceSpace> + rememberedSet: <CArrayAccessor on: Array> + rememberedSetSize: <Integer> + tenuringProportion: <Float> + tenuringThreshold: <Integer address> + + coInterpreter + - the interpreter/vm, in this context, the mutator + + eden + - the space containing newly created objects + + futureSpace + - the space to which surviving objects are copied during a scavenge + + futureSurvivorStart + - the allocation pointer into futureSpace + + manager + - the Spur memory manager + + pastSpace + - the space surviving objects live in until the next scavenge + + rememberedSet + - the root old space objects that refer to objects in new space; a scavenge starts form these roots and the interpreter's stack + + rememberedSetSize + - the size of the remembered set, also the first unused index in the rememberedSet + + tenuringProportion + - the amount of pastSpace below which the system will not tenure unless futureSpace fills up, and above which it will eagerly tenure + + tenuringThreshold + - the pointer into pastSpace below which objects will be tenured + ! Item was added: + ----- Method: SpurMemoryManager>>endOfMemory (in category 'accessing') ----- + endOfMemory + ^endOfMemory!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev September 2013