Vm-dev November 2013

vm-dev@lists.squeakfoundation.org

30 participants
103 discussions

VM Maker: VMMaker.oscog-eem.514.mcz
by commits＠source.squeak.org 18 Nov '13

18 Nov '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.514.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.514 Author: eem Time: 18 November 2013, 10:53:33.973 am UUID: f0432404-2a48-4dfd-8d71-05ce4ddfe6e7 Ancestors: VMMaker.oscog-eem.513 Make sure BaseHeaderSize is defined in the Spur cogit.c. Fix some type errors (tenuringThreshold needs to answer sqInt). Fix safePrintStringOf:. Can't have followForwarded: in an expression. Bring Spur32BitMMLECoSimulator up-to-date. =============== Diff against VMMaker.oscog-eem.513 =============== Item was changed: ----- Method: CCodeGenerator>>emitCConstantsOn: (in category 'C code generator') ----- emitCConstantsOn: aStream "Store the global variable declarations on the given stream." | unused constList | unused := constants keys asSet. "Don't generate any defines for the externally defined constants, STACKVM, COGVM, COGMTVM et al, unless they're actually used." (VMClass class>>#initializeMiscConstants) literalsDo: [:lit| (lit isVariableBinding and: [lit key isString]) ifTrue: [unused add: lit key]]. methods do: [:meth| meth declarations keysDo: [:v| (meth typeFor: v in: self) ifNotNil: [:type| unused remove: type ifAbsent: []]]. unused remove: meth returnType ifAbsent: []. meth parseTree nodesDo: [:n| n isConstant ifTrue: [unused remove: n name ifAbsent: []]]]. unused copy do: [:const| (variableDeclarations anySatisfy: [:value| value includesSubString: const]) ifTrue: [unused remove: const ifAbsent: []]]. unused remove: #BytesPerWord ifAbsent: []. "force inclusion of BytesPerWord declaration" + unused remove: #BaseHeaderSize ifAbsent: []. "force inclusion of BaseHeaderSize declaration" constList := constants keys reject: [:any| unused includes: any]. aStream cr; nextPutAll: '/*** Constants ***/'; cr. (self sortStrings: constList) do: [:varName| | node default value | node := constants at: varName. node name isEmpty ifFalse: ["If the definition includes a C comment, take it as is, otherwise convert the value from Smalltalk to C. Allow the class to provide an alternative definition, either of just the value or the whole shebang." default := (node value isString and: [node value includesSubString: '/*']) ifTrue: [node value] ifFalse: [self cLiteralFor: node value name: varName]. value := vmClass ifNotNil: [(vmClass specialValueForConstant: node name default: default) ifNotNil: [:specialDef| specialDef] ifNil: [default]] ifNil: [default]. value first ~= $# ifTrue: [aStream nextPutAll: '#define '; nextPutAll: node name; space]. aStream nextPutAll: value; cr]]. aStream cr! Item was added: + ----- Method: Spur32BitCoMemoryManager>>checkForLeaks (in category 'accessing') ----- + checkForLeaks + ^checkForLeaks! Item was changed: Spur32BitCoMemoryManager subclass: #Spur32BitMMLECoSimulator + instanceVariableNames: 'bootstrapping' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-SpurMemoryManagerSimulation'! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>bootstrapping (in category 'accessing') ----- + bootstrapping + ^bootstrapping! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>bootstrapping: (in category 'accessing') ----- + bootstrapping: aBoolean + bootstrapping := aBoolean. + segmentManager initForBootstrap! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>exactFitCompact (in category 'compaction') ----- + exactFitCompact + coInterpreter transcript nextPutAll: 'ef compacting...'; flush. + ^super exactFitCompact! Item was changed: ----- Method: Spur32BitMMLECoSimulator>>fetchPointer:ofObject: (in category 'object access') ----- fetchPointer: fieldIndex ofObject: objOop self assert: (self isForwarded: objOop) not. + self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop) + or: [fieldIndex = 0 "forwarders and free objs"]]). - self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOf: objOop)]). ^super fetchPointer: fieldIndex ofObject: objOop! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>firstFitCompact (in category 'compaction') ----- + firstFitCompact + coInterpreter transcript nextPutAll: 'ff compacting...'; flush. + ^super firstFitCompact! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>freeLists (in category 'spur bootstrap') ----- + freeLists + ^freeLists! Item was removed: - ----- Method: Spur32BitMMLECoSimulator>>freeStart (in category 'accessing') ----- - freeStart - (#(Cogit SimpleStackBasedCogit StackToRegisterMappingCogit) includes: thisContext sender class name) ifTrue: - [self halt]. - ^super freeStart! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') ----- + growOldSpaceByAtLeast: minAmmount + "Attempt to grow memory by at least minAmmount. + Answer the size of the new segment, or nil if the attempt failed. + Override to not grow during the Spur image bootstrap." + ^bootstrapping ifFalse: + [super growOldSpaceByAtLeast: minAmmount]! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>initialize (in category 'initialization') ----- + initialize + super initialize. + bootstrapping := false! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>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 + isCogMethodReference: + functionForPrimitiveExternalCall: + genSpecialSelectorArithmetic + genSpecialSelectorComparison + ensureContextHasBytecodePC: + instVar:ofContext: + ceBaseFrameReturn: + inlineCacheTagForInstance: + primitiveObjectAtPut + commonVariable:at:put:cacheIndex: + primDigitBitShiftMagnitude: + externalInstVar:ofContext: + primitiveGrowMemoryByAtLeast + primitiveFileSetPosition) includes: sel) ifFalse: + [self halt]. + ^super isIntegerObject: oop! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>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." + (#( on:do: "from the dbeugger" + reverseDisplayFrom:to: + primitiveObjectAtPut + isCogMethodReference:) includes: thisContext sender method selector) ifFalse: + [self halt]. + ^super isNonIntegerObject: oop! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>markAndTrace: (in category 'gc - global') ----- + markAndTrace: objOop + "objOop = 16rB26020 ifTrue: [self halt]. + objOop = 16rB25FD8 ifTrue: [self halt]. + objOop = 16rB26010 ifTrue: [self halt]." + ^super markAndTrace: objOop! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>memoryBaseForImageRead (in category 'snapshot') ----- + memoryBaseForImageRead + "Answer the address to read the image into. Override so that when bootstrapping, + the segmentManager's segments are undisturbed in adjustSegmentSwizzlesBy:" + ^bootstrapping + ifTrue: [0] + ifFalse: [super memoryBaseForImageRead]! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>numClassTablePages (in category 'spur bootstrap') ----- + numClassTablePages + ^numClassTablePages! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>setIsMarkedOf:to: (in category 'header access') ----- + setIsMarkedOf: objOop to: aBoolean + "objOop = 16rB26020 ifTrue: [self halt]." + super setIsMarkedOf: objOop to: aBoolean. + "(aBoolean + and: [(self isContextNonImm: objOop) + and: [(coInterpreter + checkIsStillMarriedContext: objOop + currentFP: coInterpreter framePointer) + and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue: + [self halt]"! Item was added: + ----- Method: Spur32BitMMLECoSimulator>>testObjStackDo (in category 'ad-hoc tests') ----- + testObjStackDo + | size them seqA seqB seqC rs | + self initializeWeaklingStack; emptyObjStack: weaklingStack. + self assert: (self topOfObjStack: weaklingStack) isNil. + self assert: (self capacityOfObjStack: weaklingStack) >= ObjStackLimit. + seqA := (1 to: ObjStackLimit * 5 // 2) collect: [:i| self integerObjectOf: i]. + seqA do: [:it| self noCheckPush: it onObjStack: weaklingStack]. + them := Set new. + size := self objStack: weaklingStack from: 0 do: [:it| them add: it]. + self assert: size = seqA size. + self assert: (them asSortedCollection asArray = seqA). + self assert: (self isValidObjStack: weaklingStack). + seqB := (ObjStackLimit * 5 // 2 + 1 to: ObjStackLimit * 10 // 2) collect: [:i| self integerObjectOf: i]. + self assert: seqA size = seqB size. + rs := seqB readStream. + them := Set new. + size := self objStack: weaklingStack from: 0 do: + [:it| + them add: it. + self noCheckPush: rs next onObjStack: weaklingStack]. + self assert: size = seqA size. + self assert: rs atEnd. + self objStack: weaklingStack from: size do: + [:it| them add: it]. + seqC := (seqA, seqB) sort. + self assert: them asSortedCollection asArray = seqC! Item was changed: ----- Method: SpurMemoryManager>>safePrintStringOf: (in category 'debug printing') ----- safePrintStringOf: oop | target | + (self isOopForwarded: oop) + ifTrue: [target := self followForwarded: oop] + ifFalse: [target := oop]. - target := (self isOopForwarded: oop) - ifTrue: [self followForwarded: oop] - ifFalse: [oop]. ^coInterpreter printStringOf: target! Item was changed: ----- Method: SpurMemoryManager>>tenuringThreshold (in category 'accessing') ----- tenuringThreshold "In the scavenger the tenuring threshold is effectively a number of bytes of objects, accessed as a proportion of pastSpace from 0 to 1. In the Squeak image the tenuring + threshold is an object count. Marry the two notions by multiplying the proportion by - threshold is an object count. Marry the two notions by multiplying the proportion by the size of pastSpace and dividing by the average object size, as derived from observation." | averageObjectSize | averageObjectSize := 8 * self wordSize. + ^(scavenger scavengerTenuringThreshold * scavenger pastSpaceBytes // averageObjectSize) asInteger! - ^scavenger scavengerTenuringThreshold * scavenger pastSpaceBytes // averageObjectSize!

1 0

VM Maker: VMMaker.oscog-eem.513.mcz
by commits＠source.squeak.org 18 Nov '13

18 Nov '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.513.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.513 Author: eem Time: 17 November 2013, 3:08:08.722 pm UUID: be833738-0c93-4c1a-8f13-d4c083687ffa Ancestors: VMMaker.oscog-eem.512 Fix slip in addToFreeTree:bytes:. Slang: Add a configuration for the Spur Cog VM. Eliminate translation-time errors and warnings for the Spur Cog VM. Improve error reporting for inst var masking for dtl's jenkins build. Don't raise a confliuct error when adding a method override in a subclass. Abstract away filtering implicit non-argument inst vars into CCodeGenerator>>instVarNamesForClass:. =============== Diff against VMMaker.oscog-eem.512 =============== Item was changed: ----- Method: CCodeGenerator>>addClass: (in category 'public') ----- addClass: aClass "Add the variables and methods of the given class to the code base." aClass prepareToBeAddedToCodeGenerator: self. self checkClassForNameConflicts: aClass. self addClassVarsFor: aClass. "ikp..." self addPoolVarsFor: aClass. (aClass inheritsFrom: VMStructType) ifFalse: + [variables addAll: (self instVarNamesForClass: aClass)]. - [variables addAll: (vmClass - ifNil: [aClass instVarNames] - ifNotNil: [aClass instVarNames reject: - [:ivn| vmClass isNonArgumentImplicitReceiverVariableName: ivn]])]. self retainMethods: (aClass requiredMethodNames: self options). 'Adding Class ' , aClass name , '...' displayProgressAt: Sensor cursorPoint from: 0 to: aClass selectors size during: [:bar | aClass selectors doWithIndex: [:sel :i | | source | bar value: i. self addMethodFor: aClass selector: sel]]. aClass declareCVarsIn: self! Item was changed: ----- Method: CCodeGenerator>>addMethod: (in category 'utilities') ----- addMethod: aTMethod "Add the given method to the code base and answer it. Only allow duplicate definitions for struct accessors, since we don't actually generate code for these methods and hence the conflict doesn't matter." (methods at: aTMethod selector ifAbsent: []) ifNotNil: [:conflict | aTMethod compiledMethod isSubclassResponsibility ifTrue: [^nil]. (conflict isStructAccessor and: [aTMethod isStructAccessor and: [conflict compiledMethod decompileString = aTMethod compiledMethod decompileString]]) ifTrue: [^nil]. + (conflict definingClass inheritsFrom: aTMethod definingClass) ifTrue: + [^nil]. self error: 'Method name conflict: ', aTMethod selector]. ^methods at: aTMethod selector put: aTMethod! Item was changed: ----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') ----- addMethodFor: aClass selector: selector "Add the given method to the code base and answer its translation or nil if it shouldn't be translated." | method tmethod | selector == #initialize ifTrue: [^nil]. method := aClass compiledMethodAt: selector. (method pragmaAt: #doNotGenerate) ifNotNil: [^nil]. + method isSubclassResponsibility ifTrue: + [^nil]. (self shouldIncludeMethodFor: aClass selector: selector) ifFalse: [^nil]. tmethod := self addMethod: (self compileToTMethodSelector: selector in: aClass). "If the method has a macro then add the macro. But keep the method for analysis purposes (e.g. its variable accesses)." (method pragmaAt: #cmacro:) ifNotNil: [:pragma| self addMacro: (pragma argumentAt: 1) for: selector. tmethod inline: false]. (method propertyValueAt: #cmacro:) ifNotNil: [:macro| self addMacro: macro for: selector. tmethod inline: false]. ^tmethod! Item was changed: ----- Method: CCodeGenerator>>checkClassForNameConflicts: (in category 'error notification') ----- checkClassForNameConflicts: aClass "Verify that the given class does not have constant, variable, or method names that conflict with those of previously added classes. Raise an error if a conflict is found, otherwise just return." "check for constant name collisions in class pools" aClass classPool associationsDo: [:assoc | (constants includesKey: assoc key asString) ifTrue: [self error: 'Constant ', assoc key, ' was defined in a previously added class']]. "and in shared pools" (aClass sharedPools reject: [:pool| pools includes: pool]) do: [:pool | pool bindingsDo: [:assoc | (constants includesKey: assoc key asString) ifTrue: [self error: 'Constant ', assoc key, ' was defined in a previously added class']]]. "check for instance variable name collisions" (aClass inheritsFrom: VMStructType) ifFalse: + [(self instVarNamesForClass: aClass) do: - [aClass instVarNames do: [:varName | (variables includes: varName) ifTrue: [self error: 'Instance variable ', varName, ' was defined in a previously added class']]]. "check for method name collisions" aClass selectors do: + [:sel | | tmeth meth | + ((tmeth := methods at: sel ifAbsent: nil) notNil - [:sel | | meth | - ((methods includesKey: sel) and: [(aClass isStructClass and: [(aClass isAccessor: sel) and: [(methods at: sel) isStructAccessor]]) not and: [((meth := aClass compiledMethodAt: sel) pragmaAt: #doNotGenerate) isNil + and: [meth isSubclassResponsibility not + and: [(tmeth definingClass inheritsFrom: aClass) not]]]]) ifTrue: - and: [meth isSubclassResponsibility not]]]) ifTrue: [self error: 'Method ', sel, ' was defined in a previously added class.']]! Item was added: + ----- Method: CCodeGenerator>>instVarNamesForClass: (in category 'utilities') ----- + instVarNamesForClass: aClass + ((vmClass + ifNil: [aClass instVarNames] + ifNotNil: [aClass instVarNames reject: + [:ivn| vmClass isNonArgumentImplicitReceiverVariableName: ivn]]) includes: 'manager') ifTrue: + [self halt: aClass name]. + ^vmClass + ifNil: [aClass instVarNames] + ifNotNil: [aClass instVarNames reject: + [:ivn| vmClass isNonArgumentImplicitReceiverVariableName: ivn]]! Item was changed: ----- Method: CCodeGenerator>>prepareMethods (in category 'utilities') ----- prepareMethods | globals | globals := Set new: 200. globals addAll: variables. methods do: [:m | m locals, m args do: [:var | (globals includes: var) ifTrue: + [self error: 'Local variable ''', var, ''' may mask global when inlining ', m selector]. - [self error: 'Local variable name may mask global when inlining: ' , var]. ((methods at: var ifAbsent: [nil]) ifNil: [false] ifNotNil: [:m1| m1 isStructAccessor not]) ifTrue: [logger ensureCr; + nextPutAll: 'Local variable name ''', var, ''' in '; - nextPutAll: 'Local variable name ', var, ' in '; nextPutAll: m selector; + nextPutAll: ' may mask method when inlining']]. - nextPutAll: ' may mask method when inlining: ' , var]]. m bindClassVariablesIn: constants. m prepareMethodIn: self]! Item was changed: ----- Method: CoInterpreter class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') ----- isNonArgumentImplicitReceiverVariableName: aString + ^(#('self' 'stackPages' 'cogit' 'coInterpreter' 'cogMethodZone' 'interpreter' 'objectMemory') includes: aString) + or: [self objectMemoryClass isNonArgumentImplicitReceiverVariableName: aString]! - ^#('self' 'stackPages' 'cogit' 'coInterpreter' 'cogMethodZone' 'objectMemory' 'interpreter' 'heapMap') includes: aString! Item was changed: ----- Method: CoInterpreter>>commonCallerReturn (in category 'return bytecodes') ----- commonCallerReturn "Return to the previous context/frame (sender for method activations, caller for block activations)." <sharedCodeNamed: 'commonCallerReturn' inCase: #returnTopFromBlock> | callersFPOrNull | <var: #callersFPOrNull type: #'char *'> callersFPOrNull := self frameCallerFP: localFP. callersFPOrNull == 0 "baseFrame" ifTrue: [self assert: localFP = stackPage baseFP. ^self baseFrameReturn]. localIP := self frameCallerSavedIP: localFP. localSP := localFP + (self frameStackedReceiverOffset: localFP). localFP := callersFPOrNull. localIP asUnsignedInteger < objectMemory startOfMemory ifTrue: [localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue: ["localIP in the cog method zone indicates a return to machine code." ^self returnToMachineCodeFrame]. localIP := self pointerForOop: (self iframeSavedIP: localFP)]. self setMethod: (self iframeMethod: localFP). self fetchNextBytecode. + self internalStackTopPut: localReturnValue! - ^self internalStackTopPut: localReturnValue! Item was changed: ----- Method: CoInterpreter>>itemporary:in:put: (in category 'internal interpreter access') ----- itemporary: offset in: theFP put: valueOop "Temporary access for an interpreter frame only." "See StackInterpreter class>>initializeFrameIndices" | frameNumArgs | <inline: true> <var: #theFP type: #'char *'> + ^offset < (frameNumArgs := self iframeNumArgs: theFP) - offset < (frameNumArgs := self iframeNumArgs: theFP) ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord) put: valueOop] ifFalse: [stackPages longAt: theFP + FoxIFReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]! Item was changed: ----- Method: CogObjectRepresentation>>genInnerPrimitiveNewWithArg: (in category 'primitive generators') ----- genInnerPrimitiveNewWithArg: retNoffset + self subclassResponsibility! - self subclassResponsibility. - ^0! Item was changed: ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAt: (in category 'primitive generators') ----- genInnerPrimitiveAt: retNoffset "Implement the guts of primitiveAt; dispatch on size" - <returnTypeC: #'AbstractInstruction *'> | formatReg jumpNotIndexable jumpSmallSize jumpImmediate jumpBadIndex jumpBytesDone jumpShortsDone jumpWordsDone jumpFixedFieldsDone jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig jumpIsArray jumpHasFixedFields jumpIsContext jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds | <inline: true> "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:" <var: #jumpIsBytes type: #'AbstractInstruction *'> <var: #jumpIsShorts type: #'AbstractInstruction *'> <var: #jumpBadIndex type: #'AbstractInstruction *'> <var: #jumpSmallSize type: #'AbstractInstruction *'> <var: #jumpIsContext type: #'AbstractInstruction *'> <var: #jumpImmediate type: #'AbstractInstruction *'> <var: #jumpBytesDone type: #'AbstractInstruction *'> <var: #jumpShortsDone type: #'AbstractInstruction *'> <var: #jumpWordsDone type: #'AbstractInstruction *'> <var: #jumpWordTooBig type: #'AbstractInstruction *'> <var: #jumpNotIndexable type: #'AbstractInstruction *'> <var: #jumpHasFixedFields type: #'AbstractInstruction *'> <var: #jumpFixedFieldsDone type: #'AbstractInstruction *'> <var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'> <var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'> <var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'> <var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'> <var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'> cogit MoveR: ReceiverResultReg R: TempReg. jumpImmediate := self genJumpImmediateInScratchReg: TempReg. cogit MoveR: Arg0Reg R: TempReg. jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg. self genConvertSmallIntegerToIntegerInScratchReg: Arg0Reg. cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel" formatReg := SendNumArgsReg. cogit MoveMw: 0 r: ReceiverResultReg R: formatReg; "formatReg := least significant half of self baseHeader: receiver" MoveR: formatReg R: TempReg; LogicalShiftRightCq: objectMemory formatShift R: formatReg; AndCq: objectMemory formatMask R: formatReg. "formatReg := self formatOfHeader: destReg" "get numSlots into ClassReg." cogit MoveCq: 0 R: ClassReg. "N.B. MoveMb:r:R: does not zero other bits" cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header" cogit CmpCq: objectMemory numSlotsMask R: ClassReg. jumpSmallSize := cogit JumpLess: 0. cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header" "dispatch on format in a combination of highest dynamic frequency order first and convenience. 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 unused, reserved for exotic pointer objects? 7 Forwarded Object, 1st field is pointer, rest of fields are ignored 8 unused, reserved for exotic non-pointer objects? 9 (?) 64-bit indexable 10 - 11 32-bit indexable 12 - 15 16-bit indexable 16 - 23 byte indexable 24 - 31 compiled method" jumpSmallSize jmpTarget: (cogit CmpCq: objectMemory firstByteFormat R: formatReg). jumpIsBytes := cogit JumpGreaterOrEqual: 0. cogit CmpCq: objectMemory arrayFormat R: formatReg. jumpIsArray := cogit JumpZero: 0. jumpNotIndexable := cogit JumpLess: 0. cogit CmpCq: objectMemory weakArrayFormat R: formatReg. jumpHasFixedFields := cogit JumpLessOrEqual: 0. cogit CmpCq: objectMemory firstShortFormat R: formatReg. jumpIsShorts := cogit JumpGreaterOrEqual: 0. cogit CmpCq: objectMemory firstLongFormat R: formatReg. jumpIsWords := cogit JumpGreaterOrEqual: 0. "For now ignore 64-bit indexability." jumpNotIndexable jmpTarget: cogit Label. jumpNotIndexable := cogit Jump: 0. jumpIsBytes jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg). cogit AndCq: objectMemory wordSize - 1 R: formatReg. cogit SubR: formatReg R: ClassReg; CmpR: Arg0Reg R: ClassReg. jumpBytesOutOfBounds := cogit JumpAboveOrEqual: 0. cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg. cogit MoveXbr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg. self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg. jumpBytesDone := cogit Jump: 0. jumpIsShorts jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg). cogit AndCq: 1 R: formatReg. cogit SubR: formatReg R: ClassReg; CmpR: Arg0Reg R: ClassReg. jumpShortsOutOfBounds := cogit JumpAboveOrEqual: 0. cogit AddR: Arg0Reg R: ReceiverResultReg. cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg. self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg. jumpShortsDone := cogit Jump: 0. jumpIsWords jmpTarget: (cogit CmpR: Arg0Reg R: ClassReg). jumpWordsOutOfBounds := cogit JumpAboveOrEqual: 0. cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg. cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: TempReg. cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg. jumpWordTooBig := self jumpNotSmallIntegerUnsignedValueInRegister: TempReg. cogit MoveR: TempReg R: ReceiverResultReg. self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg. jumpWordsDone := cogit Jump: 0. jumpHasFixedFields jmpTarget: (cogit AndCq: objectMemory classIndexMask R: TempReg). cogit CmpCq: ClassMethodContextCompactIndex R: TempReg. cogit MoveR: TempReg R: formatReg. cogit CmpCq: ClassMethodContextCompactIndex R: TempReg. jumpIsContext := cogit JumpZero: 0. cogit PushR: ClassReg. self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg. self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg. cogit PopR: ClassReg. self genConvertSmallIntegerToIntegerInScratchReg: formatReg. cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg; SubR: formatReg R: ClassReg; CmpR: Arg0Reg R: ClassReg. jumpFixedFieldsOutOfBounds := cogit JumpAboveOrEqual: 0. "index is (formatReg (fixed fields) + Arg0Reg (0-rel index)) * wordSize + baseHeaderSize" cogit AddR: formatReg R: Arg0Reg. cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg. cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg. jumpFixedFieldsDone := cogit Jump: 0. jumpIsArray jmpTarget: (cogit CmpR: Arg0Reg R: ClassReg). jumpArrayOutOfBounds := cogit JumpAboveOrEqual: 0. cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg. cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg. jumpFixedFieldsDone jmpTarget: (jumpWordsDone jmpTarget: (jumpShortsDone jmpTarget: (jumpBytesDone jmpTarget: (cogit RetN: retNoffset)))). jumpFixedFieldsOutOfBounds jmpTarget: (jumpArrayOutOfBounds jmpTarget: (jumpBytesOutOfBounds jmpTarget: (jumpShortsOutOfBounds jmpTarget: (jumpWordsOutOfBounds jmpTarget: (jumpWordTooBig jmpTarget: (jumpNotIndexable jmpTarget: (jumpIsContext jmpTarget: cogit Label))))))). cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel" self genConvertIntegerToSmallIntegerInScratchReg: Arg0Reg. (jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label)). ^0! Item was changed: ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveStringAt: (in category 'primitive generators') ----- genInnerPrimitiveStringAt: retNoffset "Implement the guts of primitiveStringAt; dispatch on size" - <returnTypeC: #'AbstractInstruction *'> | formatReg jumpNotIndexable jumpSmallSize jumpBadIndex done jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds | <inline: true> "c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:" <var: #done type: #'AbstractInstruction *'> <var: #jumpIsBytes type: #'AbstractInstruction *'> <var: #jumpIsShorts type: #'AbstractInstruction *'> <var: #jumpIsWords type: #'AbstractInstruction *'> <var: #jumpBadIndex type: #'AbstractInstruction *'> <var: #jumpSmallSize type: #'AbstractInstruction *'> <var: #jumpWordTooBig type: #'AbstractInstruction *'> <var: #jumpNotIndexable type: #'AbstractInstruction *'> <var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'> <var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'> <var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'> cogit MoveR: Arg0Reg R: TempReg. jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg. self genConvertSmallIntegerToIntegerInScratchReg: Arg0Reg. cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel" formatReg := SendNumArgsReg. cogit MoveMw: 0 r: ReceiverResultReg R: formatReg; "formatReg := least significant half of self baseHeader: receiver" MoveR: formatReg R: TempReg; LogicalShiftRightCq: objectMemory formatShift R: formatReg; AndCq: objectMemory formatMask R: formatReg. "formatReg := self formatOfHeader: destReg" "get numSlots into ClassReg." cogit MoveCq: 0 R: ClassReg. "N.B. MoveMb:r:R: does not zero other bits" cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header" cogit CmpCq: objectMemory numSlotsMask R: ClassReg. jumpSmallSize := cogit JumpLess: 0. cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header" "dispatch on format in a combination of highest dynamic frequency order first and convenience. 0 = 0 sized objects (UndefinedObject True False et al) 1 = non-indexable objects with inst vars (Point et al) 2 = indexable objects with no inst vars (Array et al) 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) 4 = weak indexable objects with inst vars (WeakArray et al) 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) 6 unused, reserved for exotic pointer objects? 7 Forwarded Object, 1st field is pointer, rest of fields are ignored 8 unused, reserved for exotic non-pointer objects? 9 (?) 64-bit indexable 10 - 11 32-bit indexable 12 - 15 16-bit indexable 16 - 23 byte indexable 24 - 31 compiled method" jumpSmallSize jmpTarget: (cogit CmpCq: objectMemory firstByteFormat R: formatReg). jumpIsBytes := cogit JumpGreaterOrEqual: 0. cogit CmpCq: objectMemory firstShortFormat R: formatReg. jumpIsShorts := cogit JumpGreaterOrEqual: 0. cogit CmpCq: objectMemory firstLongFormat R: formatReg. jumpIsWords := cogit JumpGreaterOrEqual: 0. jumpNotIndexable := cogit Jump: 0. jumpIsBytes jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg). cogit AndCq: objectMemory wordSize - 1 R: formatReg. cogit SubR: formatReg R: ClassReg; CmpR: Arg0Reg R: ClassReg. jumpBytesOutOfBounds := cogit JumpAboveOrEqual: 0. cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg. cogit MoveXbr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg. done := cogit Label. self genConvertIntegerToCharacterInScratchReg: ReceiverResultReg. cogit RetN: retNoffset. jumpIsShorts jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg). cogit AndCq: 1 R: formatReg. cogit SubR: formatReg R: ClassReg; CmpR: Arg0Reg R: ClassReg. jumpShortsOutOfBounds := cogit JumpAboveOrEqual: 0. cogit AddR: Arg0Reg R: ReceiverResultReg. cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg. cogit Jump: done. jumpIsWords jmpTarget: (cogit CmpR: Arg0Reg R: ClassReg). jumpWordsOutOfBounds := cogit JumpAboveOrEqual: 0. cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg. cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: TempReg. cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg. jumpWordTooBig := self jumpNotCharacterUnsignedValueInRegister: TempReg. cogit MoveR: TempReg R: ReceiverResultReg. cogit Jump: done. jumpBytesOutOfBounds jmpTarget: (jumpShortsOutOfBounds jmpTarget: (jumpWordsOutOfBounds jmpTarget: (jumpWordTooBig jmpTarget: (jumpNotIndexable jmpTarget: cogit Label)))). cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel" self genConvertIntegerToSmallIntegerInScratchReg: Arg0Reg. jumpBadIndex jmpTarget: cogit Label. ^0! Item was changed: ----- Method: Cogit class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') ----- isNonArgumentImplicitReceiverVariableName: aString ^#('cogit' 'coInterpreter' 'methodZone' + 'objectMemory' 'objectRepresentation' 'manager') includes: aString! - 'objectMemory' 'objectRepresentation') includes: aString! Item was changed: ----- Method: InterpreterPrimitives>>primitiveCompareBytes (in category 'indexing primitives') ----- primitiveCompareBytes "Primitive. Compare two byte-indexed objects for equality" | arg1 arg2 len1 len2 | <export: true> + argumentCount = 1 ifFalse:[self primitiveFail. ^self]. - argumentCount = 1 ifFalse:[^self primitiveFail]. arg1 := self stackValue: 1. arg2 := self stackValue: 0. ((objectMemory isBytes: arg1) and:[objectMemory isBytes: arg2]) + ifFalse:[self primitiveFail. ^self]. - ifFalse:[^self primitiveFail]. "Quick identity test" (arg1 = arg2) ifTrue:[^self pop: 2 thenPush: objectMemory trueObject]. len1 := objectMemory byteSizeOf: arg1. len2 := objectMemory byteSizeOf: arg2. len1 = len2 ifFalse:[^self pop: 2 thenPush: objectMemory falseObject]. 0 to: len1-1 do:[:i| (objectMemory fetchByte: i ofObject: arg1) = (objectMemory fetchByte: i ofObject: arg2) ifFalse:[^self pop: 2 thenPush: objectMemory falseObject]]. self pop: 2 thenPush: objectMemory trueObject. ! Item was changed: ----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') ----- addToFreeTree: freeChunk bytes: chunkBytes "Add freeChunk to the large free chunk tree. For the benefit of sortedFreeObject:, answer the treeNode it is added to, if it is added to the next list of a freeTreeNode, otherwise answer 0." | childBytes parent child | self assert: chunkBytes = (self bytesInObject: freeChunk). self assert: chunkBytes / self allocationUnit >= self numFreeLists. 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. ^child]. "walk down the tree" parent := child. child := self fetchPointer: (childBytes > chunkBytes ifTrue: [self freeChunkSmallerIndex] ifFalse: [self freeChunkLargerIndex]) + ofFreeChunk: child]. - ofObject: child]. parent = 0 ifTrue: [self assert: (freeLists at: 0) = 0. freeLists at: 0 put: freeChunk. freeListsMask := freeListsMask bitOr: 1. ^0]. self assert: (freeListsMask anyMask: 1). "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. ^0! Item was changed: ----- Method: SpurMemoryManager>>setHeapBase:memoryLimit:endOfMemory: (in category 'snapshot') ----- + setHeapBase: baseOfHeap memoryLimit: memLimit endOfMemory: memEnd - setHeapBase: heapBase memoryLimit: memLimit endOfMemory: memEnd "Transcript + cr; nextPutAll: 'heapBase: '; print: baseOfHeap; nextPut: $/; nextPutAll: baseOfHeap hex; - cr; nextPutAll: 'heapBase: '; print: heapBase; nextPut: $/; nextPutAll: heapBase hex; nextPutAll: ' memLimit '; print: memLimit; nextPut: $/; nextPutAll: memLimit hex; nextPutAll: ' memEnd '; print: memEnd; nextPut: $/; nextPutAll: memEnd hex; cr; flush." + startOfMemory := baseOfHeap. + newSpaceLimit := baseOfHeap - startOfMemory := heapBase. - newSpaceLimit := heapBase + self newSpaceBytes + coInterpreter interpreterAllocationReserveBytes. freeOldSpaceStart := memEnd. endOfMemory := memLimit. scavenger + newSpaceStart: baseOfHeap + newSpaceBytes: newSpaceLimit - baseOfHeap + edenBytes: newSpaceLimit - baseOfHeap - newSpaceStart: heapBase - newSpaceBytes: newSpaceLimit - heapBase - edenBytes: newSpaceLimit - heapBase * (self scavengerDenominator - self numSurvivorSpaces) // self scavengerDenominator. freeStart := scavenger eden start. pastSpaceStart := scavenger pastSpace start! Item was changed: ----- Method: StackInterpreter>>followField:in: (in category 'lazy become') ----- followField: fieldIndex in: anObject "Make sure the oop at fieldIndex in anObject is not forwarded (follow the + forwarder there-in if so). Answer the (possibly followed) oop at fieldIndex. + N.B. the oop is assumed to be non-immediate." + | objOop | + objOop := objectMemory fetchPointer: fieldIndex ofObject: anObject. + self assert: (objectMemory isNonImmediate: objOop). + (objectMemory isForwarded: objOop) ifTrue: + [objOop := objectMemory followForwarded: objOop. + objectMemory storePointer: fieldIndex ofObject: anObject withValue: objOop]. + ^objOop! - forwarder there-in if so). Answer the (possibly followed) oop at fieldIndex." - | field | - field := objectMemory fetchPointer: fieldIndex ofObject: anObject. - (objectMemory isForwarded: field) ifTrue: - [field := objectMemory followForwarded: field. - objectMemory storePointer: fieldIndex ofObject: anObject withValue: field]. - ^field! Item was changed: ----- Method: StackInterpreter>>printOop: (in category 'debug printing') ----- printOop: oop | cls fmt lastIndex startIP bytecodesPerLine column | <inline: false> (objectMemory isImmediate: oop) ifTrue: [^self shortPrintOop: oop]. self printHex: oop. (objectMemory addressCouldBeObj: oop) ifFalse: + [^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0 - [self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [' is misaligned'] + ifFalse: [' is not on the heap']); cr]. - ifFalse: [' is not on the heap']); cr. - ^nil]. (objectMemory isFreeObject: oop) ifTrue: + [^self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr]. - [self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr. - ^nil]. (objectMemory isForwarded: oop) ifTrue: + [^self - [self print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop); + print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop); cr]. - print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop); cr. - ^nil]. self print: ': a(n) '. self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5. cls = (objectMemory splObj: ClassFloat) ifTrue: + [^self cr; printFloat: (self dbgFloatValueOf: oop); cr]. - [self cr; printFloat: (self dbgFloatValueOf: oop); cr. - ^nil]. fmt := objectMemory formatOf: oop. fmt > objectMemory lastPointerFormat ifTrue: [self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)]. self cr. (fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue: ["This will answer false if splObj: ClassAlien is nilObject" (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue: [self print: ' datasize '; printNum: (self sizeOfAlienData: oop). self print: ((self isIndirectAlien: oop) ifTrue: [' indirect @ '] ifFalse: [(self isPointerAlien: oop) ifTrue: [' pointer @ '] ifFalse: [' direct @ ']]). + ^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr]. - self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr. - ^nil]. (objectMemory isWords: oop) ifTrue: [lastIndex := 64 min: ((objectMemory byteLengthOf: oop) / BytesPerWord). lastIndex > 0 ifTrue: [1 to: lastIndex do: [:index| self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop). (index \\ self elementsPerPrintOopLine) = 0 ifTrue: [self cr]]. (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse: [self cr]]. + ^self]. - ^nil]. ^self printStringOf: oop; cr]. "this is nonsense. apologies." startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop. lastIndex := 256 min: startIP. lastIndex > 0 ifTrue: [1 to: lastIndex do: [:index| self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space] inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space. self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))]. (index \\ self elementsPerPrintOopLine) = 0 ifTrue: [self cr]]. (lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse: [self cr]]. (objectMemory isCompiledMethod: oop) ifFalse: [startIP > 64 ifTrue: [self print: '...'; cr]] ifTrue: [startIP := startIP * BytesPerWord + 1. lastIndex := objectMemory lengthOf: oop. lastIndex - startIP > 100 ifTrue: [lastIndex := startIP + 100]. bytecodesPerLine := 8. column := 1. startIP to: lastIndex do: [:index| | byte | column = 1 ifTrue: [self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)' inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']]. byte := objectMemory fetchByte: index - 1 ofObject: oop. self cCode: 'printf(" %02x/%-3d", byte,byte)' inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte]. column := column + 1. column > bytecodesPerLine ifTrue: [column := 1. self cr]]. column = 1 ifFalse: [self cr]]! Item was changed: ----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') ----- shortPrintOop: oop <inline: false> self printHexnp: oop. (objectMemory isImmediate: oop) ifTrue: [(objectMemory isImmediateCharacter: oop) ifTrue: + [self - [^self cCode: 'printf("=$%ld ($%lc)\n", (long)characterValueOf(oop), (wint_t)characterValueOf(oop))' inSmalltalk: [self print: (self shortPrint: oop); cr]]. + (objectMemory isIntegerObject: oop) ifTrue: + [self + cCode: 'printf("=%ld\n", (long)integerValueOf(oop))' + inSmalltalk: [self print: (self shortPrint: oop); cr]]. + ^self]. - ^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 - [self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [' is misaligned'] + ifFalse: [' is not on the heap']); cr]. - 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! Item was changed: ----- Method: StackInterpreter>>storeLiteralVariable:withValue: (in category 'stack bytecodes') ----- storeLiteralVariable: literalIndex withValue: anObject | litVar | litVar := self literal: literalIndex. "push/store/popLiteralVariable all fetch a literal, and either read or write the literal's value field. The fetch of the literal needs an explicit check (otherwise we would have to scan all literals in all methods in the stack zone, and the entire method on return, and global variables are relatively rare; in my work image 8.7% of literals are globals)." (objectMemory isForwarded: litVar) ifTrue: [litVar := objectMemory followForwarded: litVar]. + ^objectMemory storePointer: ValueIndex ofObject: litVar withValue: anObject! - objectMemory storePointer: ValueIndex ofObject: litVar withValue: anObject! Item was changed: ----- Method: TMethod>>inferReturnTypeFromReturnsIn: (in category 'type inference') ----- inferReturnTypeFromReturnsIn: aCodeGen "Attempt to infer the return type of the receiver from returns in the parse tree." + "this for determining which returns have which return types:" + "aCodeGen + pushScope: declarations + while: [parseTree + nodesSelect: [:n| n isReturn] + thenCollect: [:n| | s | + s := Set new. + self addTypesFor: n expression to: s in: aCodeGen. + {n. s}]]" returnType ifNil: "the initial default" [aCodeGen pushScope: declarations while: [| hasReturn returnTypes | hasReturn := false. returnTypes := Set new. parseTree nodesDo: [:node| node isReturn ifTrue: [hasReturn := true. self addTypesFor: node expression to: returnTypes in: aCodeGen]]. returnTypes remove: #implicit ifAbsent: []. returnTypes := aCodeGen harmonizeReturnTypesIn: returnTypes. hasReturn ifTrue: [returnTypes size > 1 ifTrue: [aCodeGen logger show: (String streamContents: [:s| s nextPutAll: 'conflicting return types '. returnTypes do: [:t| s nextPutAll: t] separatedBy: [s nextPutAll: ', ']. s nextPutAll: ' in '; nextPutAll: selector; cr])]. returnTypes size = 1 ifTrue: [self returnType: returnTypes anyOne]] ifFalse: [self returnType: (aCodeGen implicitReturnTypeFor: selector)]]]! Item was added: + ----- Method: TParseNode>>nodesSelect:thenCollect: (in category 'enumerating') ----- + nodesSelect: selectBlock thenCollect: collectBlock + | result | + result := OrderedCollection new. + self nodesDo: + [:node| + (selectBlock value: node) ifTrue: + [result addLast: (collectBlock value: node)]]. + ^result! Item was added: + ----- Method: VMMaker class>>generateSqueakSpurCogVM (in category 'configurations') ----- + generateSqueakSpurCogVM + ^VMMaker + generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]] + value: #(CoInterpreter CoInterpreterMT))) + and: StackToRegisterMappingCogit + with: #( ObjectMemory Spur32BitCoMemoryManager + MULTIPLEBYTECODESETS false + NewspeakVM false) + to: (FileDirectory default pathFromURI: 'oscogvm/spursrc') + platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms') + including:#()!

