Vm-dev January 2017

vm-dev@lists.squeakfoundation.org

30 participants
136 discussions

[OpenSmalltalk/opensmalltalk-vm] a22e78: updated sista sources
by GitHub 05 Jan '17

05 Jan '17

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: a22e78688684215e7e6c3c6105722066fd00d052 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/a22e78688684215e7e… Author: Clement Bera <clementbera(a)Clements-MacBook-Pro.local> Date: 2017-01-05 (Thu, 05 Jan 2017) Changed paths: M spursistasrc/vm/cogit.h M spursistasrc/vm/cogitARMv5.c M spursistasrc/vm/cogitIA32.c M spursistasrc/vm/cogitMIPSEL.c M spursistasrc/vm/cogmethod.h M spursistasrc/vm/cointerp.c M spursistasrc/vm/cointerp.h M spursistasrc/vm/gcc3x-cointerp.c M spursistasrc/vm/interp.h M spursistasrc/vm/vmCallback.h Log Message: ----------- updated sista sources

1 0

Lowcode and x64
by Nicolas Cellier 05 Jan '17

05 Jan '17

Hi Ronie, >From my understanding, following code cannot work in x64 because registers are overwritten while marshalling arguments: generateLowcodeObjectTrampolines ... snip ... ceInstantiateClassIndexableSizeTrampoline := cogit genTrampolineFor: #instantiateClass:indexableSize: called: 'ceInstantiateClassIndexableSizeTrampoline' arg: ReceiverResultReg arg: Arg0Reg result: TempReg. The first arg ReceiverResultReg (RDX) will overwrite Arg0Reg (RDI) before Arg0Reg is copied to Arg1Reg (RSI)... See genMarshallNArgs:arg:arg:arg:arg: and carefully read the comment for the x64 flavour, it's scary ;) Cheers

2 1

VM Maker: VMMaker.oscog-rsf.2072.mcz
by commits＠source.squeak.org 05 Jan '17

05 Jan '17