1 0

VM Maker: VMMaker.oscog-eem.512.mcz
by commits＠source.squeak.org 16 Nov '13

16 Nov '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.512.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.512 Author: eem Time: 16 November 2013, 8:46:30.121 am UUID: e67f6750-242d-43e3-8a3b-681b3b617e38 Ancestors: VMMaker.oscog-eem.511 A Ferrari commit? A power-of-two commit? :-) Change endOfMemory to include last bridge (too hard to get the memory size right otherwise). Change the enumerators to use endOfMemory instead of freeOldSpaceStart (which I'd like to get rid of sometime). Move isValidSegmentBridge: to SpurSegMgr. Include segLimit in SpurSegInfo printing. Finally the shootout tests run to completion. =============== Diff against VMMaker.oscog-eem.511 =============== 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 = 16r183FB00 and: [a32BitValue = 16r3FFFFC]) ifTrue: - "(byteAddress = 16r1614CB8 and: [a32BitValue = 16rA000035]) ifTrue: [self halt]." "(byteAddress between: 16r33FBB8 and: 16r33FBCF) ifTrue: [self halt]." byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError]. ^memory at: byteAddress // 4 + 1 put: a32BitValue! Item was changed: ----- Method: SpurMemoryManager>>accessibleObjectAfter: (in category 'object enumeration') ----- accessibleObjectAfter: objOop "Answer the accessible object following the given object or free chunk in the heap. Return nil when heap is exhausted. This is for primitiveNextObject subsequent to primtiiveSomeObject." <inline: false> | objAfter | objAfter := objOop. + [objAfter := self objectAfter: objAfter limit: endOfMemory. + objAfter = endOfMemory ifTrue: - [objAfter := self objectAfter: objAfter limit: freeOldSpaceStart. - objAfter = freeOldSpaceStart ifTrue: [^nil]. (self isNormalObject: objAfter) ifTrue: [^objAfter]] repeat! Item was changed: ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'snapshot') ----- adjustAllOopsBy: bytesToShift "Adjust all oop references by the given number of bytes. This is done just after reading in an image when the new base address of the object heap is different from the base address in the image, or when loading multiple segments that have been coalesced. Also set bits in the classTableBitmap corresponding to used classes." | obj | self countNumClassPagesPreSwizzle: bytesToShift; ensureAdequateClassTableBitmap. (bytesToShift ~= 0 or: [segmentManager numSegments > 1]) ifTrue: [self assert: self newSpaceIsEmpty. obj := self objectStartingAt: newSpaceLimit. + [self oop: obj isLessThan: endOfMemory] whileTrue: - [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: [(self isFreeObject: obj) ifTrue: [self swizzleFieldsOfFreeChunk: obj] ifFalse: [self inClassTableBitmapSet: (self classIndexOf: obj). self swizzleFieldsOfObject: obj]. obj := self objectAfter: obj]] ifFalse: [self assert: self newSpaceIsEmpty. obj := self objectStartingAt: newSpaceLimit. + [self oop: obj isLessThan: endOfMemory] whileTrue: - [self oop: obj isLessThan: freeOldSpaceStart] whileTrue: [(self isFreeObject: obj) ifFalse: [self inClassTableBitmapSet: (self classIndexOf: obj)]. obj := self objectAfter: obj]]! Item was changed: ----- Method: SpurMemoryManager>>allExistingOldSpaceObjectsDo: (in category 'object enumeration') ----- allExistingOldSpaceObjectsDo: aBlock "Enumerate all old space objects, excluding any objects created during the execution of allExistingOldSpaceObjectsDo:." <inline: true> | oldSpaceLimit prevObj prevPrevObj objOop | prevPrevObj := prevObj := nil. objOop := self firstObject. + oldSpaceLimit := endOfMemory. - oldSpaceLimit := freeOldSpaceStart. [self assert: objOop \\ self allocationUnit = 0. self oop: objOop isLessThan: oldSpaceLimit] whileTrue: [self assert: (self longLongAt: objOop) ~= 0. (self isEnumerableObject: objOop) ifTrue: [aBlock value: objOop]. prevPrevObj := prevObj. prevObj := objOop. + objOop := self objectAfter: objOop limit: oldSpaceLimit]. - objOop := self objectAfter: objOop limit: freeOldSpaceStart]. self touch: prevPrevObj. self touch: prevObj! Item was changed: ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCoalescingDo: (in category 'object enumeration') ----- allOldSpaceEntitiesForCoalescingDo: aBlock <inline: true> | prevObj prevPrevObj objOop rawNumSlots rawNumSlotsAfter | prevPrevObj := prevObj := nil. objOop := self firstObject. [self assert: objOop \\ self allocationUnit = 0. + self oop: objOop isLessThan: endOfMemory] whileTrue: - self oop: objOop isLessThan: freeOldSpaceStart] whileTrue: [self assert: (self longLongAt: objOop) ~= 0. rawNumSlots := self rawNumSlotsOf: objOop. aBlock value: objOop. "If the number of slot changes coalescing changed an object from a single to a double header." rawNumSlotsAfter := self rawNumSlotsOf: objOop. (rawNumSlotsAfter ~= rawNumSlots and: [rawNumSlotsAfter = self numSlotsMask]) ifTrue: [objOop := objOop + self baseHeaderSize. + self assert: (self objectAfter: prevObj limit: endOfMemory) = objOop]. - self assert: (self objectAfter: prevObj limit: freeOldSpaceStart) = objOop]. prevPrevObj := prevObj. prevObj := objOop. + objOop := self objectAfter: objOop limit: endOfMemory]. - objOop := self objectAfter: objOop limit: freeOldSpaceStart]. self touch: prevPrevObj. self touch: prevObj! Item was changed: ----- Method: SpurMemoryManager>>allOldSpaceEntitiesFrom:do: (in category 'object enumeration') ----- allOldSpaceEntitiesFrom: initialObject do: aBlock <inline: true> | prevObj prevPrevObj objOop | prevPrevObj := prevObj := nil. objOop := initialObject. [self assert: objOop \\ self allocationUnit = 0. + self oop: objOop isLessThan: endOfMemory] whileTrue: - self oop: objOop isLessThan: freeOldSpaceStart] whileTrue: [self assert: (self longLongAt: objOop) ~= 0. aBlock value: objOop. prevPrevObj := prevObj. prevObj := objOop. + objOop := self objectAfter: objOop limit: endOfMemory]. - objOop := self objectAfter: objOop limit: freeOldSpaceStart]. self touch: prevPrevObj. self touch: prevObj! Item was changed: ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:stackSize:codeSize: (in category 'spur bootstrap') ----- allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes "Intialize the receiver for bootsraping an image. Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold to allocate in oldSpace. Later on (in initializePostBootstrap) freeStart and scavengeThreshold will be set to sane values." <doNotGenerate> self assert: (memoryBytes \\ self allocationUnit = 0 and: [newSpaceBytes \\ self allocationUnit = 0 and: [codeBytes \\ self allocationUnit = 0]]). memory := (self endianness == #little ifTrue: [LittleEndianBitmap] ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes + stackBytes) // 4. startOfMemory := codeBytes + stackBytes. + endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes + stackBytes. - endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes + stackBytes - self bridgeSize. "leave newSpace empty for the bootstrap" freeStart := newSpaceBytes + startOfMemory. newSpaceLimit := newSpaceBytes + startOfMemory. scavengeThreshold := memory size * 4. "Bitmap is a 4-byte per word array" scavenger := SpurGenerationScavengerSimulator new manager: self newSpaceStart: startOfMemory newSpaceBytes: newSpaceBytes edenBytes: newSpaceBytes * self scavengerDenominator - self numSurvivorSpaces // self scavengerDenominator! Item was changed: ----- Method: SpurMemoryManager>>cheapAddressCouldBeInHeap: (in category 'debug support') ----- cheapAddressCouldBeInHeap: address ^(address bitAnd: self wordSize - 1) = 0 and: [(self oop: address isGreaterThanOrEqualTo: startOfMemory) + and: [self oop: address isLessThan: endOfMemory]]! - and: [self oop: address isLessThan: freeOldSpaceStart]]! Item was changed: ----- Method: SpurMemoryManager>>checkOkayOop: (in category 'debug support') ----- checkOkayOop: oop "Verify that the given oop is legitimate. Check address, header, and size but not class. Answer true if OK. Otherwise print reason and answer false." <api> <var: #oop type: #usqInt> | classIndex fmt unusedBits unusedBitsInYoungObjects | <var: #unusedBits type: #usqLong> "address and size checks" (self isImmediate: oop) ifTrue: [^true]. (self addressCouldBeObjWhileScavenging: oop) ifFalse: [self print: 'oop '; printHex: oop; print: ' is not a valid address'. ^false]. + (self oop: (self addressAfter: oop) isLessThanOrEqualTo: endOfMemory) ifFalse: - (self oop: (self addressAfter: oop) isLessThanOrEqualTo: freeOldSpaceStart) ifFalse: [self print: 'oop '; printHex: oop; print: ' size would make it extend beyond the end of memory'. ^false]. "header type checks" (classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse: [self print: 'oop '; printHex: oop; print: ' is a free chunk, or bridge, not an object'. ^false]. ((self rawNumSlotsOf: oop) = self numSlotsMask and: [(self rawNumSlotsOf: oop - self baseHeaderSize) ~= self numSlotsMask]) ifTrue: [self print: 'oop '; printHex: oop; print: ' header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false]. "format check" fmt := self formatOf: oop. (fmt = 6) | (fmt = 8) ifTrue: [self print: 'oop '; printHex: oop; print: ' has an unknown format type'. ^false]. (fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue: [self print: 'oop '; printHex: oop; print: ' has mis-matched format/classIndex fields; only one of them is the isForwarded value'. ^false]. "specific header bit checks" unusedBits := (1 << self classIndexFieldWidth) | (1 << (self identityHashFieldWidth + 32)). ((self longLongAt: oop) bitAnd: unusedBits) ~= 0 ifTrue: [self print: 'oop '; printHex: oop; print: ' has some unused header bits set; should be zero'. ^false]. unusedBitsInYoungObjects := self newSpaceRefCountMask. ((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue: [self print: 'oop '; printHex: oop; print: ' has some header bits unused in young objects set; should be zero'. ^false]. ^true! Item was added: + ----- Method: SpurMemoryManager>>computeFreeSpacePostSwizzle (in category 'free space') ----- + computeFreeSpacePostSwizzle + totalFreeOldSpace := self totalFreeListBytes. + self checkFreeSpace! Item was changed: ----- Method: SpurMemoryManager>>countNumClassPagesPreSwizzle: (in category 'class table') ----- countNumClassPagesPreSwizzle: bytesToShift "Compute the used size of the class table before swizzling. Needed to initialize the classTableBitmap which is populated during adjustAllOopsBy:" | firstObj classTableRoot nilObjPreSwizzle | firstObj := self objectStartingAt: newSpaceLimit. "a.k.a. nilObj" "first five objects are nilObj, falseObj, trueObj, freeListsObj, classTableRootObj" classTableRoot := self objectAfter: (self objectAfter: (self objectAfter: (self objectAfter: firstObj + limit: endOfMemory) + limit: endOfMemory) + limit: endOfMemory) + limit: endOfMemory. - limit: freeOldSpaceStart) - limit: freeOldSpaceStart) - limit: freeOldSpaceStart) - limit: freeOldSpaceStart. nilObjPreSwizzle := newSpaceLimit - bytesToShift. numClassTablePages := self numSlotsOf: classTableRoot. self assert: numClassTablePages = (self classTableRootSlots + self hiddenRootSlots). 2 to: numClassTablePages - 1 do: [:i| (self fetchPointer: i ofObject: classTableRoot) = nilObjPreSwizzle ifTrue: [numClassTablePages := i. ^self]] ! Item was changed: ----- Method: SpurMemoryManager>>endOfMemory (in category 'accessing') ----- endOfMemory + <cmacro: '() GIV(endOfMemory)'> ^endOfMemory! Item was changed: ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') ----- freeUnmarkedObjectsAndSortAndCoalesceFreeSpace "Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space. Small free chunks are sorted in address order on each small list head. Large free chunks are sorted on the sortedFreeChunks list. Record as many of the highest objects as there is room for in highestObjects, a circular buffer, for the use of exactFitCompact. Use unused eden space for highestObjects. If highestObjects does not wrap, store 0 at highestObjects last. Record the lowest free object in firstFreeChunk. Let the segmentManager mark which segments contain pinned objects via notePinned:." | lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks | <var: #lastHighest type: #usqInt> self checkFreeSpace. scavenger forgetUnmarkedRememberedObjects. segmentManager prepareForGlobalSweep."for notePinned:" "for sorting free space throw away the list heads, rebuilding them for small free chunks below." self resetFreeListHeads. highestObjects initializeStart: freeStart limit: scavenger eden limit. lastHighest := highestObjects last "a.k.a. freeStart - wordSize". highestObjectsWraps := 0. self assert: highestObjects limit - highestObjects start // self wordSize >= 1024. firstFreeChunk := sortedFreeChunks := lastLargeFree := 0. "Note that if we were truly striving for performance we could split the scan into two phases, one up to the first free object and one after, which would remove the need to test firstFreeChunk when filling highestObjects." self allOldSpaceEntitiesForCoalescingDo: [:o| (self isMarked: o) ifTrue: "forwarders should have been followed in markAndTrace:" [self assert: (self isForwarded: o) not. self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:" (self isPinned: o) ifTrue: [segmentManager notePinned: o]. firstFreeChunk ~= 0 ifTrue: [false "conceptually...: " ifTrue: [highestObjects addLast: o] ifFalse: "but we inline so we can use the local lastHighest" [(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue: [highestObjectsWraps := highestObjectsWraps + 1]. self longAt: lastHighest put: o]]] ifFalse: "unmarked; two cases, an unreachable object or a free chunk." + [| here limit next | - [| here next | self assert: (self isRemembered: o) not. "scavenger should have cleared this above" here := o. + limit := endOfMemory - self bridgeSize. + next := self objectAfter: here limit: limit. + [next = limit or: [self isMarked: next]] whileFalse: "coalescing; rare case" - next := self objectAfter: here limit: endOfMemory. - (self isMarked: next) ifFalse: "coalescing; rare case" [self assert: (self isRemembered: o) not. + statCoalesces := statCoalesces + 1. + here := self coalesce: here and: next. + next := self objectAfter: here limit: limit]. - [statCoalesces := statCoalesces + 1. - here := self coalesce: here and: next. - next := self objectAfter: here limit: endOfMemory. - next = endOfMemory or: [self isMarked: next]] whileFalse]. self setFree: here. firstFreeChunk = 0 ifTrue: [firstFreeChunk := here]. (self isLargeFreeObject: here) ifTrue: [lastLargeFree = 0 ifTrue: [sortedFreeChunks := here] ifFalse: [self setFree: here. self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here]. lastLargeFree := here] ifFalse: [self freeSmallObject: here]]]. highestObjects last: lastHighest. highestObjectsWraps ~= 0 ifTrue: [highestObjects first: (lastHighest + self wordSize >= highestObjects limit ifTrue: [highestObjects start] ifFalse: [lastHighest + self wordSize])]. lastLargeFree ~= 0 ifTrue: [self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0]. totalFreeOldSpace := self reverseSmallListHeads. totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks). self checkFreeSpace. self touch: highestObjectsWraps! Item was changed: ----- Method: SpurMemoryManager>>initializeFreeSpacePostLoad: (in category 'snapshot') ----- initializeFreeSpacePostLoad: freeListObj "Reinitialize the free list info. The freeLists object needs to be swizzled because its neither a free, nor a pointer object. Free objects have already been swizzled in adjustAllOopsBy:" self assert: (self numSlotsOf: freeListObj) = self numFreeLists. self assert: (self formatOf: freeListObj) = (self wordSize = 4 ifTrue: [self firstLongFormat] ifFalse: [self sixtyFourBitIndexableFormat]). freeLists := self firstIndexableField: freeListObj. freeListsMask := 0. 0 to: self numFreeLists - 1 do: [:i| (freeLists at: i) ~= 0 ifTrue: [freeListsMask := freeListsMask bitOr: (1 << i). + freeLists at: i put: (segmentManager swizzleObj: (freeLists at: i))]]! - freeLists at: i put: (segmentManager swizzleObj: (freeLists at: i))]]. - totalFreeOldSpace := self totalFreeListBytes. - self checkFreeSpace! Item was changed: ----- Method: SpurMemoryManager>>initializeNewSpaceVariables (in category 'gc - scavenging') ----- initializeNewSpaceVariables - startOfMemory ifNotNil: "true in bootstrap" - [^self]. freeStart := scavenger eden start. pastSpaceStart := scavenger pastSpace start. scavengeThreshold := scavenger eden limit - (scavenger edenBytes / 64) - coInterpreter interpreterAllocationReserveBytes. startOfMemory := scavenger pastSpace start min: scavenger futureSpace start. self assert: startOfMemory < scavenger eden start. self initSpaceForAllocationCheck: (self addressOf: scavenger eden)! Item was changed: ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks." "Assume: image reader initializes the following variables: memory memoryLimit specialObjectsOop lastHash " <inline: false> | freeListObj | "Catch mis-initializations leading to bad translations to C" self assert: BaseHeaderSize = self baseHeaderSize. + self bootstrapping ifFalse: + [self + initSegmentBridgeWithBytes: self bridgeSize + at: endOfMemory - self bridgeSize]. - segmentManager adjustSegmentSwizzlesBy: bytesToShift. "image may be at a different address; adjust oops for new location" self adjustAllOopsBy: bytesToShift. specialObjectsOop := segmentManager swizzleObj: specialObjectsOop. "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. "In Cog we insist that nil, true & false are next to each other (Cogit generates tighter conditional branch code as a result). In addition, Spur places the free lists and class table root page immediately following them." self assert: nilObj = newSpaceLimit. self assert: falseObj = (self objectAfter: nilObj). self assert: trueObj = (self objectAfter: falseObj). freeListObj := self objectAfter: trueObj. self reInitializeClassTablePostLoad: (self objectAfter: freeListObj). markStack := self swizzleObjStackAt: MarkStackRootIndex. weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex. ephemeronQueue := self swizzleObjStackAt: EphemeronQueueRootIndex. - segmentManager collapseSegmentsPostSwizzle. self initializeFreeSpacePostLoad: freeListObj. + segmentManager collapseSegmentsPostSwizzle. + self computeFreeSpacePostSwizzle. + self bootstrapping ifFalse: + [self initializeNewSpaceVariables]. - - self initializeNewSpaceVariables. self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart" + segmentManager checkSegments. "These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi." growHeadroom := 16*1024*1024. "headroom when growing" shrinkThreshold := 32*1024*1024. "free space before shrinking"! Item was changed: ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') ----- initializeOldSpaceFirstFree: startOfFreeOldSpace <var: 'startOfFreeOldSpace' type: #usqLong> + | limit freeOldStart freeChunk | + <var: 'limit' type: #usqLong> - | freeOldStart freeChunk | <var: 'freeOldStart' type: #usqLong> + limit := endOfMemory - self bridgeSize. + limit > startOfFreeOldSpace ifTrue: + [totalFreeOldSpace := totalFreeOldSpace + (limit - startOfFreeOldSpace). - - endOfMemory > startOfFreeOldSpace ifTrue: - [totalFreeOldSpace := totalFreeOldSpace + (endOfMemory - startOfFreeOldSpace). freeOldStart := startOfFreeOldSpace. + [limit - freeOldStart >= (2 raisedTo: 32)] whileTrue: - [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 < limit ifTrue: + [freeChunk := self freeChunkWithBytes: limit - freeOldStart at: freeOldStart. + self assert: (self addressAfter: freeChunk) = limit]]. - freeOldStart < endOfMemory ifTrue: - [freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart. - self assert: (self addressAfter: freeChunk) = endOfMemory]]. freeOldSpaceStart := endOfMemory. self checkFreeSpace! Item was changed: ----- Method: SpurMemoryManager>>instanceAfter: (in category 'object enumeration') ----- instanceAfter: objOop | actualObj classIndex | actualObj := objOop. classIndex := self classIndexOf: objOop. (self isInEden: objOop) ifTrue: [[actualObj := self objectAfter: actualObj limit: freeStart. self oop: actualObj isLessThan: freeStart] whileTrue: [classIndex = (self classIndexOf: actualObj) ifTrue: [^actualObj]]. actualObj := (self oop: pastSpaceStart isGreaterThan: scavenger pastSpace start) ifTrue: [self objectStartingAt: scavenger pastSpace start] ifFalse: [nilObj]]. (self isInSurvivorSpace: actualObj) ifTrue: [[actualObj := self objectAfter: actualObj limit: pastSpaceStart. self oop: actualObj isLessThan: pastSpaceStart] whileTrue: [classIndex = (self classIndexOf: actualObj) ifTrue: [^actualObj]]. actualObj := nilObj]. + [actualObj := self objectAfter: actualObj limit: endOfMemory. + self oop:actualObj isLessThan: endOfMemory] whileTrue: - [actualObj := self objectAfter: actualObj limit: freeOldSpaceStart. - self oop:actualObj isLessThan: freeOldSpaceStart] whileTrue: [classIndex = (self classIndexOf: actualObj) ifTrue: [^actualObj]]. ^nil! Item was changed: ----- Method: SpurMemoryManager>>isInOldSpace: (in category 'object testing') ----- isInOldSpace: address ^self oop: address isGreaterThanOrEqualTo: newSpaceLimit + andLessThan: endOfMemory! - andLessThan: freeOldSpaceStart! Item was removed: - ----- Method: SpurMemoryManager>>isValidSegmentBridge: (in category 'segments') ----- - isValidSegmentBridge: objOop - "Maybe this should be in SpurSegmentManager only" - ^(objOop = endOfMemory or: [self addressCouldBeObj: objOop]) - and: [(self isSegmentBridge: objOop) - and: [self hasOverflowHeader: objOop]]! Item was changed: ----- Method: SpurMemoryManager>>objectAfter: (in category 'object enumeration') ----- objectAfter: objOop <api> "Object parsing. 1. all objects have at least a word following the header, for a forwarding pointer. 2. objects with an overflow size have a preceeing word with a saturated slotSize. If the word following an object doesn't have a saturated size field it must be a single-header object. If the word following does have a saturated slotSize it must be the overflow size word." <inline: false> (self oop: objOop isLessThan: newSpaceLimit) ifTrue: [(self isInEden: objOop) ifTrue: [^self objectAfter: objOop limit: freeStart]. (self isInSurvivorSpace: objOop) ifTrue: [^self objectAfter: objOop limit: pastSpaceStart]. ^self objectAfter: objOop limit: scavenger futureSurvivorStart]. + ^self objectAfter: objOop limit: endOfMemory! - ^self objectAfter: objOop limit: freeOldSpaceStart! Item was changed: ----- Method: SpurMemoryManager>>okayOop: (in category 'debug support') ----- okayOop: signedOop "Verify that the given oop is legitimate. Check address, header, and size but not class." | oop classIndex fmt unusedBits unusedBitsInYoungObjects | <var: #oop type: #usqInt> <var: #unusedBits type: #usqLong> oop := self cCoerce: signedOop to: #usqInt. "address and size checks" (self isImmediate: oop) ifTrue: [^true]. (self addressCouldBeObjWhileScavenging: oop) ifFalse: [self error: 'oop is not a valid address'. ^false]. + (self oop: (self addressAfter: oop) isLessThanOrEqualTo: endOfMemory) ifFalse: - (self oop: (self addressAfter: oop) isLessThanOrEqualTo: freeOldSpaceStart) ifFalse: [self error: 'oop size would make it extend beyond the end of memory'. ^false]. "header type checks" (classIndex := self classIndexOf: oop) >= self firstClassIndexPun ifFalse: [self error: 'oop is a free chunk, or bridge, not an object'. ^false]. ((self rawNumSlotsOf: oop) = self numSlotsMask and: [(self rawNumSlotsOf: oop - self baseHeaderSize) ~= self numSlotsMask]) ifTrue: [self error: 'oop header has overflow header word, but overflow word does not have a saturated numSlots field'. ^false]. "format check" fmt := self formatOf: oop. (fmt = 6) | (fmt = 8) ifTrue: [self error: 'oop has an unknown format type'. ^false]. (fmt = self forwardedFormat) ~= (classIndex = self isForwardedObjectClassIndexPun) ifTrue: [self error: 'oop has mis-matched format/classIndex fields; only one of them is the isForwarded value'. ^false]. "specific header bit checks" unusedBits := (1 << self classIndexFieldWidth) | (1 << (self identityHashFieldWidth + 32)). ((self longLongAt: oop) bitAnd: unusedBits) ~= 0 ifTrue: [self error: 'some unused header bits are set; should be zero'. ^false]. unusedBitsInYoungObjects := (1 << self greyBitShift) | (1 << self pinnedBitShift) | (1 << self rememberedBitShift). ((self longAt: oop) bitAnd: unusedBitsInYoungObjects) ~= 0 ifTrue: [self error: 'some header bits unused in young objects are set; should be zero'. ^false]. ^true ! Item was changed: ----- Method: SpurMemoryManager>>reverseBytesInMemory (in category 'snapshot') ----- reverseBytesInMemory + self reverseBytesFrom: newSpaceLimit to: endOfMemory! - self reverseBytesFrom: newSpaceLimit to: freeOldSpaceStart! Item was changed: ----- Method: SpurSegmentInfo>>printOn: (in category 'printing') ----- printOn: aStream <doNotGenerate> super printOn: aStream. + (self class instVarNames copyReplaceAll: #('segSize') with: #('segSize' 'segLimit')) do: - self class instVarNames do: [:name| | iv | + iv := self perform: name asSymbol. - iv := self instVarNamed: name. aStream space; nextPutAll: name; space; print: iv. (iv isInteger and: [iv ~= 0]) ifTrue: [aStream nextPut: $/. iv storeOn: aStream base: 16]]! Item was added: + ----- Method: SpurSegmentManager>>checkSegments (in category 'debug support') ----- + checkSegments + self assert: numSegments >= 1. + 0 to: numSegments - 1 do: + [:i| + self assert: (manager addressCouldBeObj: (segments at: i) segStart). + self assert: (self isValidSegmentBridge: (segments at: i) segLimit - manager baseHeaderSize)]. + self assert: (segments at: numSegments - 1) segLimit = manager endOfMemory! Item was changed: ----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') ----- collapseSegmentsPostSwizzle "The image has been loaded, old segments reconstructed, and the heap swizzled into a single contiguous segment. Collapse the segments into one." <inline: false> canSwizzle := false. self cCode: [] inSmalltalk: [segments ifNil: [self allocateOrExtendSegmentInfos]]. numSegments := 1. (segments at: 0) segStart: manager newSpaceLimit; + segSize: manager endOfMemory - manager newSpaceLimit. + manager bootstrapping ifTrue: + ["finally plant a bridge at the end of the coalesced segment and cut back the + manager's notion of the end of memory to immediately before the bridge." + self assert: manager endOfMemory = (segments at: 0) segLimit. + manager + initSegmentBridgeWithBytes: manager bridgeSize + at: manager endOfMemory - manager bridgeSize]. + self assert: (self isValidSegmentBridge: manager endOfMemory - manager baseHeaderSize). + self assert: (manager numSlotsOfAny: manager endOfMemory - manager baseHeaderSize) = 0! - segSize: manager endOfMemory + manager bridgeSize - manager newSpaceLimit. - manager bootstrapping - ifTrue: - ["finally plant a bridge at the end of the coalesced segment and cut back the - manager's notion of the end of memory to immediately before the bridge." - self assert: manager endOfMemory = ((segments at: 0) segLimit - manager bridgeSize). - manager initSegmentBridgeWithBytes: manager bridgeSize at: manager endOfMemory] - ifFalse: - [self assert: (manager isValidSegmentBridge: manager endOfMemory). - self assert: (manager numSlotsOfAny: manager endOfMemory) = 0]! Item was changed: ----- Method: SpurSegmentManager>>initializeFromFreeChunks: (in category 'simulation only') ----- initializeFromFreeChunks: freeChunks "For testing, create a set of segments using the freeChunks as bridges." numSegments := freeChunks size. freeChunks do: [:f| manager initSegmentBridgeWithBytes: (manager bytesInObject: f) at: (manager startOfObject: f). self assert: (manager isSegmentBridge: f)]. segments := (1 to: numSegments) collect: [:i| | bridge start size | bridge := freeChunks at: i. start := i = 1 ifTrue: [manager newSpaceLimit] ifFalse: [manager addressAfter: (freeChunks at: i - 1)]. size := bridge + manager baseHeaderSize - start. SpurSegmentInfo new segStart: start; segSize: size; yourself]. + manager setEndOfMemory: segments last segLimit. segments := CArrayAccessor on: segments. + freeChunks do: + [:bridge| self assert: (self isValidSegmentBridge: bridge)]! - freeChunks allButLast do: - [:bridge| self assert: (manager isValidSegmentBridge: bridge)]! Item was added: + ----- Method: SpurSegmentManager>>isValidSegmentBridge: (in category 'testing') ----- + isValidSegmentBridge: objOop + "bridges bridge the gaps between segments. They are the last object in each segment." + ^(manager addressCouldBeObj: objOop) + and: [(manager isSegmentBridge: objOop) + and: [manager hasOverflowHeader: objOop]]! Item was changed: ----- Method: SpurSegmentManager>>writeImageToFile: (in category 'snapshot') ----- writeImageToFile: aBinaryStream | total | total := 0. + self assert: (segments at: numSegments - 1) segLimit = manager endOfMemory. - self assert: (segments at: numSegments - 1) segLimit - manager bridgeSize = manager endOfMemory. firstSegmentSize ifNotNil: [self assert: firstSegmentSize = (segments at: 0) segSize]. 0 to: numSegments - 1 do: [:i| | nextSegSize | nextSegSize := i = (numSegments - 1) ifTrue: [0] ifFalse: [(segments at: i + 1) segSize]. total := total + (self writeSegment: (self addressOf: (segments at: i)) nextSegmentSize: nextSegSize toFile: aBinaryStream)]. ^total! Item was changed: ----- Method: SpurSegmentManager>>writeSegment:nextSegmentSize:toFile: (in category 'snapshot') ----- writeSegment: aSpurSegmentInfo nextSegmentSize: nextSegSize toFile: aBinaryStream <var: 'aSpurSegmentInfo' type: #'SpurSegmentInfo *'> <var: 'aBinaryStream' type: #'FILE *'> | bridge savedHeader nWritten | <var: 'savedHeader' type: #usqLong> bridge := aSpurSegmentInfo segLimit - manager baseHeaderSize. "last seg may be beyond endOfMemory/freeOldSpaceStart" + self assert: (self isValidSegmentBridge: bridge). - self assert: ((manager isValidSegmentBridge: bridge) or: [nextSegSize = 0]). savedHeader := manager longLongAt: bridge. manager longLongAt: bridge put: nextSegSize. nWritten := self cCode: [self sq: aSpurSegmentInfo segStart asVoidPointer Image: 1 File: aSpurSegmentInfo segSize Write: aBinaryStream] inSmalltalk: [aBinaryStream next: aSpurSegmentInfo segSize / 4 putAll: manager memory startingAt: aSpurSegmentInfo segStart / 4 + 1. aSpurSegmentInfo segSize]. manager longLongAt: bridge put: savedHeader. ^nWritten!

1 0

VM Maker: Cog-eem.120.mcz
by commits＠source.squeak.org 16 Nov '13

16 Nov '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.120.mcz ==================== Summary ==================== Name: Cog-eem.120 Author: eem Time: 16 November 2013, 8:24:50.422 am UUID: 2830bc2a-d66c-486b-9f3e-783a1dc555b2 Ancestors: Cog-eem.119 Fix Spur bootstrap image validation and snapshot write now endOfMemory includes last bridge. Needs VMMaker.oscog-eem.512. =============== Diff against Cog-eem.119 =============== Item was changed: ----- Method: SpurBootstrap>>validate (in category 'bootstrap image') ----- validate + | p n duplicates maxClassIndex savedEndOfMemory | - | p n duplicates maxClassIndex | self assert: (reverseMap at: newHeap specialObjectsOop) = oldHeap specialObjectsOop. self assert: (map at: oldHeap specialObjectsOop) = newHeap specialObjectsOop. self assert: (reverseMap at: newHeap classTableRootObj ifAbsent: []) isNil. duplicates := { 3. newHeap arrayClassIndexPun. newHeap weakArrayClassIndexPun }. maxClassIndex := classToIndex inject: 0 into: [:a :b| a max: b]. self assert: ((newHeap arrayClassIndexPun to: maxClassIndex) select: [:idx| | classObj | (classObj := newHeap classAtIndex: idx) ~= newHeap nilObject and: [(newHeap classIndexOf: classObj) = (newHeap rawHashBitsOf: classObj)]]) isEmpty. 0 to: maxClassIndex do: [:index| | classObj | (index <= newHeap tagMask and: [index > newHeap isForwardedObjectClassIndexPun]) ifTrue: [(classObj := newHeap classAtIndex: index) = newHeap nilObject ifTrue: [self assert: (classToIndex keyAtValue: index ifAbsent: []) isNil] ifFalse: [self assert: (newHeap classIndexOf: classObj) ~= (newHeap rawHashBitsOf: classObj). (duplicates includes: index) ifFalse: [self assert: (newHeap rawHashBitsOf: classObj) = index]]]]. classToIndex keysAndValuesDo: [:oldClass :idx| self assert: (newHeap rawHashBitsOf: (map at: oldClass)) = idx. self assert: oldClass = (reverseMap at: (newHeap classAtIndex: idx))]. n := 0. + savedEndOfMemory := newHeap endOfMemory. + newHeap setEndOfMemory: newHeap freeOldSpaceStart. newHeap allObjectsDo: [:o| (o <= newHeap trueObject or: [o > lastClassTablePage]) ifTrue: [self assert: (reverseMap includesKey: o). self assert: (newHeap fetchClassOfNonImm: o) = (map at: (oldHeap fetchClassOfNonImm: (reverseMap at: o)))]. n := n + 1. p := o]. + newHeap setEndOfMemory: savedEndOfMemory. + self touch: p. - p class. self assert: (n between: map size and: map size + 6). "+ 6 is room for freelists & classTable" "check some class properties to ensure the format changes are correct" self assert: (newHeap fixedFieldsOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = 0. self assert: (newHeap instSpecOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = newHeap arrayFormat! Item was changed: ----- Method: SpurBootstrap>>writeSnapshotOfTransformedImage (in category 'testing') ----- writeSnapshotOfTransformedImage "The bootstrapped image typically contains a few big free chunks and one huge free chunk. Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges and saving." + | penultimate ultimate heap sizes counts barriers sim | - | last heap sizes counts barriers sim | heap := TransformedImage veryDeepCopy. sim := StackInterpreterSimulator onObjectMemory: heap. sim bootstrapping: true. heap coInterpreter: sim. sim initializeInterpreter: 0; setImageHeaderFlagsFrom: ImageHeaderFlags; setDisplayForm: (Form extent: ImageScreenSize >> 16 @ (ImageScreenSize bitAnd: 16rFFFF)). + heap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e]. + self assert: (heap isFreeObject: penultimate). + self assert: (heap isSegmentBridge: ultimate). - heap allOldSpaceEntitiesDo: [:e| last := e]. - self assert: (heap isFreeObject: last). sizes := Bag new. heap allObjectsInFreeTree: (heap freeLists at: 0) do: [:f| sizes add: (heap bytesInObject: f)]. counts := sizes sortedCounts. self assert: counts last key = 1. "1 huge chunk" self assert: ((counts at: counts size - 1) key > 2 and: [(counts at: counts size - 1) value > 1024]). barriers := (1 to: (counts at: counts size - 1) key) collect: [:ign| heap allocateOldSpaceChunkOfExactlyBytes: (counts at: counts size - 1) value]. + barriers := barriers, {heap allocateOldSpaceChunkOfExactlyBytes: (heap bytesInObject: penultimate)}. - barriers := barriers, {heap allocateOldSpaceChunkOfExactlyBytes: (heap bytesInObject: last)}. heap setEndOfMemory: barriers last. + heap allOldSpaceEntitiesDo: [:e| penultimate := ultimate. ultimate := e]. + self assert: (heap addressAfter: ultimate) = barriers last. - heap allOldSpaceEntitiesDo: [:e| last := e]. - self assert: (heap addressAfter: last) = barriers last. heap checkFreeSpace. heap runLeakCheckerForFullGC: true. heap segmentManager initializeFromFreeChunks: (barriers sort collect: [:b| heap objectStartingAt: b]). heap checkFreeSpace. heap runLeakCheckerForFullGC: true. sim bereaveAndNormalizeContextsAndFlushExternalPrimitives. sim imageName: 'spur.image'. sim writeImageFileIO!