Ronie Salgado Faila uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-rsf.2072.mcz ==================== Summary ==================== Name: VMMaker.oscog-rsf.2072 Author: rsf Time: 4 January 2017, 11:19:12.905175 pm UUID: a71106f7-964a-4165-bd14-cd8b52ca1acf Ancestors: VMMaker.oscog-eem.2071 Fixing some compilation warnings. Fixing the order of the arguments of some trampolines. Fixing the computation of the numTrampolines to return values according to the LowcodeVM flag. Added a hack in CogObjectRepresentationForSpur to always add the NumStoreTrampolines count. The generated NumTrampolines C define is just a constant, which does not take into account if -DIMMUTABILITY was passed to the compiler, which happens with the PharoVM. =============== Diff against VMMaker.oscog-eem.2071 =============== Item was changed: ----- Method: CogBytecodeDescriptor class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a BytecodeDescriptor struct." "With hasIRC there are 9 flag bits. Excluding hasIRC in non-Newspeak VMs keeps the descriptor compact." (NewspeakVM ifTrue: [self instVarNames] ifFalse: [self instVarNames copyWithout: 'hasIRC']) do: [:ivn| aBinaryBlock value: ivn value: (ivn caseOf: { ['generator'] -> [#('sqInt (*' ')(void)')]. + ['spanFunction'] -> [#('sqInt NoDbgRegParms (*' ')(struct _BytecodeDescriptor *,sqInt,sqInt,sqInt)')]. + ['needsFrameFunction'] -> [#('sqInt NoDbgRegParms (*' ')(sqInt)')]. - ['spanFunction'] -> [#('sqInt (*' ')(struct _BytecodeDescriptor *,sqInt,sqInt,sqInt)')]. - ['needsFrameFunction'] -> [#('sqInt (*' ')(sqInt)')]. ['numBytes'] -> ['unsigned char']. ['stackDelta'] -> ['signed char']. ['opcode'] -> ['unsigned char'] } otherwise: [#('unsigned' ' : 1')])]! Item was changed: ----- Method: CogObjectRepresentation>>genDoubleComparison:invert: (in category 'primitive generators') ----- genDoubleComparison: jumpOpcodeGenerator invert: invertComparison <option: #DPFPReg0> + <var: #jumpOpcodeGenerator declareC: 'AbstractInstruction * NoDbgRegParms (*jumpOpcodeGenerator)(void *)'> - <var: #jumpOpcodeGenerator declareC: 'AbstractInstruction *(*jumpOpcodeGenerator)(void *)'> | jumpFail jumpImmediate jumpNonInt jumpCond compare | <var: #jumpImmediate type: #'AbstractInstruction *'> <var: #jumpNonInt type: #'AbstractInstruction *'> <var: #jumpCond type: #'AbstractInstruction *'> <var: #compare type: #'AbstractInstruction *'> <var: #jumpFail type: #'AbstractInstruction *'> cogit processorHasDoublePrecisionFloatingPointSupport ifFalse: [^UnimplementedPrimitive]. cogit genLoadArgAtDepth: 0 into: Arg0Reg. self genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0. jumpImmediate := self genJumpImmediate: Arg0Reg. self genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg. self genCmpClassFloatCompactIndexR: SendNumArgsReg. jumpFail := cogit JumpNonZero: 0. self genGetDoubleValueOf: Arg0Reg into: DPFPReg1. invertComparison "May need to invert for NaNs" ifTrue: [compare := cogit CmpRd: DPFPReg0 Rd: DPFPReg1] ifFalse: [compare := cogit CmpRd: DPFPReg1 Rd: DPFPReg0]. jumpCond := cogit perform: jumpOpcodeGenerator with: 0. "FP jumps are a little weird" cogit genMoveFalseR: ReceiverResultReg. cogit genPrimReturn. jumpCond jmpTarget: (cogit genMoveTrueR: ReceiverResultReg). cogit genPrimReturn. jumpImmediate jmpTarget: cogit Label. self maybeGenConvertIfSmallFloatIn: Arg0Reg scratchReg: TempReg into: DPFPReg1 andJumpTo: compare. self smallIntegerIsOnlyImmediateType ifFalse: [jumpNonInt := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg]. self genConvertSmallIntegerToIntegerInReg: Arg0Reg. cogit ConvertR: Arg0Reg Rd: DPFPReg1. cogit Jump: compare. jumpFail jmpTarget: cogit Label. self smallIntegerIsOnlyImmediateType ifFalse: [jumpNonInt jmpTarget: jumpFail getJmpTarget]. ^CompletePrimitive! Item was changed: ----- Method: CogObjectRepresentation>>genLcByteSizeOf:to: (in category 'inline primitive support') ----- genLcByteSizeOf: oop to: resultRegister <option: #LowcodeVM> "TODO: Optimize this one avoiding the trampoline" + oop ~= Arg0Reg ifTrue: [cogit MoveR: oop R: Arg0Reg ]. - oop ~= ReceiverResultReg ifTrue: [cogit MoveR: oop R: ReceiverResultReg ]. cogit CallRT: ceByteSizeOfTrampoline. cogit MoveR: TempReg R: resultRegister. cogit ssPushNativeRegister: resultRegister.! Item was changed: ----- Method: CogObjectRepresentation>>genLcInstantiateOop:constantIndexableSize: (in category 'inline primitive support') ----- genLcInstantiateOop: classOop constantIndexableSize: indexableSize <option: #LowcodeVM> + classOop ~= Arg0Reg ifTrue: [cogit MoveR: classOop R: Arg0Reg]. + cogit MoveCq: indexableSize R: Arg1Reg. - classOop ~= ReceiverResultReg ifTrue: [cogit MoveR: classOop R: ReceiverResultReg]. - cogit MoveCq: indexableSize R: Arg0Reg. cogit CallRT: ceInstantiateClassIndexableSizeTrampoline. cogit MoveR: TempReg R: classOop. cogit ssPushRegister: classOop.! Item was changed: ----- Method: CogObjectRepresentation>>genLcInstantiateOop:indexableSize: (in category 'inline primitive support') ----- genLcInstantiateOop: classOop indexableSize: indexableSize <option: #LowcodeVM> + classOop ~= Arg0Reg ifTrue: [ + indexableSize = Arg0Reg ifTrue: [ - classOop ~= ReceiverResultReg ifTrue: [ - indexableSize = ReceiverResultReg ifTrue: [ cogit MoveR: indexableSize R: TempReg. ]. + cogit MoveR: classOop R: Arg0Reg - cogit MoveR: classOop R: ReceiverResultReg ]. + indexableSize ~= Arg1Reg ifTrue: [ + indexableSize = Arg0Reg ifTrue: [ + cogit MoveR: TempReg R: Arg1Reg. - indexableSize ~= Arg0Reg ifTrue: [ - indexableSize = ReceiverResultReg ifTrue: [ - cogit MoveR: TempReg R: Arg0Reg. ] ifFalse: [ + cogit MoveR: indexableSize R: Arg1Reg. - cogit MoveR: indexableSize R: Arg0Reg. ] ]. cogit CallRT: ceInstantiateClassIndexableSizeTrampoline. cogit MoveR: TempReg R: classOop. cogit ssPushRegister: classOop.! Item was changed: ----- Method: CogObjectRepresentation>>genLcPointerToOop:class: (in category 'inline primitive support') ----- genLcPointerToOop: pointer class: pointerClass <option: #LowcodeVM> cogit PushR: pointer. + cogit annotate: (cogit MoveCw: pointerClass R: Arg0Reg) objRef: pointerClass. + cogit MoveCq: BytesPerOop R: Arg1Reg. - cogit annotate: (cogit MoveCw: pointerClass R: ReceiverResultReg) objRef: pointerClass. - cogit MoveCq: BytesPerOop R: Arg0Reg. cogit CallRT: ceInstantiateClassIndexableSizeTrampoline. cogit PopR: pointer. cogit MoveR: pointer Mw: BaseHeaderSize r: TempReg. cogit MoveR: TempReg R: pointer. cogit ssPushRegister: pointer.! Item was changed: ----- Method: CogObjectRepresentation>>genSmallIntegerComparison:orDoubleComparison:invert: (in category 'primitive generators') ----- genSmallIntegerComparison: jumpOpcode orDoubleComparison: jumpFPOpcodeGenerator invert: invertComparison "Stack looks like return address" | jumpNonInt jumpFail jumpCond r | + <var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction * NoDbgRegParms (*jumpFPOpcodeGenerator)(void *)'> - <var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction *(*jumpFPOpcodeGenerator)(void *)'> <var: #jumpNonInt type: #'AbstractInstruction *'> <var: #jumpCond type: #'AbstractInstruction *'> <var: #jumpFail type: #'AbstractInstruction *'> r := self genSmallIntegerComparison: jumpOpcode. r < 0 ifTrue: [^r]. self cppIf: #DPFPReg0 defined ifTrue: "Fall through on non-SmallInteger argument. Argument may be a Float : let us check or fail" [self smallIntegerIsOnlyImmediateType ifFalse: [jumpNonInt := self genJumpImmediate: Arg0Reg]. self genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg. self genCmpClassFloatCompactIndexR: SendNumArgsReg. jumpFail := cogit JumpNonZero: 0. "It was a Float, so convert the receiver to double and perform the operation" self genConvertSmallIntegerToIntegerInReg: ReceiverResultReg. cogit ConvertR: ReceiverResultReg Rd: DPFPReg0. self genGetDoubleValueOf: Arg0Reg into: DPFPReg1. invertComparison "May need to invert for NaNs" ifTrue: [cogit CmpRd: DPFPReg0 Rd: DPFPReg1] ifFalse: [cogit CmpRd: DPFPReg1 Rd: DPFPReg0]. jumpCond := cogit perform: jumpFPOpcodeGenerator with: 0. "FP jumps are a little weird" cogit genMoveFalseR: ReceiverResultReg. cogit genPrimReturn. jumpCond jmpTarget: (cogit genMoveTrueR: ReceiverResultReg). cogit genPrimReturn. self smallIntegerIsOnlyImmediateType ifTrue: [jumpFail jmpTarget: cogit Label] ifFalse: [jumpNonInt jmpTarget: (jumpFail jmpTarget: cogit Label)]]. ^CompletePrimitive! Item was changed: ----- Method: CogObjectRepresentation>>generateLowcodeObjectTrampolines (in category 'initialization') ----- generateLowcodeObjectTrampolines <option: #LowcodeVM> ceFloatObjectOfTrampoline := cogit genTrampolineFor: #floatObjectOf: called: 'ceFloatObjectOfTrampoline' floatArg: DPFPReg0 result: TempReg. ceFloatValueOfTrampoline := cogit genTrampolineFor: #floatValueOf: called: 'ceFloatValueOfTrampoline' arg: ReceiverResultReg floatResult: DPFPReg0. ceInstantiateClassIndexableSizeTrampoline := cogit genTrampolineFor: #instantiateClass:indexableSize: called: 'ceInstantiateClassIndexableSizeTrampoline' - arg: ReceiverResultReg arg: Arg0Reg + arg: Arg1Reg result: TempReg. ceInstantiateClassTrampoline := cogit genTrampolineFor: #instantiateClass:indexableSize: called: 'ceInstantiateClassTrampoline' arg: ReceiverResultReg arg: 0 result: TempReg. ceByteSizeOfTrampoline := cogit genTrampolineFor: #byteSizeOf: called: 'ceByteSizeOfTrampoline' - arg: ReceiverResultReg arg: Arg0Reg result: TempReg. BytesPerOop = 4 ifTrue: [ cePositive64BitIntegerTrampoline := cogit genTrampolineFor: #positive64BitIntegerFor: called: 'cePositive64BitIntegerTrampoline' arg: ReceiverResultReg arg: Arg0Reg result: TempReg. cePositive64BitValueOfTrampoline := cogit genTrampolineFor: #positive64BitValueOf: called: 'cePositive64BitValueOfTrampoline' arg: ReceiverResultReg result: TempReg result: Arg0Reg. ceSigned64BitIntegerTrampoline := cogit genTrampolineFor: #signed64BitIntegerFor: called: 'ceSigned64BitIntegerTrampoline' arg: ReceiverResultReg arg: Arg0Reg result: TempReg. ceSigned64BitValueOfTrampoline := cogit genTrampolineFor: #signed64BitValueOf: called: 'ceSigned64BitValueOfTrampoline' arg: ReceiverResultReg result: TempReg result: Arg0Reg. ] ifFalse: [ cePositive64BitIntegerTrampoline := cogit genTrampolineFor: #positive64BitIntegerFor: called: 'cePositive64BitIntegerTrampoline' arg: ReceiverResultReg result: TempReg. cePositive64BitValueOfTrampoline := cogit genTrampolineFor: #positive64BitValueOf: called: 'cePositive64BitValueOfTrampoline' arg: ReceiverResultReg result: TempReg. ceSigned64BitIntegerTrampoline := cogit genTrampolineFor: #signed64BitIntegerFor: called: 'ceSigned64BitIntegerTrampoline' arg: ReceiverResultReg result: TempReg. ceSigned64BitValueOfTrampoline := cogit genTrampolineFor: #signed64BitValueOf: called: 'ceSigned64BitValueOfTrampoline' arg: ReceiverResultReg result: TempReg. ]! Item was changed: ----- Method: CogObjectRepresentationFor32BitSpur class>>numTrampolines (in category 'accessing') ----- numTrampolines + ^ super numTrampolines + (LowcodeVM ifTrue: [4] ifFalse: [0])! - ^ super numTrampolines + 4 "lowcode"! Item was changed: ----- Method: CogObjectRepresentationForSpur class>>numTrampolines (in category 'accessing') ----- numTrampolines ^super numTrampolines + (SistaV1BytecodeSet ifTrue: [8] "(small,large)x(method,block,fullBlock) context creation, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline" ifFalse: [6] "(small,large)x(method,block) context creation, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline") + + NumStoreTrampolines "FIXME: the generated C code does not take into account whether IMMUTABILITY is defined to one or zero" + "((initializationOptions at: #IMMUTABILITY ifAbsent: [false]) - + ((initializationOptions at: #IMMUTABILITY ifAbsent: [false]) ifTrue: [NumStoreTrampolines] + ifFalse: [0])"! - ifFalse: [0])! Item was changed: ----- Method: CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in category 'initialization') ----- generateObjectRepresentationTrampolines "Do the store check. Answer the argument for the benefit of the code generator; ReceiverResultReg may be caller-saved and hence smashed by this call. Answering it allows the code generator to reload ReceiverResultReg cheaply. In Spur the only thing we leave to the run-time is adding the receiver to the remembered set and setting its isRemembered bit." self cppIf: IMMUTABILITY ifTrue: [self cCode: [] inSmalltalk: [ceStoreTrampolines := CArrayAccessor on: (Array new: NumStoreTrampolines)]. 0 to: NumStoreTrampolines - 1 do: [:instVarIndex | ceStoreTrampolines at: instVarIndex put: (self genStoreTrampolineCalled: (cogit trampolineName: 'ceStoreTrampoline' numArgs: instVarIndex limit: NumStoreTrampolines - 2) instVarIndex: instVarIndex)]]. ceStoreCheckTrampoline := self genStoreCheckTrampoline. ceStoreCheckContextReceiverTrampoline := self genStoreCheckContextReceiverTrampoline. ceScheduleScavengeTrampoline := cogit genTrampolineFor: #ceScheduleScavenge called: 'ceScheduleScavengeTrampoline' regsToSave: CallerSavedRegisterMask. ceSmallActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: false inBlock: 0 called: 'ceSmallMethodContext'. ceSmallActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: InVanillaBlock called: 'ceSmallBlockContext'. SistaV1BytecodeSet ifTrue: [ceSmallActiveContextInFullBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: InFullBlock called: 'ceSmallFullBlockContext']. ceLargeActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: true inBlock: 0 called: 'ceLargeMethodContext'. ceLargeActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: InVanillaBlock called: 'ceLargeBlockContext'. SistaV1BytecodeSet ifTrue: [ceLargeActiveContextInFullBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: InFullBlock called: 'ceLargeFullBlockContext']. LowcodeVM ifTrue: [ self generateLowcodeObjectTrampolines ]! Item was changed: ----- Method: CogSimStackNativeEntry>>stackSpillSize (in category 'accessing') ----- stackSpillSize <returnTypeC: #sqInt> type caseOf: { [SSConstantInt64] -> [ ^ 8 ]. [SSConstantFloat64] -> [ ^ 8 ]. [SSRegisterDoubleFloat] -> [ ^ 8 ]. [SSRegisterPair] -> [ ^ 8 ]. [SSSpillFloat64] -> [ ^ 8 ]. [SSSpillInt64] -> [ ^ 8 ]. + } otherwise: [^ BytesPerOop ]. + ^ 0! - } otherwise: [^ BytesPerOop ]! Item was changed: ----- Method: Cogit class>>numTrampolines (in category 'accessing') ----- numTrampolines + ^38 "30 + 4 each for self and super sends" + (LowcodeVM ifTrue: [1] ifFalse: [0]) - ^38 "30 + 4 each for self and super sends" "self withAllSubclasses collect: [:c| {c. (c instVarNames select: [:ea| ea beginsWith: 'ce']) size}]"! Item was changed: ----- Method: Cogit>>cogMNUPICSelector:receiver:methodOperand:numArgs: (in category 'in-line cacheing') ----- cogMNUPICSelector: selector receiver: rcvr methodOperand: methodOperand numArgs: numArgs <api> "Attempt to create a one-case PIC for an MNU. The tag for the case is at the send site and so doesn't need to be generated." <returnTypeC: #'CogMethod *'> | startAddress | ((objectMemory isYoung: selector) or: [(objectRepresentation inlineCacheTagForInstance: rcvr) = self picAbortDiscriminatorValue]) ifTrue: [^0]. coInterpreter compilationBreak: selector point: (objectMemory numBytesOf: selector) isMNUCase: true. self assert: endCPICCase0 notNil. "get memory in the code zone for the CPIC; if that fails we return an error code for the sender to use to work out how to blow up" startAddress := methodZone allocate: closedPICSize. startAddress = 0 ifTrue: [coInterpreter callForCogCompiledCodeCompaction. ^0]. "memcpy the prototype across to our allocated space; because anything else would be silly" + objectMemory + mem: (self cCoerceSimple: startAddress to: #'CogMethod *') + cp: (self cCoerceSimple: cPICPrototype to: #'CogMethod *') + y: closedPICSize. - objectMemory mem: startAddress cp: cPICPrototype y: closedPICSize. self configureMNUCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *') methodOperand: methodOperand numArgs: numArgs delta: startAddress - cPICPrototype. ^self fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *') numArgs: numArgs numCases: 1 hasMNUCase: true selector: selector ! Item was changed: ----- Method: Cogit>>cogPICSelector:numArgs:Case0Method:Case1Method:tag:isMNUCase: (in category 'in-line cacheing') ----- cogPICSelector: selector numArgs: numArgs Case0Method: case0CogMethod Case1Method: case1MethodOrNil tag: case1Tag isMNUCase: isMNUCase "Attempt to create a two-case PIC for case0CogMethod and case1Method,case1Tag. The tag for case0CogMethod is at the send site and so doesn't need to be generated. case1Method may be any of - a Cog method; link to its unchecked entry-point - a CompiledMethod; link to ceInterpretMethodFromPIC: - a CompiledMethod; link to ceMNUFromPICMNUMethod:receiver:" <var: #case0CogMethod type: #'CogMethod *'> <returnTypeC: #'CogMethod *'> | startAddress | (objectMemory isYoung: selector) ifTrue: [^self cCoerceSimple: YoungSelectorInPIC to: #'CogMethod *']. coInterpreter compilationBreak: selector point: (objectMemory numBytesOf: selector) isMNUCase: isMNUCase. "get memory in the code zone for the CPIC; if that fails we return an error code for the sender to use to work out how to blow up" startAddress := methodZone allocate: closedPICSize. startAddress = 0 ifTrue: [^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *']. "memcpy the prototype across to our allocated space; because anything else would be silly" + objectMemory + mem: (self cCoerceSimple: startAddress to: #'CogMethod *') + cp: (self cCoerceSimple: cPICPrototype to: #'CogMethod *') + y: closedPICSize. - objectMemory mem: startAddress cp: cPICPrototype y: closedPICSize. self configureCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *') Case0: case0CogMethod Case1Method: case1MethodOrNil tag: case1Tag isMNUCase: isMNUCase numArgs: numArgs delta: startAddress - cPICPrototype . ^self fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *') numArgs: numArgs numCases: 2 hasMNUCase: isMNUCase selector: selector ! Item was changed: ----- Method: Cogit>>generateRunTimeTrampolines (in category 'initialization') ----- generateRunTimeTrampolines "Generate the run-time entries at the base of the native code zone and update the base." ceSendMustBeBooleanAddFalseTrampoline := self genMustBeBooleanTrampolineFor: objectMemory falseObject called: 'ceSendMustBeBooleanAddFalseTrampoline'. ceSendMustBeBooleanAddTrueTrampoline := self genMustBeBooleanTrampolineFor: objectMemory trueObject called: 'ceSendMustBeBooleanAddTrueTrampoline'. ceNonLocalReturnTrampoline := self genNonLocalReturnTrampoline. ceCheckForInterruptTrampoline := self genCheckForInterruptsTrampoline. "Neither of the context inst var access trampolines save registers. Their operation could cause arbitrary update of stack frames, so the assumption is that callers flush the stack before calling the context inst var access trampolines, and that everything except the result is dead afterwards." ceFetchContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar: called: 'ceFetchContextInstVarTrampoline' arg: ReceiverResultReg arg: SendNumArgsReg result: SendNumArgsReg. ceStoreContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:value: called: 'ceStoreContextInstVarTrampoline' arg: ReceiverResultReg arg: SendNumArgsReg arg: ClassReg result: ReceiverResultReg. "to keep ReceiverResultReg live.". ceCannotResumeTrampoline := self genTrampolineFor: #ceCannotResume called: 'ceCannotResumeTrampoline'. "These two are unusual; they are reached by return instructions." ceBaseFrameReturnTrampoline := self genReturnTrampolineFor: #ceBaseFrameReturn: called: 'ceBaseFrameReturnTrampoline' arg: ReceiverResultReg. ceReturnToInterpreterTrampoline := self genReturnTrampolineFor: #ceReturnToInterpreter: called: 'ceReturnToInterpreterTrampoline' arg: ReceiverResultReg. ceMallocTrampoline := self genTrampolineFor: #ceMalloc: called: 'ceMallocTrampoline' arg: ReceiverResultReg result: TempReg. ceFreeTrampoline := self genTrampolineFor: #ceFree: called: 'ceFreeTrampoline' arg: ReceiverResultReg. LowcodeVM ifTrue: [ ceFFICalloutTrampoline := self genFFICalloutTrampoline. ]! Item was changed: ----- Method: VMMaker class>>generateSqueakSpurLowcodeCogVM (in category 'configurations') ----- generateSqueakSpurLowcodeCogVM "No primitives since we can use those for the Cog VM" ^VMMaker generate: CoInterpreter and: StackToRegisterMappingCogit with: #(ObjectMemory Spur32BitCoMemoryManager SistaVM true LowcodeVM true MULTIPLEBYTECODESETS true bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid) to: (FileDirectory default pathFromURI: self sourceTree, '/spurlowcodesrc') platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms') including:#()!

1 0

VM Maker: VMMaker.oscog-eem.2071.mcz
by commits＠source.squeak.org 05 Jan '17

05 Jan '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2071.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2071 Author: eem Time: 4 January 2017, 5:40:04.754725 pm UUID: f96e66a4-24c6-4c44-925c-116a07bf1d27 Ancestors: VMMaker.oscog-eem.2070 Slang: To make code more readable when implementing SpurPlanningCompactor, markedBitShift was made a macro. That caused Slang to generate a bogus versuon of nullHeaderForMachineCodeMethod because it could no longer infer the type of the shift operand for the marked bit, and so generated 1UL << 55 instead of 1ULL << 55. Consequently nullHeaderForMachineCodeMethod answered 0 (!!). Add TParseNode>>constantNumbericValueIfAtAllPossibleOrNilIn: that provides a vaue for defines and methods answerinf constants as well as explicit constants and use it in generateShiftLeft:on:indent:, hence fixing nullHeaderForMachineCodeMethod. =============== Diff against VMMaker.oscog-eem.2070 =============== Item was changed: ----- Method: CCodeGenerator>>generateShiftLeft:on:indent: (in category 'C translation') ----- generateShiftLeft: msgNode on: aStream indent: level "Generate a C bitShift. If we can determine the result would overflow the word size, cast to a long integer." | rcvr arg castToLong type mustCastBackToSign mustCastToUnsigned canSuffixTheConstant typeIsUnsigned | rcvr := msgNode receiver. arg := msgNode args first. castToLong := false. + (rcvr constantNumbericValueIfAtAllPossibleOrNilIn: self) ifNotNil: - rcvr constantNumbericValueOrNil ifNotNil: [:rcvrVal | + (arg constantNumbericValueIfAtAllPossibleOrNilIn: self) - arg constantNumbericValueOrNil ifNil: [castToLong := vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]] ifNotNil: [:argVal | | valueBeyondInt | valueBeyondInt := 1 bitShift: 32. "The default type of const << N is int." castToLong := rcvrVal < valueBeyondInt and: [(rcvrVal bitShift: argVal) >= valueBeyondInt]]]. canSuffixTheConstant := rcvr isConstant and: [rcvr name isEmpty and: [rcvr value >= 0]]. canSuffixTheConstant ifTrue: [aStream nextPutAll: (self cLiteralForUnsignedInteger: rcvr value longlong: castToLong). aStream nextPutAll: ' << '. self emitCExpression: arg on: aStream indent: level. ^self]. type := self typeFor: rcvr in: currentMethod. castToLong := castToLong and: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)]. typeIsUnsigned := type first = $u. mustCastToUnsigned := typeIsUnsigned not or: [castToLong or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)]]. mustCastBackToSign := typeIsUnsigned not. mustCastBackToSign ifTrue: [| promotedType | promotedType := castToLong ifTrue: [#sqLong] ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #sqInt) ifTrue: [#sqInt] ifFalse: [type]]. aStream nextPutAll: '(('; nextPutAll: promotedType; nextPut: $)]. mustCastToUnsigned ifTrue: [| unsigned | unsigned := castToLong ifTrue: [#usqLong] ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong) ifTrue: [#usqInt] ifFalse: [self unsignedTypeForIntegralType: type]]. aStream nextPutAll: '(('; nextPutAll: unsigned; nextPutAll: ')(']. self emitCExpression: rcvr on: aStream indent: level. mustCastToUnsigned ifTrue: [aStream nextPut: $)]. aStream nextPutAll: ' << '. self emitCExpression: arg on: aStream indent: level. mustCastToUnsigned ifTrue: [aStream nextPut: $)]. mustCastBackToSign ifTrue: [aStream nextPut: $)].! Item was added: + ----- Method: TConstantNode>>constantNumbericValueIfAtAllPossibleOrNilIn: (in category 'accessing') ----- + constantNumbericValueIfAtAllPossibleOrNilIn: aCCodeGen + "This is a version of constantNumbericValueOrNil for type checking rather than code generation. + It aims to yield a value if at all possible. This should /not/ be overridden in TDefineNode." + ^value isNumber ifTrue: [value]! Item was changed: + ----- Method: TConstantNode>>constantNumbericValueOrNil (in category 'accessing') ----- - ----- Method: TConstantNode>>constantNumbericValueOrNil (in category 'testing') ----- constantNumbericValueOrNil ^value isNumber ifTrue: [value]! Item was changed: + ----- Method: TDefineNode>>constantNumbericValueOrNil (in category 'accessing') ----- - ----- Method: TDefineNode>>constantNumbericValueOrNil (in category 'testing') ----- constantNumbericValueOrNil "Override so that named constants don't get elided." ^nil! Item was added: + ----- Method: TParseNode>>constantNumbericValueIfAtAllPossibleOrNilIn: (in category 'accessing') ----- + constantNumbericValueIfAtAllPossibleOrNilIn: aCCodeGen + "This is a version of constantNumbericValueOrNil for type checking rather than code generation. + It aims to yield a value if at all possible." + ^self constantNumbericValueOrNil! Item was changed: + ----- Method: TParseNode>>constantNumbericValueOrNil (in category 'accessing') ----- - ----- Method: TParseNode>>constantNumbericValueOrNil (in category 'testing') ----- constantNumbericValueOrNil ^nil! Item was added: + ----- Method: TSendNode>>constantNumbericValueIfAtAllPossibleOrNilIn: (in category 'accessing') ----- + constantNumbericValueIfAtAllPossibleOrNilIn: aCCodeGen + "This is a version of constantNumbericValueOrNil for type checking rather than code generation. + It aims to yield a value if at all possible." + (#(* // + - << >> bitAnd: bitOr: bitShift:) includes: selector) ifTrue: + [(receiver constantNumbericValueIfAtAllPossibleOrNilIn: aCCodeGen) ifNotNil: + [:rval| + (arguments first constantNumbericValueIfAtAllPossibleOrNilIn: aCCodeGen) ifNotNil: + [:aval| + ^rval perform: selector with: aval]]]. + ^(aCCodeGen anyMethodNamed: selector) ifNotNil: + [:m| + m isReturnConstant ifTrue: + [m statements last expression constantNumbericValueIfAtAllPossibleOrNilIn: aCCodeGen]]! Item was changed: + ----- Method: TSendNode>>constantNumbericValueOrNil (in category 'accessing') ----- - ----- Method: TSendNode>>constantNumbericValueOrNil (in category 'C code generation') ----- constantNumbericValueOrNil (#(* // + -) includes: selector) ifTrue: [receiver constantNumbericValueOrNil ifNotNil: [:rval| arguments first constantNumbericValueOrNil ifNotNil: [:aval| ^rval perform: selector with: aval]]]. ^nil!

1 0

VM Maker: VMMaker.oscog-eem.2070.mcz
by commits＠source.squeak.org 04 Jan '17

04 Jan '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2070.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2070 Author: eem Time: 4 January 2017, 2:28:39.632529 pm UUID: ada3d477-75ba-48e3-b468-2269b791f62b Ancestors: VMMaker.oscog-eem.2069 CoInterpreter: Make the stack depth check for abort sends consistent with normal sends. Add a stack chec for activating processes. Print non-local return info when there's an unwind to the transcript to aid debugging the wrong stack depth on some non-local returns issue. No longer halt on code compaction; its utility/annoyance ratio is now too small. =============== Diff against VMMaker.oscog-eem.2069 =============== Item was changed: ----- Method: CogVMSimulator>>ceSendAbort:to:numArgs: (in category 'trampolines') ----- ceSendAbort: selector to: rcvr numArgs: numArgs "self stringOf: selector" "self printOop: rcvr" self logSend: selector. cogit assertCStackWellAligned. + self maybeCheckStackDepth: numArgs + 1 + sp: stackPointer - self maybeCheckStackDepth: (selector = (objectMemory splObj: SelectorAboutToReturn) - ifTrue: [numArgs] - ifFalse: [numArgs + 1]) - sp: stackPointer + objectMemory wordSize pc: (stackPages longAt: stackPointer). ^super ceSendAbort: selector to: rcvr numArgs: numArgs! Item was changed: ----- Method: CogVMSimulator>>commenceCogCompiledCodeCompaction (in category 'cog jit support') ----- commenceCogCompiledCodeCompaction + "self halt." - self halt. ^super commenceCogCompiledCodeCompaction! Item was added: + ----- Method: CogVMSimulator>>externalAboutToReturn:through: (in category 'return bytecodes') ----- + externalAboutToReturn: resultOop through: aContext + self transcript ensureCr. + self print: 'externalAboutToReturn: '; printOopShortInner: resultOop; + print: ' through: '; printOopShortInner: aContext; + print: ' in '; printActivationNameFor: (self frameMethodObject: framePointer) + receiver: (self frameReceiver: framePointer) + isBlock: (self frameIsBlockActivation: framePointer) + firstTemporary: (self temporary: 0 in: framePointer); + cr. + ^super externalAboutToReturn: resultOop through: aContext! Item was added: + ----- Method: CogVMSimulator>>externalSetStackPageAndPointersForSuspendedContextOfProcess: (in category 'frame access') ----- + externalSetStackPageAndPointersForSuspendedContextOfProcess: aProcess + "Override to check stack depth (hence in the simulator only)." + super externalSetStackPageAndPointersForSuspendedContextOfProcess: aProcess. + (self isMachineCodeFrame: framePointer) ifTrue: + [self maybeCheckStackDepth: 0 + sp: stackPointer + pc: instructionPointer]!

1 0

Assert fails on non-local return
by Eliot Miranda 04 Jan '17

04 Jan '17

Hi Clément, Hi All, in debugging the SpurPlanningCompactor for the CoInterpreter I'm seeing a fair few stack depth check fails for non-local returns in Squeak trunk methods such as [] in SystemProgressMorph>nextSlotFor:, [] in HTTPSocket class>httpGet:args:user:passed: and [] in PackageInfo>changeRecordsForMethod:do:. Since these assert-fails happen in methods that are fully linked I know that the problem is /not/ the non-local return. For example, here's the code for a non-local return that fails the assert check at the end of the [] in SystemProgressMorph>nextSlotFor: 000db633: movl %edx, %esi : 89 D6 000db635: popl %edx : 5A 000db636: movl $0x00000c38, %ecx : B9 38 0C 00 00 000db63b: call .+0xfff31fe4 (0x0000d624=addMorphBack:@2C) : E8 E4 1F F3 FF IsSendCall addMorphBack: bc 205/206: 000db640: movl -32(%ebp), %edx : 8B 55 E0 000db643: call .+0xfff25b90 (0x000011d8=ceNonLocalReturnTrampoline) : E8 90 5B F2 FF IsRelativeCall: HasBytecodePC bc 208/209: Since the stack depth is checked when a send is linked we know that the stack depth was correct at 000db63b. And hence it's likely that the stack depth was correct when the non-local return trampoline was called soon afterwards. [I need to confirm this]. So this would imply that the stack depth is incorrect due to something else, and I suspect event checks on backward branches. This non-local return is in a loop. So its conceivable that the stack gets set incorrectly on some path through event checking. [The stack in this context is incorrect in having an extra copy of the loop index on the stack between the temp vars and the arguments to the thisContext aboutToReturn: result through: unwind. For now, this is just an observation, but it could be a serious bug and it would be nice to fix it I guess we should add some assert checks on stack depth for reentering loops, e.g. in a CoInterpreter override for externalSetStackPageAndPointersForSuspendedContextOfProcess: _,,,^..^,,,_ best, Eliot

1 0

VM Maker: VMMaker.oscog-eem.2069.mcz
by commits＠source.squeak.org 04 Jan '17

04 Jan '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2069.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2069 Author: eem Time: 4 January 2017, 9:16:54.512363 am UUID: f3417712-c17c-4755-92d6-f769cad5da06 Ancestors: VMMaker.oscog-eem.2068 Fix some memory access sends to self to be sends to objectMemory. =============== Diff against VMMaker.oscog-eem.2068 =============== Item was changed: ----- Method: CoInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') ----- unmarkAllFrames | thePage theFP methodField flags | <var: #thePage type: #'StackPage *'> <var: #theFP type: #'char *'> <inline: false> 0 to: numStackPages - 1 do: [:i| thePage := stackPages stackPageAt: i. (stackPages isFree: thePage) ifFalse: [theFP := thePage headFP. + [methodField := stackPages longAt: theFP + FoxMethod. - [methodField := self longAt: theFP + FoxMethod. methodField asUnsignedInteger < objectMemory startOfMemory ifTrue: [(methodField bitAnd: 4) ~= 0 ifTrue: [self longAt: theFP + FoxMethod put: methodField - 4]] ifFalse: + [flags := stackPages longAt: theFP + FoxIFrameFlags. - [flags := self longAt: theFP + FoxIFrameFlags. (flags bitAnd: 2) ~= 0 ifTrue: + [stackPages longAt: theFP + FoxIFrameFlags put: flags - 2]]. - [self longAt: theFP + FoxIFrameFlags put: flags - 2]]. (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]! Item was changed: ----- Method: CogVMSimulator>>clipboardRead:Into:At: (in category 'I/O primitives') ----- clipboardRead: sz Into: actualAddress At: zeroBaseIndex | str | str := Clipboard clipboardText. 1 to: sz do: + [:i | objectMemory byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]! - [:i | self byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]! Item was changed: ----- Method: CogVMSimulator>>printRumpCStackTo: (in category 'rump c stack') ----- printRumpCStackTo: address self assert: (self isOnRumpCStack: address). heapBase - objectMemory wordSize to: address by: objectMemory wordSize negated do: [:addr| + self printHex: addr; tab; printHex: (objectMemory longAt: addr); cr]! - self printHex: addr; tab; printHex: (self longAt: addr); cr]! Item was removed: - ----- Method: CogVMSimulator>>validOop: (in category 'testing') ----- - validOop: oop - " Return true if oop appears to be valid " - (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer" - (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address" - oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range" - "could test if within the first large freeblock" - (self longAt: oop) = 4 ifTrue: [^ false]. - (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object" - ^ true! Item was changed: ----- Method: InterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') ----- primitiveObjectPointsTo | rcvr thang lastField | thang := self stackTop. rcvr := self stackValue: 1. (objectMemory isIntegerObject: rcvr) ifTrue: [^self pop: 2 thenPushBool: false]. lastField := self lastPointerOf: rcvr. + objectMemory baseHeaderSize to: lastField by: objectMemory bytesPerOop do: - objectMemory baseHeaderSize to: lastField by: objectMemory wordSize do: [:i | + (objectMemory longAt: rcvr + i) = thang ifTrue: - (self longAt: rcvr + i) = thang ifTrue: [^self pop: 2 thenPushBool: true]]. self pop: 2 thenPushBool: false! Item was changed: ----- Method: InterpreterPrimitives>>sizeFieldOfAlien: (in category 'primitive support') ----- sizeFieldOfAlien: alienObj "Answer the first field of alienObj which is assumed to be an Alien of at least 8 bytes" <inline: true> + ^objectMemory longAt: alienObj + objectMemory baseHeaderSize! - ^self longAt: alienObj + objectMemory baseHeaderSize! Item was changed: ----- Method: InterpreterPrimitives>>startOfAlienData: (in category 'primitive support') ----- startOfAlienData: oop "Answer the start of the Alien's data or fail if oop is not an Alien." <api> <returnTypeC: #'void *'> (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifFalse: [self primitiveFailFor: PrimErrBadArgument. ^0]. ^self cCoerceSimple: ((self isDirectAlien: oop) ifTrue: [oop + objectMemory baseHeaderSize + objectMemory bytesPerOop] + ifFalse: [objectMemory longAt: oop + objectMemory baseHeaderSize + objectMemory bytesPerOop]) - ifFalse: [self longAt: oop + objectMemory baseHeaderSize + objectMemory bytesPerOop]) to: #'void *'! Item was removed: - ----- Method: InterpreterSimulator>>integerAt: (in category 'memory access') ----- - integerAt: byteAddress - "Note: Adjusted for Smalltalk's 1-based array indexing." - - ^memory integerAt: (byteAddress // 4) + 1! Item was removed: - ----- Method: InterpreterSimulator>>integerAt:put: (in category 'memory access') ----- - integerAt: byteAddress put: a32BitValue - "Note: Adjusted for Smalltalk's 1-based array indexing." - - ^memory integerAt: (byteAddress // 4) + 1 put: a32BitValue! Item was changed: ----- Method: StackInterpreter>>checkForLastObjectOverwrite (in category 'simulation') ----- checkForLastObjectOverwrite <doNotGenerate> | freeStart | checkAllocFiller ifTrue: [self assert: ((freeStart := objectMemory freeStart) >= objectMemory scavengeThreshold + or: [(objectMemory longAt: freeStart) = freeStart])]! - or: [(self longAt: freeStart) = freeStart])]! Item was changed: ----- Method: StackInterpreter>>createActualMessageTo: (in category 'message sending') ----- createActualMessageTo: lookupClass "Bundle up the selector, arguments and lookupClass into a Message object. In the process it pops the arguments off the stack, and pushes the message object. This can then be presented as the argument of e.g. #doesNotUnderstand:" | argumentArray message | <inline: false> "This is a useful break-point" self assert: ((objectMemory isImmediate: messageSelector) or: [objectMemory addressCouldBeObj: messageSelector]). self mnuBreakpoint: messageSelector receiver: nil. objectMemory hasSpurMemoryManagerAPI ifTrue: [argumentArray := objectMemory eeInstantiateSmallClassIndex: ClassArrayCompactIndex format: objectMemory arrayFormat numSlots: argumentCount. message := objectMemory eeInstantiateSmallClassIndex: ClassMessageCompactIndex format: objectMemory nonIndexablePointerFormat numSlots: MessageLookupClassIndex + 1] ifFalse: [argumentArray := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassArray) numSlots: argumentCount. message := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassMessage) numSlots: MessageLookupClassIndex + 1]. "Since the array is new can use unchecked stores." (argumentCount - 1) * objectMemory bytesPerOop to: 0 by: objectMemory bytesPerOop negated do: [:i| + objectMemory longAt: argumentArray + objectMemory baseHeaderSize + i put: self popStack]. - self longAt: argumentArray + objectMemory baseHeaderSize + i put: self popStack]. "Since message is new can use unchecked stores." objectMemory storePointerUnchecked: MessageSelectorIndex ofObject: message withValue: messageSelector; storePointerUnchecked: MessageArgumentsIndex ofObject: message withValue: argumentArray; storePointerUnchecked: MessageLookupClassIndex ofObject: message withValue: lookupClass. self push: message. argumentCount := 1! Item was changed: ----- Method: StackInterpreter>>stringOf: (in category 'debug support') ----- stringOf: oop <doNotGenerate> | size long nLongs chars | ^ String streamContents: [:strm | size := 128 min: (self stSizeOf: oop). nLongs := size-1//objectMemory wordSize+1. 1 to: nLongs do: + [:i | long := objectMemory longAt: oop + objectMemory baseHeaderSize + (i-1*objectMemory wordSize). - [:i | long := self longAt: oop + objectMemory baseHeaderSize + (i-1*objectMemory wordSize). chars := self charsOfLong: long. strm nextPutAll: (i=nLongs ifTrue: [chars copyFrom: 1 to: size-1\\objectMemory wordSize+1] ifFalse: [chars])]]! Item was changed: ----- Method: StackInterpreter>>updateObjectsPostByteSwap (in category 'image save/restore') ----- updateObjectsPostByteSwap "Byte-swap the words of all bytes objects in the image, including Strings, ByteArrays, and CompiledMethods. This returns these objects to their original byte ordering after blindly byte-swapping the entire image. For compiled methods, byte-swap only their bytecodes part. Ensure floats are in platform-order." | swapFloatWords | swapFloatWords := objectMemory vmEndianness ~= imageFloatsBigEndian. self assert: ClassFloatCompactIndex ~= 0. objectMemory allObjectsDo: [:oop| | fmt wordAddr methodHeader temp | fmt := objectMemory formatOf: oop. fmt >= self firstByteFormat ifTrue: "oop contains bytes" [wordAddr := oop + objectMemory baseHeaderSize. fmt >= self firstCompiledMethodFormat ifTrue: "compiled method; start after methodHeader and literals" + [methodHeader := objectMemory longAt: oop + objectMemory baseHeaderSize. - [methodHeader := self longAt: oop + objectMemory baseHeaderSize. wordAddr := wordAddr + (((objectMemory literalCountOfMethodHeader: methodHeader) + LiteralStart) * objectMemory bytesPerOop)]. objectMemory reverseBytesFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)]. fmt = self firstLongFormat ifTrue: "Bitmap, Float etc" [(swapFloatWords and: [(objectMemory compactClassIndexOf: oop) = ClassFloatCompactIndex]) ifTrue: + [temp := objectMemory longAt: oop + objectMemory baseHeaderSize. + objectMemory longAt: oop + objectMemory baseHeaderSize put: (self longAt: oop + objectMemory baseHeaderSize + 4). + objectMemory longAt: oop + objectMemory baseHeaderSize + 4 put: temp] - [temp := self longAt: oop + objectMemory baseHeaderSize. - self longAt: oop + objectMemory baseHeaderSize put: (self longAt: oop + objectMemory baseHeaderSize + 4). - self longAt: oop + objectMemory baseHeaderSize + 4 put: temp] ifFalse: [(objectMemory hasSpurMemoryManagerAPI not and: [objectMemory wordSize = 8]) ifTrue: "Object contains 32-bit half-words packed into 64-bit machine words." [wordAddr := oop + objectMemory baseHeaderSize. objectMemory reverseWordsFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)]]]]! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') ----- primitiveObjectPointsTo "This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so. N.B. Works forrectly for cogged methods too." | rcvr thang header fmt numSlots methodHeader | thang := self stackTop. rcvr := self stackValue: 1. (objectMemory isImmediate: rcvr) ifTrue: [^self pop: 2 thenPushBool: false]. "Inlined version of lastPointerOf: for speed in determining if rcvr is a context." header := objectMemory baseHeader: rcvr. fmt := objectMemory formatOfHeader: header. (objectMemory isPointersFormat: fmt) ifTrue: [(fmt = objectMemory indexablePointersFormat and: [objectMemory isContextHeader: header]) ifTrue: [(self isMarriedOrWidowedContext: rcvr) ifTrue: [self externalWriteBackHeadFramePointers. (self isStillMarriedContext: rcvr) ifTrue: [^self pop: 2 thenPushBool: (self marriedContext: rcvr pointsTo: thang stackDeltaForCurrentFrame: 2)]]. "contexts end at the stack pointer" numSlots := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr)] ifFalse: [numSlots := objectMemory numSlotsOf: rcvr]] ifFalse: [fmt < objectMemory firstCompiledMethodFormat "no pointers" ifTrue: [^self pop: 2 thenPushBool: false]. "CompiledMethod: contains both pointers and bytes:" methodHeader := objectMemory methodHeaderOf: rcvr. methodHeader = thang ifTrue: [^self pop: 2 thenPushBool: true]. numSlots := (objectMemory literalCountOfMethodHeader: methodHeader) + LiteralStart]. self assert: numSlots - 1 * objectMemory bytesPerOop + objectMemory baseHeaderSize = (objectMemory lastPointerOf: rcvr). objectMemory baseHeaderSize to: numSlots - 1 * objectMemory bytesPerOop + objectMemory baseHeaderSize by: objectMemory bytesPerOop do: [:i| + (objectMemory longAt: rcvr + i) = thang ifTrue: - (self longAt: rcvr + i) = thang ifTrue: [^self pop: 2 thenPushBool: true]]. self pop: 2 thenPushBool: false! Item was changed: ----- Method: StackInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') ----- unmarkAllFrames | thePage theFP flags | <var: #thePage type: #'StackPage *'> <var: #theFP type: #'char *'> <inline: false> 0 to: numStackPages - 1 do: [:i| thePage := stackPages stackPageAt: i. (stackPages isFree: thePage) ifFalse: [theFP := thePage headFP. + [flags := objectMemory longAt: theFP + FoxFrameFlags. - [flags := self longAt: theFP + FoxFrameFlags. (flags bitAnd: 2) ~= 0 ifTrue: + [objectMemory longAt: theFP + FoxFrameFlags put: flags - 2]. - [self longAt: theFP + FoxFrameFlags put: flags - 2]. (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]! Item was changed: ----- Method: StackInterpreterSimulator>>clipboardRead:Into:At: (in category 'I/O primitives') ----- clipboardRead: sz Into: actualAddress At: zeroBaseIndex | str | str := Clipboard clipboardText. 1 to: sz do: + [:i | objectMemory byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]! - [:i | self byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]! Item was removed: - ----- Method: StackInterpreterSimulator>>integerAt: (in category 'memory access') ----- - integerAt: byteAddress - "Note: Adjusted for Smalltalk's 1-based array indexing." - - self deprecated. - ^objectMemory memory integerAt: (byteAddress // 4) + 1! Item was removed: - ----- Method: StackInterpreterSimulator>>integerAt:put: (in category 'memory access') ----- - integerAt: byteAddress put: a32BitValue - "Note: Adjusted for Smalltalk's 1-based array indexing." - - self deprecated. - ^objectMemory memory integerAt: (byteAddress // 4) + 1 put: a32BitValue! Item was removed: - ----- Method: StackInterpreterSimulator>>validOop: (in category 'testing') ----- - validOop: oop - " Return true if oop appears to be valid " - (oop bitAnd: 1) = 1 ifTrue: [^ true]. "Integer" - (oop bitAnd: 3) = 0 ifFalse: [^ false]. "Uneven address" - oop >= objectMemory endOfMemory ifTrue: [^ false]. "Out of range" - "could test if within the first large freeblock" - (self longAt: oop) = 4 ifTrue: [^ false]. - (objectMemory headerType: oop) = 2 ifTrue: [^ false]. "Free object" - ^ true!

1 0

Is bintray the place to go for the latest VM builds?
by Phil (list) 04 Jan '17

04 Jan '17

I downloaded cog_linux32x86_squeak.cog.spur_201609052318.tar.gz from ht tps://bintray.com/package/files/opensmalltalk/vm/cog and it is missing the vm-sound-pulse module. Is this a build issue or am I downloading from the wrong place?

4 9

VM Maker: VMMaker.oscog-eem.2068.mcz
by commits＠source.squeak.org 04 Jan '17

04 Jan '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2068.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2068 Author: eem Time: 3 January 2017, 7:02:14.747424 pm UUID: fae06c1b-ef17-4d91-bcba-d9d203c66223 Ancestors: VMMaker.oscog-eem.2067 SpurPlanningCompactor: Fix the bug in useFreeChunkForSavedFirstFieldsSpace:; the object must not be destroyed when filling it with saved first fields, so skip the first few fields. (Code that debugged this included in a comment in check:) Fix edge cases in asserts in the main enumerators. It seems to be working. =============== Diff against VMMaker.oscog-eem.2067 =============== Item was changed: ----- Method: SpurPlanningCompactor>>check: (in category 'private') ----- check: obj <inline: true> + self cCode: '' inSmalltalk: [obj = interestingObj ifTrue: [self halt]]. + "this debugged the misuse of the largest free chunk:" + "(manager checkForLeaks bitAnd: GCModeFull+GCModeFreeSpace) = GCModeFull ifTrue: + [self deny: ((manager isEnumerableObject: obj) and: [(manager heapMapAtWord: obj) = 0])]"! - self cCode: '' inSmalltalk: [obj = interestingObj ifTrue: [self halt]]! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjectsWithTop: (in category 'compaction') ----- copyAndUnmarkMobileObjectsWithTop: initialTop "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches those in planCompactSavingForwarders and updatePointersInMobileObjects." <var: 'initialTop' type: #usqInt> | toFinger top previousPin | <var: 'top' type: #usqInt> <var: 'toFinger' type: #usqInt> toFinger := manager startOfObject: firstFreeObject. top := initialTop. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do: [:o| self check: o. + self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger <= previousPin]]). - self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger < previousPin]]). self assert: (savedFirstFieldsSpaceWasAllocated or: [savedFirstFieldsSpace limit <= manager firstObject asUnsignedInteger or: [toFinger < top]]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [(manager isSegmentBridge: o) ifFalse: [manager setIsMarkedOf: o to: false. manager segmentManager notePinned: o]. previousPin ifNotNil: [| limit | limit := manager startOfObject: previousPin. manager addFreeChunkWithBytes: limit - toFinger at: toFinger. toFinger := manager addressAfter: previousPin. + self assert: toFinger <= (manager startOfObject: o)]. - self assert: toFinger < (manager startOfObject: o)]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [self freeFrom: toFinger upTo: (manager startOfObject: o) previousPin: previousPin. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." availableSpace > 0 ifTrue: [manager addFreeChunkWithBytes: availableSpace at: toFinger]. toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. (self oop: next isGreaterThanOrEqualTo: o) ifTrue: [^self continueCopyAndUnmarkMobileObjectsFrom: o withTop: top - manager bytesPerOop]. previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]]. toFinger := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top)]]]. self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') ----- planCompactSavingForwarders "Sweep the heap from firstFreeObject forwarding marked objects to where they can be moved to, saving their forwarding pointer in savedFirstFieldsSpace. Continue until either the end of the heap is reached or savedFirstFieldsSpace is full. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). Note that this method is potentially recursive. If skipping a run of pinned objects causes the the algorithm to encounter another run of immobile objects it will recurse via continuePlanCompactSavingForwardersFrom:. This enumeration matches those in updatePointersInMobileObjects and copyAndUnmarkMobileObjects." | toFinger top previousPin | <var: 'top' type: #usqInt> <var: 'toFinger' type: #usqInt> savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [self logPhase: 'planning...']. toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace top. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. + self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger <= previousPin]]). - self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger < previousPin]]). self assert: (savedFirstFieldsSpaceWasAllocated or: [savedFirstFieldsSpace limit <= manager firstObject asUnsignedInteger or: [toFinger < top]]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." [previousPin ifNotNil: [self assert: (manager startOfObject: previousPin) - toFinger >= (manager allocationUnit * 2). toFinger := manager addressAfter: previousPin. + self assert: toFinger <= (manager startOfObject: o)]. - self assert: toFinger < (manager startOfObject: o)]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [savedFirstFieldsSpace top: top - manager bytesPerOop. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. (self oop: next isGreaterThanOrEqualTo: o) ifTrue: [savedFirstFieldsSpace top: top - manager bytesPerOop. ^self continuePlanCompactSavingForwardersFrom: o toFinger: toFinger]. previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]]. toFinger := self forwardMobileObject: o to: toFinger savedFirstFieldPtr: top]]]. savedFirstFieldsSpace top: top. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjectsWithTop: (in category 'compaction') ----- updatePointersInMobileObjectsWithTop: initialTop "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects." <var: 'initialTop' type: #usqInt> | toFinger top previousPin | <var: 'top' type: #usqInt> <var: 'toFinger' type: #usqInt> toFinger := manager startOfObject: firstFreeObject. top := initialTop. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. + self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger <= previousPin]]). - self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger < previousPin]]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." [self updatePointersIn: o. previousPin ifNotNil: [toFinger := manager addressAfter: previousPin]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. (self oop: next isGreaterThanOrEqualTo: o) ifTrue: [^self continueUpdatePointersInMobileObjectsFrom: o withTop: top - manager bytesPerOop]. previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]]. self updatePointersIn: o savedFirstFieldPointer: top. toFinger := toFinger + (manager bytesInObject: o)]]]. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>useFreeChunkForSavedFirstFieldsSpace: (in category 'space management') ----- useFreeChunkForSavedFirstFieldsSpace: highestSuitableFreeBlock + "Use the supplied free chunk to hold the savedFirstFieldsSpace. Invoked when + eden is found not to be big enough for the job. Avoid the first few fields so as + not to destroy the free chunk and there by confuse object enumeration." - "Use the supplied free chunk to hold the savedFirstFieldsSpace. - Invoked when eden is found not to be big enough for the job." <inline: true> savedFirstFieldsSpace + start: highestSuitableFreeBlock + (manager freeChunkLargerIndex * manager bytesPerOop); - start: highestSuitableFreeBlock; limit: (manager addressAfter: highestSuitableFreeBlock)!

1 0

VM Maker: VMMaker.oscog-eem.2067.mcz
by commits＠source.squeak.org 03 Jan '17

03 Jan '17

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2067.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.2067 Author: eem Time: 3 January 2017, 11:53:37.445979 am UUID: 98f859d8-b5a0-4fb8-a8f2-b70bf22be6ac Ancestors: VMMaker.oscog-rsf.2066 SpurPlanningCompactor: Nuke unmarkObjectsOverflowingSavedFirstFieldsSpace; it is never appropriate. Replace it by unmarkObjectsAfterLastMobileObject & objectAfterLastMobileObject. copyAndUnmark should not unmark initial objects in a second pass, hence copyAndUnmark => copyAndUnmark: firstPass. Fix reInitializeScan for subsequent passes by setting lastMobileObject appropriately. Fix several oop comparisons to use the approved method, and add type declarations so that comparisons can work for toFinger and top. Add an assert to planCompactSavingForwarders & copyAndUnmarkMobileObjectsWithTop: to check that a free chunk used for savedFirstFieldsSpace will not get improoperly overwritten. Simplify numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer:; the first field ptr is always present. Fix printEntity: to use the new unprefixed hex printer. Simulator: Fix deprecated usage in fetchByte. =============== Diff against VMMaker.oscog-rsf.2066 =============== Item was changed: ----- Method: SpurMemoryManager>>printEntity: (in category 'debug printing') ----- printEntity: oop <api> | isObj | isObj := false. coInterpreter printHex: oop; space. (self addressCouldBeObj: oop) ifFalse: [^coInterpreter print: ((self isImmediate: oop) ifTrue: ['immediate'] ifFalse: ['unknown'])]. coInterpreter print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse: [(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse: [(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse: [(self classIndexOf: oop) <= self lastClassIndexPun ifTrue: ['pun/obj stack'] ifFalse: [isObj := true. 'object']]]]); space; printHex: (self bytesInObject: oop); print: '/'; printNum: (self bytesInObject: oop). isObj ifTrue: [coInterpreter space; print: ((self formatOf: oop) <= 16rF ifTrue: ['f:0'] ifFalse: ['f:']); + printHexnpnp: (self formatOf: oop); - printHexnp: (self formatOf: oop); print: ((self isGrey: oop) ifTrue: [' g'] ifFalse: [' .']); print: ((self isImmutable: oop) ifTrue: ['i'] ifFalse: ['.']); print: ((self isMarked: oop) ifTrue: ['m'] ifFalse: ['.']); print: ((self isPinned: oop) ifTrue: ['p'] ifFalse: ['.']); print: ((self isRemembered: oop) ifTrue: ['r'] ifFalse: ['.'])]. coInterpreter cr! Item was changed: CogClass subclass: #SpurPlanningCompactor + instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceWasAllocated firstFieldOfRememberedSet interestingObj anomaly objectAfterLastMobileObject' - instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceWasAllocated firstFieldOfRememberedSet interestingObj anomaly' classVariableNames: '' poolDictionaries: 'SpurMemoryManagementConstants VMBasicConstants VMBytecodeConstants VMSpurObjectRepresentationConstants' category: 'VMMaker-SpurMemoryManager'! !SpurPlanningCompactor commentStamp: 'eem 12/23/2016 17:50' prior: 0! SpurPlanningCompactor implements the classic planning compaction algorithm for Spur. It makes at least three passes through the heap. The first pass plans where live movable objects will go, copying their forwarding field to the next slot in savedFirstFieldsSpace, and setting their forwarding pointer to point to their eventual location. The second pass updates all pointers in live pointer objects to point to objects' final destinations. The third pass moves objects to their final positions, unmarking objects as it does so. If the forwarding fields of live objects in the to-be-moved portion of the entire heap won't fit in savedFirstFieldsSpace, then additional passes are made until the entire heap has been compacted. Instance Variables biasForGC <Boolean> coInterpreter: <StackInterpreter> firstFieldOfRememberedSet <Oop> firstFreeObject <Oop> firstMobileObject <Oop> lastMobileObject <Oop> manager: <SpurMemoryManager> savedFirstFieldsSpace <SpurContiguousObjStack> savedFirstFieldsSpaceWasAllocated <Boolean> scavenger: <SpurGenerationScavenger> biasForGC - true if compacting for GC, in which case do only one pass, or false if compacting for snapshot, in which case do as many passes as necessary to compact the entire heap. firstFieldOfRememberedSet - the saved first field of the rememberedSet. The rememberedSet must be relocated specially because it is not a pointer object. And hence the first field needs to be extracted for proper relocation. firstFreeObject - the first free object in a compaction pass. firstMobileObject - the first mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded. lastMobileObject - the last mobile object in a compaction. Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded. savedFirstFieldsSpace - the space holding the saved first fields, each overwritten by a forwarding pointer, for the objects from firstMobileObject through to lastMobileObject. savedFirstFieldsSpaceWasAllocated - if true, the memory for savedFirstFieldsSpace was obtained via a call of sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto:! Item was changed: ----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') ----- compact "Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects. Let the segmentManager mark which segments contain pinned objects via notePinned:." + | onePass firstPass | - | onePass | <inline: #never> "for profiling" self initializeScanCheckingForFullyCompactedHeap ifTrue: [^self unmarkObjectsInFullyCompactedHeap]. self initializeCompaction. + firstPass := true. [onePass := self planCompactSavingForwarders. self assert: (self validRelocationPlanInPass: onePass) = 0. + objectAfterLastMobileObject := manager objectAfter: lastMobileObject. self updatePointers. + self copyAndUnmark: firstPass. - self copyAndUnmark. manager checkFreeSpace: GCModeFull. onePass or: [biasForGC]] whileFalse: + [firstPass := false. + self reinitializeScan; - [self reinitializeScan; updateSavedFirstFieldsSpaceIfNecessary]. self endCompaction! Item was changed: ----- Method: SpurPlanningCompactor>>continueCopyAndUnmarkMobileObjectsFrom:withTop: (in category 'compaction') ----- continueCopyAndUnmarkMobileObjectsFrom: anUnpinnedEntity withTop: initialTop "copyAndUnmarkMobileObjects has encountered a run of pinned objects around which it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a new firstFreeObject, resetting it before continuing. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + <var: 'initialTop' type: #usqInt> | result top savedFirstFreeObject savedFirstMobileObject nextFreeObject | + <var: 'top' type: #usqInt> self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). self deny: (manager isPinned: anUnpinnedEntity). savedFirstMobileObject := firstMobileObject. nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. top := initialTop. "Copy and unmark the run of immobile objects to match the enumeration in continuePlanCompactSavingForwardersFrom:toFinger:." manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do: [:o| + ((self oop: o isLessThan: firstMobileObject) - (o < firstMobileObject and: [manager isMarked: o]) ifTrue: [(manager isPinned: o) ifTrue: [(manager isSegmentBridge: o) ifFalse: [manager setIsMarkedOf: o to: false. manager segmentManager notePinned: o]] ifFalse: [(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [^false]. self assert: o = (manager fetchPointer: 0 ofObject: o). manager setIsMarkedOf: o to: false; storePointerUnchecked: 0 ofObject: o withValue: (manager longAt: top)]]]. firstMobileObject := savedFirstMobileObject. nextFreeObject ifNil: [^true]. savedFirstFreeObject := firstFreeObject. firstFreeObject := nextFreeObject. result := self copyAndUnmarkMobileObjectsWithTop: top. firstFreeObject := savedFirstFreeObject. ^result! Item was changed: ----- Method: SpurPlanningCompactor>>continuePlanCompactSavingForwardersFrom:toFinger: (in category 'compaction') ----- continuePlanCompactSavingForwardersFrom: anUnpinnedEntity toFinger: initialToFinger "planCompactSavingForwarders has encountered a run of pinned objects around which it cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a new firstFreeObject, resetting it before continuing. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + <var: 'initialToFinger' type: #usqInt> | result toFinger savedFirstMobileObject savedFirstFreeObject nextFreeObject | + <var: 'toFinger' type: #usqInt> self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). self deny: (manager isPinned: anUnpinnedEntity). toFinger := initialToFinger. savedFirstMobileObject := firstMobileObject. nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. "Forward the run of immobile objects since all unpinned objects between firstMobileObject and lastMobileObject must be forwarded. Return if savedFirstFieldsSpace fills up." manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do: [:o| | newTop | + ((self oop: o isLessThan: firstMobileObject) - (o < firstMobileObject and: [manager isMarked: o]) ifTrue: [(manager isPinned: o) ifTrue: [self assert: (manager addressAfter: o) <= initialToFinger] ifFalse: [(newTop := savedFirstFieldsSpace top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [firstMobileObject := savedFirstMobileObject. ^false]]. self assert: (manager startOfObject: o) >= toFinger. toFinger := self forwardMobileObject: o to: toFinger savedFirstFieldPtr: newTop. savedFirstFieldsSpace top: newTop]]. firstMobileObject := savedFirstMobileObject. nextFreeObject ifNil: [^true]. + self assert: (self oop: nextFreeObject isGreaterThan: lastMobileObject). - self assert: nextFreeObject > lastMobileObject. manager allOldSpaceEntitiesFrom: (manager objectAfter: lastMobileObject) to: nextFreeObject do: [:o| self deny: ((manager isMarked: o) and: [(manager isPinned: o) not])]. savedFirstFreeObject := firstFreeObject. firstFreeObject := nextFreeObject. result := self planCompactSavingForwarders. firstFreeObject := savedFirstFreeObject. ^result! Item was changed: ----- Method: SpurPlanningCompactor>>continueUpdatePointersInMobileObjectsFrom:withTop: (in category 'compaction') ----- continueUpdatePointersInMobileObjectsFrom: anUnpinnedEntity withTop: initialTop "updatePointersInMobileObjects has encountered a run of pinned objects around which planCompactSavingForwarders cannot compact, but savedFirstFieldsSpace is still not full. Continue the pass with a new firstFreeObject , resetting it before continuing. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)." + <var: 'initialTop' type: #usqInt> | result top savedFirstFreeObject savedFirstMobileObject nextFreeObject | + <var: 'top' type: #usqInt> self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory). self deny: (manager isPinned: anUnpinnedEntity). savedFirstMobileObject := firstMobileObject. nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity. top := initialTop. "Update the run of immobile objects to match the enumeration in continuePlanCompactSavingForwardersFrom:toFinger:." manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do: [:o| + ((self oop: o isLessThan: firstMobileObject) - (o < firstMobileObject and: [manager isMarked: o]) ifTrue: [(manager isPinned: o) ifTrue: [self updatePointersIn: o] ifFalse: [(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [^false]. self updatePointersIn: o savedFirstFieldPointer: top]]]. firstMobileObject := savedFirstMobileObject. nextFreeObject ifNil: [^true]. savedFirstFreeObject := firstFreeObject. firstFreeObject := nextFreeObject. result := self updatePointersInMobileObjectsWithTop: top. firstFreeObject := savedFirstFreeObject. ^result! Item was removed: - ----- Method: SpurPlanningCompactor>>copyAndUnmark (in category 'compaction') ----- - copyAndUnmark - "Sweep the heap, unmarking all objects and moving mobile objects to their correct positions, - restoring their savedFirstFields." - | onePass | - self logPhase: 'copying and unmarking...'. - self unmarkInitialImmobileObjects. - "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass." - savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: - [self assert: firstMobileObject >= manager endOfMemory. - ^self]. - onePass := self copyAndUnmarkMobileObjectsWithTop: savedFirstFieldsSpace start - manager bytesPerOop. - onePass ifFalse: - [self unmarkObjectsOverflowingSavedFirstFieldsSpace]! Item was added: + ----- Method: SpurPlanningCompactor>>copyAndUnmark: (in category 'compaction') ----- + copyAndUnmark: firstPass + "Sweep the heap, unmarking all objects and moving mobile objects to their correct positions, + restoring their savedFirstFields." + | onePass | + self logPhase: 'copying and unmarking...'. + firstPass ifTrue: + [self unmarkInitialImmobileObjects]. + "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass." + savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: + [self assert: (self oop: firstMobileObject isGreaterThanOrEqualTo: manager endOfMemory). + ^self]. + onePass := self copyAndUnmarkMobileObjectsWithTop: savedFirstFieldsSpace start - manager bytesPerOop. + (onePass not and: [biasForGC]) ifTrue: "only ever one pass if biasForGC is true." + [self unmarkObjectsAfterLastMobileObject]! Item was changed: ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjectsWithTop: (in category 'compaction') ----- copyAndUnmarkMobileObjectsWithTop: initialTop "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches those in planCompactSavingForwarders and updatePointersInMobileObjects." + <var: 'initialTop' type: #usqInt> - | toFinger top previousPin | + <var: 'top' type: #usqInt> + <var: 'toFinger' type: #usqInt> toFinger := manager startOfObject: firstFreeObject. top := initialTop. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do: [:o| self check: o. self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger < previousPin]]). + self assert: (savedFirstFieldsSpaceWasAllocated + or: [savedFirstFieldsSpace limit <= manager firstObject asUnsignedInteger + or: [toFinger < top]]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: [(manager isSegmentBridge: o) ifFalse: [manager setIsMarkedOf: o to: false. manager segmentManager notePinned: o]. previousPin ifNotNil: [| limit | limit := manager startOfObject: previousPin. manager addFreeChunkWithBytes: limit - toFinger at: toFinger. toFinger := manager addressAfter: previousPin. self assert: toFinger < (manager startOfObject: o)]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [self freeFrom: toFinger upTo: (manager startOfObject: o) previousPin: previousPin. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." availableSpace > 0 ifTrue: [manager addFreeChunkWithBytes: availableSpace at: toFinger]. toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. + (self oop: next isGreaterThanOrEqualTo: o) ifTrue: - next >= o ifTrue: [^self continueCopyAndUnmarkMobileObjectsFrom: o withTop: top - manager bytesPerOop]. previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]]. toFinger := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top)]]]. self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>initializeScanCheckingForFullyCompactedHeap (in category 'compaction') ----- initializeScanCheckingForFullyCompactedHeap + "Scan for firstFreeObject and firstMobileObject from the start of memory (actually + from lastMobileObject so that reInitializeScan can work on subsequent passes). + Answer if the heap is already fully compacted. Set " + firstFreeObject := lastMobileObject := manager hiddenRootsObject. - "Scan for firstFreeObject and firstMobileObject from the start of memory. - Answer if the heap is already fully compacted." - firstFreeObject := manager hiddenRootsObject. self reinitializeScan. ^firstMobileObject >= manager endOfMemory! Item was changed: ----- Method: SpurPlanningCompactor>>numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: (in category 'private') ----- + numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtr - numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtrOrNil "This is a version of SpurMemoryManager>>numPointerSlotsOf: that deals with the possibility of obj being a CompiledMethod whose header is in savedFirstFieldsSpace. Answer the number of pointer fields in the given object. Works with CompiledMethods, as well as ordinary objects." <inline: true> | contextSize numLiterals header | + self assert: (firstFieldPtr notNil and: [self isMobile: obj]). fmt <= manager lastPointerFormat ifTrue: [(fmt = manager indexablePointersFormat and: [manager isContextNonImm: obj]) ifTrue: ["contexts end at the stack pointer" contextSize := coInterpreter fetchStackPointerOf: obj. ^CtxtTempFrameStart + contextSize]. ^manager numSlotsOf: obj "all pointers"]. self deny: fmt = manager forwardedFormat. fmt < manager firstCompiledMethodFormat ifTrue: [^0]. "no pointers" "CompiledMethod: contains both pointers and bytes" + header := manager methodHeaderFromSavedFirstField: (manager longAt: firstFieldPtr). - self assert: firstFieldPtrOrNil notNil == (self isMobile: obj). - header := firstFieldPtrOrNil - ifNil: [manager methodHeaderOf: obj] - ifNotNil: [manager methodHeaderFromSavedFirstField: (manager longAt: firstFieldPtrOrNil)]. numLiterals := manager literalCountOfMethodHeader: header. ^numLiterals + LiteralStart! Item was changed: ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') ----- planCompactSavingForwarders "Sweep the heap from firstFreeObject forwarding marked objects to where they can be moved to, saving their forwarding pointer in savedFirstFieldsSpace. Continue until either the end of the heap is reached or savedFirstFieldsSpace is full. Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed). Note that this method is potentially recursive. If skipping a run of pinned objects causes the the algorithm to encounter another run of immobile objects it will recurse via continuePlanCompactSavingForwardersFrom:. This enumeration matches those in updatePointersInMobileObjects and copyAndUnmarkMobileObjects." | toFinger top previousPin | + <var: 'top' type: #usqInt> + <var: 'toFinger' type: #usqInt> savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue: [self logPhase: 'planning...']. toFinger := manager startOfObject: firstFreeObject. top := savedFirstFieldsSpace top. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger < previousPin]]). + self assert: (savedFirstFieldsSpaceWasAllocated + or: [savedFirstFieldsSpace limit <= manager firstObject asUnsignedInteger + or: [toFinger < top]]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." [previousPin ifNotNil: [self assert: (manager startOfObject: previousPin) - toFinger >= (manager allocationUnit * 2). toFinger := manager addressAfter: previousPin. self assert: toFinger < (manager startOfObject: o)]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [savedFirstFieldsSpace top: top - manager bytesPerOop. ^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. + (self oop: next isGreaterThanOrEqualTo: o) ifTrue: - next >= o ifTrue: [savedFirstFieldsSpace top: top - manager bytesPerOop. ^self continuePlanCompactSavingForwardersFrom: o toFinger: toFinger]. previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]]. toFinger := self forwardMobileObject: o to: toFinger savedFirstFieldPtr: top]]]. savedFirstFieldsSpace top: top. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>reinitializeScan (in category 'compaction') ----- reinitializeScan + "Search for firstFreeObject and firstMobileObject from lastMobileObject (which is + set to the hiddenRootsObject on the first pass)." firstMobileObject := manager endOfMemory. + firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: lastMobileObject. - firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: firstFreeObject. firstFreeObject ifNil: [self error: 'uncompactable heap; no unmarked objects found']. mobileStart := manager startOfObject: firstFreeObject! Item was changed: ----- Method: SpurPlanningCompactor>>unmarkInitialImmobileObjects (in category 'compaction') ----- unmarkInitialImmobileObjects "Sweep the initial immobile heap, unmarking all objects up to the first mobile object." manager allOldSpaceObjectsFrom: manager firstObject do: [:o| self check: o. + (self oop: o isGreaterThanOrEqualTo: firstMobileObject) ifTrue: - o >= firstMobileObject ifTrue: [^self]. manager setIsMarkedOf: o to: false]! Item was added: + ----- Method: SpurPlanningCompactor>>unmarkObjectsAfterLastMobileObject (in category 'compaction') ----- + unmarkObjectsAfterLastMobileObject + "Sweep the final immobile heap, unmarking all objects up to the end of memory." + manager allOldSpaceObjectsFrom: objectAfterLastMobileObject do: + [:o| + self check: o. + manager setIsMarkedOf: o to: false]! Item was removed: - ----- Method: SpurPlanningCompactor>>unmarkObjectsOverflowingSavedFirstFieldsSpace (in category 'compaction') ----- - unmarkObjectsOverflowingSavedFirstFieldsSpace - self shouldBeImplemented! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersIn:savedFirstFieldPointer: (in category 'compaction') ----- + updatePointersIn: obj savedFirstFieldPointer: firstFieldPtr - updatePointersIn: obj savedFirstFieldPointer: firstFieldPtrOrNil "Sweep the pointer fields in obj, updating all references to mobile objects to their eventual locations. + firstFieldPtr is supplied for mobile objects so that the saved first field can be updated, and so that - firstFieldPtrOrNil is supplied for mobile objects so that the saved first field can be updated, and so that the first field of a compiled method (which is its header, or reference to a CogMethod holding its header) can be retrieved." <inline: false> + | fmt numPointerSlots oop fwd | - | fmt numPointerSlots | fmt := manager formatOf: obj. + numPointerSlots := self numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtr. - numPointerSlots := self numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtrOrNil. (fmt <= manager lastPointerFormat "excludes CompiledMethod" and: [numPointerSlots > 0]) ifTrue: + ["Relocate the saved first field; Note that CompiledMethods can be excluded since their - [| oop fwd | - "Relocate the saved first field; Note that CompiledMethods can be excluded since their first field is either a SmallInteger or a reference to a CogMethod outside of oldSpace." + oop := manager longAt: firstFieldPtr. - oop := manager longAt: firstFieldPtrOrNil. ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: [self assert: (manager isMarked: oop). fwd := manager fetchPointer: 0 ofObject: oop. self assert: (self isPostMobile: fwd). + manager longAt: firstFieldPtr put: fwd]]. - manager longAt: firstFieldPtrOrNil put: fwd]]. 1 to: numPointerSlots - 1 do: + [:i| - [:i| | oop fwd | oop := manager fetchPointer: i ofObject: obj. ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue: [self assert: ((manager isMarked: oop) or: [obj = manager hiddenRootsObject]). fwd := manager fetchPointer: 0 ofObject: oop. self assert: (self isPostMobile: fwd). manager storePointerUnchecked: i ofObject: obj withValue: fwd]]! Item was changed: ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjectsWithTop: (in category 'compaction') ----- updatePointersInMobileObjectsWithTop: initialTop "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations. Remember to update the savedFirstFields of pointer objects, as these have been forwarded. This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects." + <var: 'initialTop' type: #usqInt> - | toFinger top previousPin | + <var: 'top' type: #usqInt> + <var: 'toFinger' type: #usqInt> toFinger := manager startOfObject: firstFreeObject. top := initialTop. self deny: (manager isMarked: firstFreeObject). manager allOldSpaceEntitiesFrom: firstFreeObject do: [:o| self check: o. self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger < previousPin]]). (manager isMarked: o) ifTrue: [(manager isPinned: o) ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed." [self updatePointersIn: o. previousPin ifNotNil: [toFinger := manager addressAfter: previousPin]. previousPin := o] ifFalse: [| availableSpace bytes next | (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue: [^false]. [previousPin notNil and: [availableSpace := (manager startOfObject: previousPin) - toFinger. bytes := manager bytesInObject: o. bytes ~= availableSpace and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue: ["The object does not fit in the space between toFinger and previousPin. Move toFinger beyond previousPin and update previousPin appropriately." toFinger := manager addressAfter: previousPin. next := manager objectStartingAt: toFinger. + (self oop: next isGreaterThanOrEqualTo: o) ifTrue: - next >= o ifTrue: [^self continueUpdatePointersInMobileObjectsFrom: o withTop: top - manager bytesPerOop]. previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]]. self updatePointersIn: o savedFirstFieldPointer: top. toFinger := toFinger + (manager bytesInObject: o)]]]. ^true! Item was changed: ----- Method: SpurPlanningCompactor>>validRelocationPlanInPass: (in category 'private') ----- validRelocationPlanInPass: onePass "Answer 0 if all the mobile objects from firstMobileObject to lastMobileObject have sane forwarding addresses, and that savedFirstFieldsSpace is of matching capacity. Otherwise answer an error code identifying the anomaly." | nMobiles toFinger | + <var: 'toFinger' type: #usqInt> + <var: 'destination' type: #usqInt> nMobiles := 0. toFinger := mobileStart. anomaly := nil. manager allOldSpaceEntitiesFrom: firstMobileObject do: [:o| | destination | self check: o. (manager isMarked: o) ifTrue: [(manager isPinned: o) ifFalse: [nMobiles := nMobiles + 1. destination := manager fetchPointer: 0 ofObject: o. destination >= toFinger ifFalse: [anomaly := o. ^1]. toFinger := toFinger + (manager bytesInObject: o). + (self oop: o isGreaterThan: lastMobileObject) ifTrue: - o > lastMobileObject ifTrue: [anomaly := o. ^2]. o = lastMobileObject ifTrue: [^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1 = nMobiles ifTrue: [0] ifFalse: [3]]]]]. ^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1 = nMobiles ifTrue: [0] + ifFalse: [4]! - ifFalse: [3]! Item was changed: ----- Method: StackInterpreterSimulator>>fetchByte (in category 'interpreter shell') ----- fetchByte + ^objectMemory byteAt: (localIP := localIP + 1).! - - ^ self byteAt: (localIP := localIP + 1).!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev January 2017