1 0

VM Maker: Cog-eem.119.mcz
by commits＠source.squeak.org 16 Nov '13

16 Nov '13

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.119.mcz ==================== Summary ==================== Name: Cog-eem.119 Author: eem Time: 15 November 2013, 5:10:02.638 pm UUID: e98515d8-03ad-451a-b081-2f1f3632127d Ancestors: Cog-eem.118 Check-point commit prior to changing endOfMemory to be just past the last bridge. This for fixing the bug which is the last freeChunk ending past the last bridge, not at the last bridge. Set the explicit bootstrapping ins var instead of (ab)using numSegments = 0. Agrees with VMMaker.oscog-eem.511. =============== Diff against Cog-eem.118 =============== Item was changed: ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') ----- rehashImage "Rehash all collections in newHeap. Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags. Enumerate all objects, rehashing those whose class has a bit set in rehashFlags." | n sim rehashFlags | sim := StackInterpreterSimulator onObjectMemory: newHeap. newHeap coInterpreter: sim. + sim bootstrapping: true. sim initializeInterpreter: 0. sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal. newHeap setHashBitsOf: newHeap nilObject to: 1; setHashBitsOf: newHeap falseObject to: 2; setHashBitsOf: newHeap trueObject to: 3. rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize. n := 0. newHeap classTableObjectsDo: [:class| | classIndex | sim messageSelector: (map at: rehashSym). "Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self." ((sim lookupMethodNoMNUEtcInClass: class) = 0 and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue: [n := n + 1. classIndex := newHeap rawHashBitsOf: class. rehashFlags at: classIndex >> 3 + 1 put: ((rehashFlags at: classIndex >> 3 + 1) bitOr: (1 << (classIndex bitAnd: 7)))]]. Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush. n := 0. self withExecutableInterpreter: sim do: [sim setBreakSelector: 'error:'. "don't rehash twice (actually without limit), so don't rehash any new objects created." newHeap allExistingOldSpaceObjectsDo: [:o| | classIndex | classIndex := newHeap classIndexOf: o. ((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue: [(n := n + 1) \\ 8 = 0 ifTrue: [Transcript nextPut: $.; flush]. "2845 = n ifTrue: [self halt]." "Rehash an object if its size is > 0. Symbol implements rehash, but let's not waste time rehashing it; in Squeak up to 2013 symbols are kept in a set which will get reashed anyway.. Don't rehash empty collections; they may be large for a reason and rehashing will shrink them." ((sim addressCouldBeClassObj: o) or: [(self interpreter: sim object: o perform: (map at: sizeSym) withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse: [self interpreter: sim object: o perform: (map at: rehashSym) withArguments: #()]]]]! Item was changed: ----- Method: SpurBootstrap>>writeSnapshotOfTransformedImage (in category 'testing') ----- writeSnapshotOfTransformedImage "The bootstrapped image typically contains a few big free chunks and one huge free chunk. Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges and saving." | last heap sizes counts barriers sim | heap := TransformedImage veryDeepCopy. sim := StackInterpreterSimulator onObjectMemory: heap. + sim bootstrapping: true. heap coInterpreter: sim. sim initializeInterpreter: 0; setImageHeaderFlagsFrom: ImageHeaderFlags; setDisplayForm: (Form extent: ImageScreenSize >> 16 @ (ImageScreenSize bitAnd: 16rFFFF)). heap allOldSpaceEntitiesDo: [:e| last := e]. self assert: (heap isFreeObject: last). sizes := Bag new. heap allObjectsInFreeTree: (heap freeLists at: 0) do: [:f| sizes add: (heap bytesInObject: f)]. counts := sizes sortedCounts. self assert: counts last key = 1. "1 huge chunk" self assert: ((counts at: counts size - 1) key > 2 and: [(counts at: counts size - 1) value > 1024]). barriers := (1 to: (counts at: counts size - 1) key) collect: [:ign| heap allocateOldSpaceChunkOfExactlyBytes: (counts at: counts size - 1) value]. barriers := barriers, {heap allocateOldSpaceChunkOfExactlyBytes: (heap bytesInObject: last)}. heap setEndOfMemory: barriers last. heap allOldSpaceEntitiesDo: [:e| last := e]. self assert: (heap addressAfter: last) = barriers last. heap checkFreeSpace. heap runLeakCheckerForFullGC: true. heap segmentManager initializeFromFreeChunks: (barriers sort collect: [:b| heap objectStartingAt: b]). heap checkFreeSpace. heap runLeakCheckerForFullGC: true. sim bereaveAndNormalizeContextsAndFlushExternalPrimitives. sim imageName: 'spur.image'. sim writeImageFileIO!

1 0

VM Maker: VMMaker.oscog-eem.511.mcz
by commits＠source.squeak.org 16 Nov '13

16 Nov '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.511.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.511 Author: eem Time: 15 November 2013, 5:04:13.256 pm UUID: 2a9dbb56-4151-4ebd-a674-e445ed58b0c8 Ancestors: VMMaker.oscog-eem.510 Check-point cmmit prior to changing endOfMemory to be just past the last bridge. This for fixing the bug which is the last freeChunk ending past the last bridge, not at the last bridge. Fix Integer>>asUnsignedInteger for simulation when printing frames in the StackInterpreter (which are negative there-in). Add explicit bootstrapping inst vars to the StackInterpreterSimulator and Spur32BitMMLESimulator now that there is a segment during the bootstrap. =============== Diff against VMMaker.oscog-eem.510 =============== Item was changed: ----- Method: Integer>>asUnsignedInteger (in category '*VMMaker-interpreter simulator') ----- asUnsignedInteger - self assert: self >= 0. ^self! Item was changed: Spur32BitMemoryManager subclass: #Spur32BitMMLESimulator + instanceVariableNames: 'bootstrapping' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-SpurMemoryManagerSimulation'! Item was added: + ----- Method: Spur32BitMMLESimulator>>bootstrapping (in category 'accessing') ----- + bootstrapping + ^bootstrapping! Item was added: + ----- Method: Spur32BitMMLESimulator>>bootstrapping: (in category 'accessing') ----- + bootstrapping: aBoolean + bootstrapping := aBoolean. + segmentManager initForBootstrap! Item was added: + ----- Method: Spur32BitMMLESimulator>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') ----- + growOldSpaceByAtLeast: minAmmount + "Attempt to grow memory by at least minAmmount. + Answer the size of the new segment, or nil if the attempt failed. + Override to not grow during the Spur image bootstrap." + ^bootstrapping ifFalse: + [super growOldSpaceByAtLeast: minAmmount]! Item was added: + ----- Method: Spur32BitMMLESimulator>>initialize (in category 'initialization') ----- + initialize + super initialize. + bootstrapping := false! Item was added: + ----- Method: Spur32BitMMLESimulator>>memoryBaseForImageRead (in category 'snapshot') ----- + memoryBaseForImageRead + "Answer the address to read the image into. Override so that when bootstrapping, + the segmentManager's segments are undisturbed in adjustSegmentSwizzlesBy:" + ^bootstrapping + ifTrue: [0] + ifFalse: [super memoryBaseForImageRead]! Item was changed: ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:stackSize:codeSize: (in category 'spur bootstrap') ----- allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes "Intialize the receiver for bootsraping an image. Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold to allocate in oldSpace. Later on (in initializePostBootstrap) freeStart and scavengeThreshold will be set to sane values." <doNotGenerate> - | endBridgeBytes | self assert: (memoryBytes \\ self allocationUnit = 0 and: [newSpaceBytes \\ self allocationUnit = 0 and: [codeBytes \\ self allocationUnit = 0]]). - endBridgeBytes := 2 * self baseHeaderSize. memory := (self endianness == #little ifTrue: [LittleEndianBitmap] + ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes + stackBytes) // 4. - ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes + stackBytes + endBridgeBytes) // 4. startOfMemory := codeBytes + stackBytes. + endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes + stackBytes - self bridgeSize. - endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes + stackBytes. "leave newSpace empty for the bootstrap" freeStart := newSpaceBytes + startOfMemory. newSpaceLimit := newSpaceBytes + startOfMemory. scavengeThreshold := memory size * 4. "Bitmap is a 4-byte per word array" scavenger := SpurGenerationScavengerSimulator new manager: self newSpaceStart: startOfMemory newSpaceBytes: newSpaceBytes edenBytes: newSpaceBytes * self scavengerDenominator - self numSurvivorSpaces // self scavengerDenominator! Item was added: + ----- Method: SpurMemoryManager>>bootstrapping (in category 'accessing') ----- + bootstrapping + ^false! Item was changed: ----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') ----- freeChunkWithBytes: bytes at: address <inline: false> | freeChunk | self assert: (lastSubdividedFreeChunk := address) ~= 0. freeChunk := self initFreeChunkWithBytes: bytes at: address. + self assert: (self isInMemory: (self addressAfter: freeChunk)). self addToFreeList: freeChunk bytes: bytes. self assert: freeChunk = (self objectStartingAt: address). ^freeChunk! Item was changed: ----- Method: SpurMemoryManager>>initializeFreeSpacePostLoad: (in category 'snapshot') ----- initializeFreeSpacePostLoad: freeListObj "Reinitialize the free list info. The freeLists object needs to be swizzled because its neither a free, nor a pointer object. Free objects have already been swizzled in adjustAllOopsBy:" self assert: (self numSlotsOf: freeListObj) = self numFreeLists. self assert: (self formatOf: freeListObj) = (self wordSize = 4 ifTrue: [self firstLongFormat] ifFalse: [self sixtyFourBitIndexableFormat]). - freeLists := self firstIndexableField: freeListObj. + freeListsMask := 0. 0 to: self numFreeLists - 1 do: [:i| (freeLists at: i) ~= 0 ifTrue: [freeListsMask := freeListsMask bitOr: (1 << i). + freeLists at: i put: (segmentManager swizzleObj: (freeLists at: i))]]. + totalFreeOldSpace := self totalFreeListBytes. + self checkFreeSpace! - segmentManager numSegments > 0 ifTrue: "false in Spur image bootstrap" - [freeLists at: i put: (segmentManager swizzleObj: (freeLists at: i))]]]. - totalFreeOldSpace := self totalFreeListBytes! Item was changed: ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') ----- initializeObjectMemory: bytesToShift "Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks." "Assume: image reader initializes the following variables: memory memoryLimit specialObjectsOop lastHash " <inline: false> | freeListObj | "Catch mis-initializations leading to bad translations to C" self assert: BaseHeaderSize = self baseHeaderSize. segmentManager adjustSegmentSwizzlesBy: bytesToShift. "image may be at a different address; adjust oops for new location" self adjustAllOopsBy: bytesToShift. + specialObjectsOop := segmentManager swizzleObj: specialObjectsOop. - segmentManager numSegments > 0 "false if Spur image bootstrap" - ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop] - ifFalse: [self assert: bytesToShift = 0]. - "heavily used special objects" nilObj := self splObj: NilObject. falseObj := self splObj: FalseObject. trueObj := self splObj: TrueObject. "In Cog we insist that nil, true & false are next to each other (Cogit generates tighter conditional branch code as a result). In addition, Spur places the free lists and class table root page immediately following them." self assert: nilObj = newSpaceLimit. self assert: falseObj = (self objectAfter: nilObj). self assert: trueObj = (self objectAfter: falseObj). freeListObj := self objectAfter: trueObj. self reInitializeClassTablePostLoad: (self objectAfter: freeListObj). - self initializeFreeSpacePostLoad: freeListObj. markStack := self swizzleObjStackAt: MarkStackRootIndex. weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex. ephemeronQueue := self swizzleObjStackAt: EphemeronQueueRootIndex. segmentManager collapseSegmentsPostSwizzle. + self initializeFreeSpacePostLoad: freeListObj. self initializeNewSpaceVariables. self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart" "These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi." growHeadroom := 16*1024*1024. "headroom when growing" shrinkThreshold := 32*1024*1024. "free space before shrinking"! Item was changed: ----- Method: SpurMemoryManager>>isValidFreeObject: (in category 'free space') ----- isValidFreeObject: objOop | chunk | ^(self addressCouldBeObj: objOop) and: [(self isFreeObject: objOop) + and: [(self isInMemory: (self addressAfter: objOop)) and: [((chunk := (self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop)) = 0 or: [self isFreeObject: chunk]) and: [(self bytesInObject: objOop) / self allocationUnit < self numFreeLists or: [((chunk := (self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop)) = 0 or: [self isFreeObject: chunk]) and: [((chunk := (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop)) = 0 or: [self isFreeObject: chunk]) and: [(chunk := (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop)) = 0 + or: [self isFreeObject: chunk]]]]]]]]! - or: [self isFreeObject: chunk]]]]]]]! Item was changed: ----- Method: SpurMemoryManager>>isValidSegmentBridge: (in category 'segments') ----- isValidSegmentBridge: objOop "Maybe this should be in SpurSegmentManager only" + ^(objOop = endOfMemory or: [self addressCouldBeObj: objOop]) - ^(self addressCouldBeObj: objOop) and: [(self isSegmentBridge: objOop) and: [self hasOverflowHeader: objOop]]! Item was changed: ----- Method: SpurMemoryManager>>scavengingGCTenuringIf: (in category 'gc - scavenging') ----- scavengingGCTenuringIf: tenuringCriterion "Run the scavenger." self assert: remapBufferCount = 0. + self assert: scavenger eden limit - freeStart > coInterpreter interpreterAllocationReserveBytes. - self assert: (segmentManager numSegments = 0 "true in the spur image bootstrap" - or: [scavenger eden limit - freeStart > coInterpreter interpreterAllocationReserveBytes]). self checkFreeSpace. "coInterpreter printCallStackFP: coInterpreter framePointer" self runLeakCheckerForFullGC: false. coInterpreter preGCAction: GCModeScavenge; "would prefer this to be in mapInterpreterOops, but compatibility with ObjectMemory dictates it goes here." flushMethodCacheFrom: startOfMemory to: newSpaceLimit. needGCFlag := false. gcStartUsecs := coInterpreter ioUTCMicrosecondsNow. self doScavenge: tenuringCriterion. statScavenges := statScavenges + 1. statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow. statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs. statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs. statRootTableCount := scavenger rememberedSetSize. coInterpreter postGCAction: GCModeScavenge. self runLeakCheckerForFullGC: false. self checkFreeSpace! Item was changed: ----- Method: SpurMemoryManager>>setHeapBase:memoryLimit:endOfMemory: (in category 'snapshot') ----- setHeapBase: heapBase memoryLimit: memLimit endOfMemory: memEnd "Transcript cr; nextPutAll: 'heapBase: '; print: heapBase; nextPut: $/; nextPutAll: heapBase hex; nextPutAll: ' memLimit '; print: memLimit; nextPut: $/; nextPutAll: memLimit hex; nextPutAll: ' memEnd '; print: memEnd; nextPut: $/; nextPutAll: memEnd hex; cr; flush." + startOfMemory := heapBase. newSpaceLimit := heapBase + self newSpaceBytes + coInterpreter interpreterAllocationReserveBytes. freeOldSpaceStart := memEnd. endOfMemory := memLimit. scavenger newSpaceStart: heapBase newSpaceBytes: newSpaceLimit - heapBase edenBytes: newSpaceLimit - heapBase * (self scavengerDenominator - self numSurvivorSpaces) // self scavengerDenominator. freeStart := scavenger eden start. pastSpaceStart := scavenger pastSpace start! Item was changed: ----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') ----- collapseSegmentsPostSwizzle "The image has been loaded, old segments reconstructed, and the heap swizzled into a single contiguous segment. Collapse the segments into one." <inline: false> - | bridge | canSwizzle := false. + self cCode: [] + inSmalltalk: + [segments ifNil: + [self allocateOrExtendSegmentInfos]]. - firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image" - [^self]. - numSegments := 1. (segments at: 0) segStart: manager newSpaceLimit; + segSize: manager endOfMemory + manager bridgeSize - manager newSpaceLimit. + manager bootstrapping + ifTrue: + ["finally plant a bridge at the end of the coalesced segment and cut back the + manager's notion of the end of memory to immediately before the bridge." + self assert: manager endOfMemory = ((segments at: 0) segLimit - manager bridgeSize). + manager initSegmentBridgeWithBytes: manager bridgeSize at: manager endOfMemory] + ifFalse: + [self assert: (manager isValidSegmentBridge: manager endOfMemory). + self assert: (manager numSlotsOfAny: manager endOfMemory) = 0]! - segSize: manager endOfMemory - manager newSpaceLimit. - "finally plant a bridge at the end of the coalesced segment and cut back the - manager's notion of the end of memory to immediately before the bridge." - bridge := manager endOfMemory - manager bridgeSize. - self assert: bridge = ((segments at: 0) segLimit - manager bridgeSize). - manager - initSegmentBridgeWithBytes: manager bridgeSize at: bridge; - setEndOfMemory: bridge! Item was added: + ----- Method: SpurSegmentManager>>initForBootstrap (in category 'spur bootstrap') ----- + initForBootstrap + self allocateOrExtendSegmentInfos! Item was added: + ----- Method: SpurSegmentManager>>segments (in category 'accessing') ----- + segments + ^segments! Item was changed: ----- Method: SpurSegmentManager>>writeImageToFile: (in category 'snapshot') ----- writeImageToFile: aBinaryStream | total | total := 0. + self assert: (segments at: numSegments - 1) segLimit - manager bridgeSize = manager endOfMemory. firstSegmentSize ifNotNil: [self assert: firstSegmentSize = (segments at: 0) segSize]. 0 to: numSegments - 1 do: [:i| | nextSegSize | nextSegSize := i = (numSegments - 1) ifTrue: [0] ifFalse: [(segments at: i + 1) segSize]. total := total + (self writeSegment: (self addressOf: (segments at: i)) nextSegmentSize: nextSegSize toFile: aBinaryStream)]. ^total! Item was changed: StackInterpreterPrimitives subclass: #StackInterpreterSimulator + instanceVariableNames: 'bootstrapping byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat' - instanceVariableNames: 'byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-InterpreterSimulation'! !StackInterpreterSimulator commentStamp: 'eem 9/3/2013 11:05' prior: 0! This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory. To see the thing actually run, you could (after backing up this image and changes), execute (StackInterpreterSimulator new openOn: Smalltalk imageName) test ((StackInterpreterSimulator newWithOptions: #(NewspeakVM true MULTIPLEBYTECODESETS true)) openOn: 'ns101.image') test and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image. Here's an example of what Eliot uses to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff: | vm | vm := StackInterpreterSimulator newWithOptions: #(). vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. vm setBreakSelector: #&. vm openAsMorph; run! Item was added: + ----- Method: StackInterpreterSimulator>>bootstrapping (in category 'spur bootstrap') ----- + bootstrapping + ^bootstrapping! Item was added: + ----- Method: StackInterpreterSimulator>>bootstrapping: (in category 'spur bootstrap') ----- + bootstrapping: aBoolean + bootstrapping := aBoolean. + objectMemory ifNotNil: + [objectMemory bootstrapping: aBoolean]! Item was changed: ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') ----- initialize "Initialize the StackInterpreterSimulator when running the interpreter inside Smalltalk. The primary responsibility of this method is to allocate Smalltalk Arrays for variables that will be declared as statically-allocated global arrays in the translated code." + bootstrapping := false. + objectMemory ifNil: [objectMemory := self class objectMemoryClass simulatorClass new]. objectMemory coInterpreter: self. "Note: we must initialize ConstMinusOne differently for simulation, due to the fact that the simulator works only with +ve 32-bit values" ConstMinusOne := objectMemory integerObjectOf: -1. methodCache := Array new: MethodCacheSize. atCache := Array new: AtCacheTotalSize. self flushMethodCache. gcSemaphoreIndex := 0. externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #(). externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize). externalPrimitiveTableFirstFreeIndex := 0. primitiveTable := self class primitiveTable copy. pluginList := {'' -> self }. mappedPluginEntries := #(). desiredNumStackPages := desiredEdenBytes := 0. "This is initialized on loading the image, but convenient for testing stack page values..." numStackPages := self defaultNumStackPages. startMicroseconds := Time totalSeconds * 1000000. "initialize InterpreterSimulator variables used for debugging" byteCount := 0. sendCount := 0. quitBlock := [^ self]. traceOn := true. printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false. myBitBlt := BitBltSimulator new setInterpreter: self. transcript := Transcript. displayForm := 'Display has not yet been installed' asDisplayText form. suppressHeartbeatFlag := false. extSemTabSize := 256. disableBooleanCheat := false! Item was added: + ----- Method: StackInterpreterSimulator>>interpreterAllocationReserveBytes (in category 'stack pages') ----- + interpreterAllocationReserveBytes + ^bootstrapping + ifTrue: [0] + ifFalse: [super interpreterAllocationReserveBytes]!

1 0

VM Maker: VMMaker-dtl.329.mcz
by commits＠source.squeak.org 15 Nov '13

15 Nov '13

David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.329.mcz ==================== Summary ==================== Name: VMMaker-dtl.329 Author: dtl Time: 15 November 2013, 5:44:12.345 pm UUID: 1050f0cf-ec99-40ca-9fcf-165024cb2735 Ancestors: VMMaker-dtl.328 Merge MiscPrimitivePluginTest into IncludedMethodsTest, and remove MiscPrimitivePluginTest. Various classes in the image contain methods that are intended to be translated to C and executed as primitives. IncludedMethodsTest provides tests to validate these methods. =============== Diff against VMMaker-dtl.328 =============== Item was added: + ----- Method: IncludedMethodsTest>>expectedFailures (in category 'testing') ----- + expectedFailures + + ^#(testFindSubstringOldVersionWithMissingTypeChecks + testFindSubstringInWideString) + ! Item was added: + ----- Method: IncludedMethodsTest>>hashBytes:startingWith: (in category 'primitives') ----- + hashBytes: aByteArray startingWith: speciesHash + "Answer the hash of a byte-indexed collection, + using speciesHash as the initial value. + See SmallInteger>>hashMultiply. + + The primitive should be renamed at a + suitable point in the future" + + <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> + self primitiveFailed + ! Item was added: + ----- Method: IncludedMethodsTest>>testFindSubstringInByteString (in category 'testing') ----- + testFindSubstringInByteString + "Verify that primitive exists in the VM and works as expected for byte + sized string and key. If key is a WideString, as may be the case if testing + for a WideString as substring of a byte sized string, then the primitive + should fail. Earlier version of the primitive would accept the non-bytes + parameter, leading to incorrect results, as documented in + testFindSubstringOldVersionWithMissingTypeChecks" + + | position | + position := self + findSubstring: 'bc' + in: 'abcdef' + startingAt: 1 + matchTable: ((0 to: 255) + as: ByteArray). + self assert: position = 2. + self should: [self + findSubstring: 'bc' asWideString + in: 'abcdef' + startingAt: 1 + matchTable: ((0 to: 255) + as: ByteArray)] + raise: Error + + ! Item was added: + ----- Method: IncludedMethodsTest>>testFindSubstringInWideString (in category 'testing') ----- + testFindSubstringInWideString + "The primitive will fail if invoked on a non-byte receiver. WideString does + not call the primitive, so this is an expected failure." + + | position | + position := self + findSubstring: 'bc' + in: 'abcdef' asWideString + startingAt: 1 + matchTable: ((0 to: 255) + as: ByteArray). + self assert: position = 0. + position := self + findSubstring: 'bc' asWideString + in: 'abcdef' asWideString + startingAt: 1 + matchTable: ((0 to: 255) + as: ByteArray). + self assert: position = 2 + ! Item was added: + ----- Method: IncludedMethodsTest>>testFindSubstringOldVersionWithMissingTypeChecks (in category 'testing') ----- + testFindSubstringOldVersionWithMissingTypeChecks + "Verify that primitive exists in the VM. This test documents the behavior of older versions + of the primitive that did not perform type checking on to fail on WideString parameters. + Newer versions of the primitive handle this properly, hence this test is an expectedFailure. + The fix for this issue (by Andreas Raab) is in TMethod>>argConversionExprFor:stackIndex: + which was added to VMMaker in VMMaker-dtl.202. + + If this test passes, it is an indication that the TMethod>>argConversionExprFor:stackIndex: + update is missing from the VMMaker code generator that produced the VM." + + "(MiscPrimitivePluginTest selector: #testArgsAsFlatArrayAndOffsets) run" + + | position | + "If both receiver and argument are byte size, the primitive performs correctly" + position := self + findSubstring: 'bc' + in: 'abcdef' + startingAt: 1 + matchTable: ((0 to: 255) + as: ByteArray). + self assert: position = 2. + + "Plugin accepts wide string argument, but should not do so." + position := self + findSubstring: 'bc' asWideString + in: 'abcdef' + startingAt: 1 + matchTable: ((0 to: 255) + as: ByteArray). + self assert: position = 0. + + position := self + findSubstring: 'bc' + in: 'abcdef' asWideString + startingAt: 1 + matchTable: ((0 to: 255) + as: ByteArray). + self assert: position = 0. + + "Older versions of the plugin produce incorrect results here" + position := self + findSubstring: 'bc' asWideString + in: 'abcdef' asWideString + startingAt: 1 + matchTable: ((0 to: 255) + as: ByteArray). + self assert: position = 5 "Incorrect!!" + ! Item was added: + ----- Method: IncludedMethodsTest>>testHashBytesStartingWith (in category 'testing - MiscPrimitivePlugin') ----- + testHashBytesStartingWith + + | ba result | + ba := #[1 2 3 4 5 6 7 8 9]. + result := self hashBytes: ba startingWith: 12345. + self assert: result = 170953102 + ! Item was removed: - TestCase subclass: #MiscPrimitivePluginTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'VMMaker-Tests'! - - !MiscPrimitivePluginTest commentStamp: 'dtl 11/10/2010 22:04' prior: 0! - Various classes in the image contain methods intended for translation to C for execution as primitives in MiscPrimitivePlugin. MiscPrimitivePluginTest provides tests to validate these methods. - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>compare:with:collated: (in category 'primitives') ----- - compare: string1 with: string2 collated: order - "Return 1, 2 or 3, if string1 is <, =, or > string2, with the collating order of characters given by the order array." - - <primitive: 'primitiveCompareString' module: 'MiscPrimitivePlugin'> - self primitiveFailed - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>compress:toByteArray: (in category 'primitives') ----- - compress: bm toByteArray: ba - - <primitive: 'primitiveCompressToByteArray' module: 'MiscPrimitivePlugin'> - self primitiveFailed! Item was removed: - ----- Method: MiscPrimitivePluginTest>>convert8bitSignedFrom:to16Bit: (in category 'primitives') ----- - convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer - "Copy the contents of the given array of signed 8-bit samples into the given array of 16-bit signed samples." - - <primitive: 'primitiveConvert8BitSigned' module: 'MiscPrimitivePlugin'> - self primitiveFailed - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>decompress:fromByteArray:at: (in category 'primitives') ----- - decompress: bm fromByteArray: ba at: index - - <primitive: 'primitiveDecompressFromByteArray' module: 'MiscPrimitivePlugin'> - self primitiveFailed - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>expectedFailures (in category 'testing') ----- - expectedFailures - - ^#(testFindSubstringOldVersionWithMissingTypeChecks - testFindSubstringInWideString) - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>findFirstInString:inSet:startingAt: (in category 'primitives') ----- - findFirstInString: aString inSet: inclusionMap startingAt: start - - <primitive: 'primitiveFindFirstInString' module: 'MiscPrimitivePlugin'> - self primitiveFailed - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>findSubstring:in:startingAt:matchTable: (in category 'primitives') ----- - findSubstring: key in: body startingAt: start matchTable: matchTable - "Answer the index in the string body at which the substring key first occurs, at or beyond start. The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches. If no match is found, zero will be returned." - - <primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'> - self primitiveFailed - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>hashBytes:startingWith: (in category 'primitives') ----- - hashBytes: aByteArray startingWith: speciesHash - "Answer the hash of a byte-indexed collection, - using speciesHash as the initial value. - See SmallInteger>>hashMultiply. - - The primitive should be renamed at a - suitable point in the future" - - <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> - self primitiveFailed - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>indexOfAscii:inString:startingAt: (in category 'primitives') ----- - indexOfAscii: anInteger inString: aString startingAt: start - - <primitive: 'primitiveIndexOfAsciiInString' module: 'MiscPrimitivePlugin'> - self primitiveFailed - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testCompareWithCollated (in category 'testing') ----- - testCompareWithCollated - "Verify that primitive exists in the VM" - - self assert: 3 = (self compare: 'foo' with: 'bar' collated: ((0 to: 255) as: ByteArray)) - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testCompressToByteArray (in category 'testing') ----- - testCompressToByteArray - - | bitmap byteArray | - bitmap := Bitmap with: 16rFFFFFFFF. - byteArray := ByteArray new: 4. - self compress: bitmap toByteArray: byteArray. - self should: byteArray = #[1 5 255 0]! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testConvert8bitSignedFromTo16Bit (in category 'testing') ----- - testConvert8bitSignedFromTo16Bit - "SampledSound class>>convert8bitSignedFrom:to16Bit:" - - - | aByteArray aSoundBuffer | - aByteArray := #[1 2 3 4 5 6 7 8 9]. - aSoundBuffer := SoundBuffer newMonoSampleCount: aByteArray size. - self convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer. - self assert: aSoundBuffer = ((SoundBuffer new: 10) at: 1 put: 256; at: 2 put: 512; - at: 3 put: 768; at: 4 put: 1024; at: 5 put: 1280; at: 6 put: 1536; at: 7 put: 1792; - at: 8 put: 2048; at: 9 put: 2304; at: 10 put: 0; yourself)! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testDecompressFromByteArrayAt (in category 'testing') ----- - testDecompressFromByteArrayAt - - | bitmap byteArray s size | - byteArray := #(1 5 255 0) asByteArray. - s := ReadStream on: byteArray. - size := Bitmap decodeIntFrom: s. - bitmap := Bitmap new: size. - self decompress: bitmap fromByteArray: byteArray at: s position + 1. - self should: bitmap = ((Bitmap new: 1) at: 1 put: 4294967295; yourself)! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testFindFirstInStringInSetStartingAt (in category 'testing') ----- - testFindFirstInStringInSetStartingAt - - | position set | - set := ((0 to: 255) collect: [:e | (e \\ 2) + $0 asciiValue]) asByteArray. - position := self findFirstInString: 'abcdef' inSet: set startingAt: 1. - self assert: position = 1 - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testFindSubstringInByteString (in category 'testing') ----- - testFindSubstringInByteString - "Verify that primitive exists in the VM and works as expected for byte - sized string and key. If key is a WideString, as may be the case if testing - for a WideString as substring of a byte sized string, then the primitive - should fail. Earlier version of the primitive would accept the non-bytes - parameter, leading to incorrect results, as documented in - testFindSubstringOldVersionWithMissingTypeChecks" - - | position | - position := MiscPrimitivePluginTest new - findSubstring: 'bc' - in: 'abcdef' - startingAt: 1 - matchTable: ((0 to: 255) - as: ByteArray). - self assert: position = 2. - self should: [MiscPrimitivePluginTest new - findSubstring: 'bc' asWideString - in: 'abcdef' - startingAt: 1 - matchTable: ((0 to: 255) - as: ByteArray)] - raise: Error - - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testFindSubstringInWideString (in category 'testing') ----- - testFindSubstringInWideString - "The primitive will fail if invoked on a non-byte receiver. WideString does - not call the primitive, so this is an expected failure." - - | position | - position := MiscPrimitivePluginTest new - findSubstring: 'bc' - in: 'abcdef' asWideString - startingAt: 1 - matchTable: ((0 to: 255) - as: ByteArray). - self assert: position = 0. - position := MiscPrimitivePluginTest new - findSubstring: 'bc' asWideString - in: 'abcdef' asWideString - startingAt: 1 - matchTable: ((0 to: 255) - as: ByteArray). - self assert: position = 2 - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testFindSubstringOldVersionWithMissingTypeChecks (in category 'testing') ----- - testFindSubstringOldVersionWithMissingTypeChecks - "Verify that primitive exists in the VM. This test documents the behavior of older versions - of the primitive that did not perform type checking on to fail on WideString parameters. - Newer versions of the primitive handle this properly, hence this test is an expectedFailure. - The fix for this issue (by Andreas Raab) is in TMethod>>argConversionExprFor:stackIndex: - which was added to VMMaker in VMMaker-dtl.202. - - If this test passes, it is an indication that the TMethod>>argConversionExprFor:stackIndex: - update is missing from the VMMaker code generator that produced the VM." - - "(MiscPrimitivePluginTest selector: #testArgsAsFlatArrayAndOffsets) run" - - | position | - "If both receiver and argument are byte size, the primitive performs correctly" - position := MiscPrimitivePluginTest new - findSubstring: 'bc' - in: 'abcdef' - startingAt: 1 - matchTable: ((0 to: 255) - as: ByteArray). - self assert: position = 2. - - "Plugin accepts wide string argument, but should not do so." - position := MiscPrimitivePluginTest new - findSubstring: 'bc' asWideString - in: 'abcdef' - startingAt: 1 - matchTable: ((0 to: 255) - as: ByteArray). - self assert: position = 0. - - position := MiscPrimitivePluginTest new - findSubstring: 'bc' - in: 'abcdef' asWideString - startingAt: 1 - matchTable: ((0 to: 255) - as: ByteArray). - self assert: position = 0. - - "Older versions of the plugin produce incorrect results here" - position := MiscPrimitivePluginTest new - findSubstring: 'bc' asWideString - in: 'abcdef' asWideString - startingAt: 1 - matchTable: ((0 to: 255) - as: ByteArray). - self assert: position = 5 "Incorrect!!" - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testHashBytesStartingWith (in category 'testing') ----- - testHashBytesStartingWith - - | ba result | - ba := #[1 2 3 4 5 6 7 8 9]. - result := self hashBytes: ba startingWith: 12345. - self assert: result = 170953102 - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testIindexOfAsciiInStringStartingAt (in category 'testing') ----- - testIindexOfAsciiInStringStartingAt - - | position | - position := self indexOfAscii: 50 inString: '012345' startingAt: 1. - self assert: position = 3! Item was removed: - ----- Method: MiscPrimitivePluginTest>>testTranslateFromToTable (in category 'testing') ----- - testTranslateFromToTable - "Verify that primitive exists in the VM" - - | s t | - s := 'foo' copy. "copy so string is instantiated each time" - t := ByteArray withAll: ((1 to: 255) as: ByteArray). - self translate: s from: 1 to: 3 table: t. - self assert: s = 'gpp' - ! Item was removed: - ----- Method: MiscPrimitivePluginTest>>translate:from:to:table: (in category 'primitives') ----- - translate: aString from: start to: stop table: table - "translate the characters in the string by the given table, in place" - - <primitive: 'primitiveTranslateStringWithTable' module: 'MiscPrimitivePlugin'> - self primitiveFailed!

1 0

Re: [Vm-dev] Spur Object 64 bit format
by Igor Stasenko 14 Nov '13

14 Nov '13

IMO, reversing the tag value (0/1) doesn't changes much.. And camp division between two reminds me big vs little endian fights described by Jonathan Swift :) If we wanna gain more performance, i think we should put our attention to another place(s). On 14 November 2013 15:14, Jecel Assumpcao Jr. <jecel(a)merlintec.com> wrote: > > Eliot Miranda wrote: > > On Tue, Nov 12, 2013 at 3:56 AM, Clément Bera wrote: > > > By the way as you are talking about Immediate objects tags and Spur's > object > > > representation, I read on other VMs reports that it is faster in > overall performance > > > to have pointers tagged with the xxx1 and SmallIntegers tagged with > xxx0, > > > because SmallIntegers arithmetics is then much faster. > > > > I'm sure that was true 20 years ago when register operations were about > the > > same speed as memory operations. But now that memory operations are at > > least an order of magnitude slower I suspect that adjusting the tags > (all register > > operations) are in the noise. But I agree it *would* be interesting to > measure. > > Another issue is that the 680x0 had addressing modes that aren't common > on current processors. Having SmallIntegers be xxx0 means you don't have > to untag them to add or subtract and then retag them. Shifts and > multiplies require a single scaling factor beyond the basic operation. > But the xxx1 for OOPs introduce complications: if you are going to > access a fixed instance variable, for example instance variable 3, then > you can deal with it at assembly time: > > MOVE.L (-1+4*(3+1),A5),D1 ; where A5 is the OOP > > But if you are going to access a field in an Array then you have to do > it at runtime: > > MOVE.L (-1+4*FixedFields,A5,D2*4),D1 ; where A5 is the OOP and D2 is > the index > > While it takes several instructions to do the same thing on a current > processor, the 680X0 took quite a few clock cycles to execute the single > instruction above and it took several words in memory to encode it, so > the gain was mostly imaginary. > > -- Jecel > > -- Best regards, Igor Stasenko.

1 0

[commit][2812] fix typo
by commits＠squeakvm.org 14 Nov '13

14 Nov '13

Revision: 2812 Author: piumarta Date: 2013-11-13 21:44:19 -0800 (Wed, 13 Nov 2013) Log Message: ----------- fix typo Modified Paths: -------------- trunk/platforms/unix/cmake/Plugins.cmake Modified: trunk/platforms/unix/cmake/Plugins.cmake =================================================================== --- trunk/platforms/unix/cmake/Plugins.cmake 2013-11-14 03:57:30 UTC (rev 2811) +++ trunk/platforms/unix/cmake/Plugins.cmake 2013-11-14 05:44:19 UTC (rev 2812) @@ -1,6 +1,6 @@ # Figure out which plugins to build and create a configuration for each. # -# Last edited: 2013-11-13 19:43:20 by piumarta on emilia +# Last edited: 2013-11-13 21:43:50 by piumarta on emilia IF (EXISTS ${bld}/plugins.int) FILE (STRINGS ${bld}/plugins.int plugins_int) @@ -30,7 +30,7 @@ IF (EXISTS ${bld}/plugins.exc) FILE (STRINGS ${bld}/plugins.exc plugins_exc) -IF (EXISTS ${config}/plugins.exc) +ELSEIF (EXISTS ${config}/plugins.exc) FILE (STRINGS ${config}/plugins.exc plugins_exc) ELSEIF (EXISTS ${src}/plugins.exc) FILE (STRINGS ${src}/plugins.exc plugins_exc)

1 0

[commit][2811] add latest changes
by commits＠squeakvm.org 14 Nov '13

14 Nov '13

Revision: 2811 Author: piumarta Date: 2013-11-13 19:57:30 -0800 (Wed, 13 Nov 2013) Log Message: ----------- add latest changes Modified Paths: -------------- trunk/platforms/unix/ChangeLog Modified: trunk/platforms/unix/ChangeLog =================================================================== --- trunk/platforms/unix/ChangeLog 2013-11-14 03:54:12 UTC (rev 2810) +++ trunk/platforms/unix/ChangeLog 2013-11-14 03:57:30 UTC (rev 2811) @@ -1,3 +1,16 @@ +2013-11-13 Ian Piumarta <com -dot- gmail -at- piumarta (backwards)> + + * cmake/Plugins.cmake: Look for plugins.{int,ext,exc} in ${bld}, + ${config} and then ${src}. Make parsing of their contents more + robust. + + * cmake/configure: Fix handling of --src option. + + * cmake/squeak.in: Disable debugging messages. Run default VM + with any given args if image check fails. + + * vm/build.cmake: Use ckformat.c from generated sources. + 2013-11-11 Ian Piumarta <com -dot- gmail -at- piumarta (backwards)> * cmake/configure: Default generated source locations are next to

1 0

← Newer
1
2
3
4
5
6
7
8
...
11
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev November 2013