Vm-dev July 2014

vm-dev@lists.squeakfoundation.org

22 participants
157 discussions

VM Maker: VMMaker.oscog-eem.830.mcz
by commits＠source.squeak.org 21 Jul '14

21 Jul '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.830.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.830 Author: eem Time: 21 July 2014, 7:35:48.335 am UUID: ad7e3584-5924-4500-be7c-ea7ebac3f71c Ancestors: VMMaker.oscog-eem.829 Revise markAndTrace: given that markAndShouldScan: is inlined within it (see Slang changes below). Move the ephemeron processing into markAndShouldScan: out of the now unused numStringSlotsOf:ephemeronInactiveIf: circumlocution. Add activeAndDeferredScan: and numStrongSlotsOfInephemeral: in place of the double negative inactiveOrFailedToDeferScan: and hence inline numStrongSlotsOfInephemeral:. Increase the traceImmediatelySlotLimit. These changes plus the 2 repeats for compaction speed up global GC by at least x2. In the wake of the inlining changes below, split lookupInMethodCacheSel:classTag: into it and inlineLookupInMethodCacheSel:classTag:, and use the inline version in internalFindNewMethod. Slang: Add support for inlining into the condition of ifTrue:/ifFalse: when it is marked as inline. Transform expr1 ifTrue:/ifFalse: [^expr2] by inlining ^expr2 into expr1. Transform expr ifTrue:/ifFalse: [statements] by replacing ^boolean occurrences in expr with gotos. =============== Diff against VMMaker.oscog-eem.829 =============== Item was changed: ----- Method: CoInterpreter>>internalFindNewMethod (in category 'message sending') ----- internalFindNewMethod "Find the compiled method to be run when the current messageSelector is sent to the given class, setting the values of newMethod and primitiveIndex." | ok | <inline: true> + ok := self inlineLookupInMethodCacheSel: messageSelector classTag: lkupClassTag. - ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag. ok ifTrue: [self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector] ifFalse: [self externalizeIPandSP. ((objectMemory isOopForwarded: messageSelector) or: [objectMemory isForwardedClassTag: lkupClassTag]) ifTrue: [(objectMemory isOopForwarded: messageSelector) ifTrue: [messageSelector := self handleForwardedSelectorFaultFor: messageSelector]. (objectMemory isForwardedClassTag: lkupClassTag) ifTrue: [lkupClassTag := self handleForwardedSendFaultForTag: lkupClassTag]. + (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifTrue: - ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag. - ok ifTrue: [^self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]]. lkupClass := objectMemory classForClassTag: lkupClassTag. self lookupMethodInClass: lkupClass. self internalizeIPandSP. self addNewMethodToCache: lkupClass]! Item was changed: ----- Method: SmartSyntaxPluginTMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initializing') ----- setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment "Initialize this method using the given information." selector := sel. definingClass := class. returnType := #sqInt. "assume return type is sqInt for now" args := argList asOrderedCollection collect: [:arg | arg key]. locals := (localList collect: [:arg | arg key]) asSet. declarations := Dictionary new. primitive := aNumber. properties := methodProperties. comment := aComment. parseTree := aBlockNode asTranslatorNodeIn: self. + labels := Set new. - labels := OrderedCollection new. complete := false. "set to true when all possible inlining has been done" export := self extractExportDirective. static := self extractStaticDirective. canAsmLabel := self extractLabelDirective. self extractSharedCase. isPrimitive := false. "set to true only if you find a primtive direction." suppressingFailureGuards := self extractSuppressFailureGuardDirective. self recordDeclarationsIn: nil. self extractPrimitiveDirectives. ! Item was added: + ----- Method: SpurMemoryManager>>activeAndDeferredScan: (in category 'weakness and ephemerality') ----- + activeAndDeferredScan: anEphemeron + "Answer whether an ephemeron is active (has an unmarked + key) and was pushed on the unscanned ephemerons stack." + | key | + <inline: #never> + self assert: (self isEphemeron: anEphemeron). + ((self isImmediate: (key := self keyOfEphemeron: anEphemeron)) + or: [self isMarked: key]) ifTrue: + [^false]. + ^self pushOnUnscannedEphemeronsStack: anEphemeron! Item was changed: ----- Method: SpurMemoryManager>>fixFollowedField:ofObject:withInitialValue: (in category 'forwarding') ----- fixFollowedField: fieldIndex ofObject: anObject withInitialValue: initialValue "Private helper for followField:ofObject: to avoid code duplication for rare case." + <inline: #never> - <inline: false> | objOop | self assert: (self isOopForwarded: initialValue). objOop := self followForwarded: initialValue. self storePointer: fieldIndex ofObject: anObject withValue: objOop. ^objOop! Item was changed: ----- Method: SpurMemoryManager>>markAndShouldScan: (in category 'gc - global') ----- markAndShouldScan: objOop + "Helper for markAndTrace:. + Mark the argument, and answer if its fields should be scanned now. - "Mark the argument, and answer if its fields should be scanned now. Immediate objects don't need to be marked. Already marked objects have already been processed. Pure bits objects don't need scanning, although their class does. Weak objects should be pushed on the weakling stack. Anything else need scanning." | format | + <inline: true> (self isImmediate: objOop) ifTrue: [^false]. + "if markAndTrace: is to follow and eliminate forwarding pointers + in its scan it cannot be handed an r-value which is forwarded." self assert: (self isForwarded: objOop) not. (self isMarked: objOop) ifTrue: [^false]. self setIsMarkedOf: objOop to: true. format := self formatOf: objOop. (self isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack" [self markAndTraceClassOf: objOop. ^false]. format = self weakArrayFormat ifTrue: "push weaklings on the weakling stack to scan later" [self push: objOop onObjStack: weaklingStack. ^false]. + (format = self ephemeronFormat + and: [self activeAndDeferredScan: objOop]) ifTrue: + [^false]. ^true! Item was changed: ----- Method: SpurMemoryManager>>markAndTrace: (in category 'gc - global') ----- markAndTrace: objOop "Mark the argument, and all objects reachable from it, and any remaining objects on the mark stack. Follow forwarding pointers in the scan." <api> + | objToScan scanLargeObject numStrongSlots index field | + "if markAndTrace: is to follow and eliminate forwarding pointers + in its scan it cannot be handed an r-value which is forwarded. + The assert for this is in markAndShouldScan:" - | objToScan numStrongSlots index field | (self markAndShouldScan: objOop) ifFalse: [^self]. - "if markAndTrace: is to follow and eliminate forwarding pointers - in its scan it cannot be handed an r-value which is forwarded." - self assert: (self isForwarded: objOop) not. "Now scan the object, and any remaining objects on the mark stack." objToScan := objOop. "To avoid overflowing the mark stack when we encounter large objects, we push the obj, then its numStrongSlots, and then index the object from the stack." + [(self isImmediate: objToScan) + ifTrue: [scanLargeObject := true] + ifFalse: + [numStrongSlots := self numStrongSlotsOfInephemeral: objToScan. + scanLargeObject := numStrongSlots > self traceImmediatelySlotLimit]. + scanLargeObject - [((self isImmediate: objToScan) - or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. - numStrongSlots > self traceImmediatelySlotLimit]) ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any." [(self isImmediate: objToScan) ifTrue: [index := self integerValueOf: objToScan. objToScan := self topOfObjStack: markStack] ifFalse: [index := numStrongSlots. self markAndTraceClassOf: objToScan]. [index > 0] whileTrue: [index := index - 1. field := self fetchPointer: index ofObject: objToScan. + (self isNonImmediate: field) ifTrue: + [(self isForwarded: field) ifTrue: "fixFollowedField: is /not/ inlined" + [field := self fixFollowedField: index ofObject: objToScan withInitialValue: field]. + (self markAndShouldScan: field) ifTrue: + [index > 0 ifTrue: + [(self topOfObjStack: markStack) ~= objToScan ifTrue: + [self push: objToScan onObjStack: markStack]. + self push: (self integerObjectOf: index) onObjStack: markStack]. + objToScan := field. + index := -1]]]. - (self isOopForwarded: field) ifTrue: - [field := self followForwarded: field. - self storePointer: index ofObject: objToScan withValue: field]. - (self markAndShouldScan: field) ifTrue: - [index > 0 ifTrue: - [(self topOfObjStack: markStack) ~= objToScan ifTrue: - [self push: objToScan onObjStack: markStack]. - self push: (self integerObjectOf: index) onObjStack: markStack]. - objToScan := field. - index := -1]]. index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack." [objToScan := self popObjStack: markStack. objToScan = objOop ifTrue: [objToScan := self popObjStack: markStack]]] ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack." [index := numStrongSlots. self markAndTraceClassOf: objToScan. [index > 0] whileTrue: [index := index - 1. field := self fetchPointer: index ofObject: objToScan. + (self isNonImmediate: field) ifTrue: + [(self isForwarded: field) ifTrue: "fixFollowedField: is /not/ inlined" + [field := self fixFollowedField: index ofObject: objToScan withInitialValue: field]. + (self markAndShouldScan: field) ifTrue: + [self push: field onObjStack: markStack. + ((self rawNumSlotsOf: field) > self traceImmediatelySlotLimit + and: [(numStrongSlots := self numStrongSlotsOfInephemeral: field) > self traceImmediatelySlotLimit]) ifTrue: + [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]]. - (self isOopForwarded: field) ifTrue: - [field := self followForwarded: field. - self storePointer: index ofObject: objToScan withValue: field]. - (self markAndShouldScan: field) ifTrue: - [self push: field onObjStack: markStack. - numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:. - numStrongSlots > self traceImmediatelySlotLimit ifTrue: - [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]. objToScan := self popObjStack: markStack]. objToScan notNil] whileTrue! Item was removed: - ----- Method: SpurMemoryManager>>numStrongSlotsOf:ephemeronInactiveIf: (in category 'object access') ----- - numStrongSlotsOf: objOop ephemeronInactiveIf: criterion - "Answer the number of strong pointer fields in the given object. - Works with CompiledMethods, as well as ordinary objects." - <var: 'criterion' declareC: 'int (*criterion)(sqInt key)'> - <inline: true> - <asmLabel: false> - | fmt | - fmt := self formatOf: objOop. - ^self numStrongSlotsOf: objOop format: (self formatOf: objOop) ephemeronInactiveIf: criterion! Item was added: + ----- Method: SpurMemoryManager>>numStrongSlotsOfInephemeral: (in category 'object access') ----- + numStrongSlotsOfInephemeral: objOop + "Answer the number of strong pointer fields in the given object, + which is .expected not to be an active ephemeron. + Works with CompiledMethods, as well as ordinary objects." + <inline: true> + <asmLabel: false> + | fmt numSlots contextSize numLiterals | + fmt := self formatOf: objOop. + self assert: (fmt ~= self ephemeronFormat or: [self isMarked: (self keyOfEphemeron: objOop)]). + fmt <= self lastPointerFormat ifTrue: + [numSlots := self numSlotsOf: objOop. + fmt <= self arrayFormat ifTrue: + [^numSlots]. + fmt = self indexablePointersFormat ifTrue: + [(self isContextNonImm: objOop) ifTrue: + [coInterpreter setTraceFlagOnContextsFramesPageIfNeeded: objOop. + "contexts end at the stack pointer" + contextSize := coInterpreter fetchStackPointerOf: objOop. + ^CtxtTempFrameStart + contextSize]. + ^numSlots]. + fmt = self weakArrayFormat ifTrue: + [^self fixedFieldsOfClass: (self fetchClassOfNonImm: objOop)]]. + fmt = self forwardedFormat ifTrue: [^1]. + fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers" + + "CompiledMethod: contains both pointers and bytes" + numLiterals := coInterpreter literalCountOf: objOop. + ^numLiterals + LiteralStart! Item was changed: ----- Method: SpurMemoryManager>>traceImmediatelySlotLimit (in category 'gc - global') ----- traceImmediatelySlotLimit "Arbitrary level at which to defer tracing large objects until later. + The average slot size of Smalltalk objects is typically near 8. + We do require traceImmediatelySlotLimit to be < numSlotsMask." + ^64! - The average slot size of Smalltalk objects is typically near 8." - ^16! Item was added: + ----- Method: StackInterpreter>>inlineLookupInMethodCacheSel:classTag: (in category 'method lookup cache') ----- + inlineLookupInMethodCacheSel: selector classTag: classTag + "This method implements a simple method lookup cache. If an entry for the given selector and classTag is + found in the cache, set the values of 'newMethod' and 'primitiveFunctionPointer' and answer true. Otherwise, + answer false." + "About the re-probe scheme: The hash is the low bits of the XOR of two large addresses, minus their useless + lowest two bits. If a probe doesn't get a hit, the hash is shifted right one bit to compute the next probe, + introducing a new randomish bit. The cache is probed CacheProbeMax times before giving up." + "WARNING: Since the hash computation is based on the object addresses of the class and selector, we must + rehash or flush when compacting storage. We've chosen to flush, since that also saves the trouble of updating + the addresses of the objects in the cache." + "classTag is either a class object, if using NewObjectMemory, or a classIndex, if using SpurMemoryManager." + + | hash probe | + <inline: true> + <asmLabel: false> + hash := selector bitXor: classTag. "shift drops two low-order zeros from addresses" + + probe := hash bitAnd: MethodCacheMask. "first probe" + (((methodCache at: probe + MethodCacheSelector) = selector) and: + [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue: + [newMethod := methodCache at: probe + MethodCacheMethod. + primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction) + to: #'void (*)()'. + ^true "found entry in cache; done"]. + + probe := (hash >> 1) bitAnd: MethodCacheMask. "second probe" + (((methodCache at: probe + MethodCacheSelector) = selector) and: + [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue: + [newMethod := methodCache at: probe + MethodCacheMethod. + primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction) + to: #'void (*)()'. + ^true "found entry in cache; done"]. + + probe := (hash >> 2) bitAnd: MethodCacheMask. + (((methodCache at: probe + MethodCacheSelector) = selector) and: + [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue: + [newMethod := methodCache at: probe + MethodCacheMethod. + primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction) + to: #'void (*)()'. + ^true "found entry in cache; done"]. + + ^false! Item was changed: ----- Method: StackInterpreter>>internalFindNewMethod (in category 'message sending') ----- internalFindNewMethod "Find the compiled method to be run when the current messageSelector is sent to the class 'lkupClass', setting the values of 'newMethod' and 'primitiveIndex'." - | ok | <inline: true> + (self inlineLookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse: + ["entry was not found in the cache; look it up the hard way" + self externalizeIPandSP. - ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag. - ok ifFalse: "entry was not found in the cache; look it up the hard way" - [self externalizeIPandSP. ((objectMemory isOopForwarded: messageSelector) or: [objectMemory isForwardedClassTag: lkupClassTag]) ifTrue: [(objectMemory isOopForwarded: messageSelector) ifTrue: [messageSelector := self handleForwardedSelectorFaultFor: messageSelector]. (objectMemory isForwardedClassTag: lkupClassTag) ifTrue: [lkupClassTag := self handleForwardedSendFaultForTag: lkupClassTag]. + (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifTrue: - ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag. - ok ifTrue: [^nil]]. lkupClass := objectMemory classForClassTag: lkupClassTag. self lookupMethodInClass: lkupClass. self internalizeIPandSP. self addNewMethodToCache: lkupClass]! Item was changed: ----- Method: StackInterpreter>>lookupInMethodCacheSel:classTag: (in category 'method lookup cache') ----- lookupInMethodCacheSel: selector classTag: classTag + "This method implements a simple method lookup cache. If an entry for the given + selector and classTag is found in the cache, set the values of 'newMethod' and + 'primitiveFunctionPointer' and answer true. Otherwise, answer false." + <inline: false> + ^self inlineLookupInMethodCacheSel: selector classTag: classTag! - "This method implements a simple method lookup cache. If an entry for the given selector and classTag is - found in the cache, set the values of 'newMethod' and 'primitiveFunctionPointer' and answer true. Otherwise, - answer false." - "About the re-probe scheme: The hash is the low bits of the XOR of two large addresses, minus their useless - lowest two bits. If a probe doesn't get a hit, the hash is shifted right one bit to compute the next probe, - introducing a new randomish bit. The cache is probed CacheProbeMax times before giving up." - "WARNING: Since the hash computation is based on the object addresses of the class and selector, we must - rehash or flush when compacting storage. We've chosen to flush, since that also saves the trouble of updating - the addresses of the objects in the cache." - "classTag is either a class object, if using NewObjectMemory, or a classIndex, if using SpurMemoryManager." - - | hash probe | - <inline: true> - <asmLabel: false> - hash := selector bitXor: classTag. "shift drops two low-order zeros from addresses" - - probe := hash bitAnd: MethodCacheMask. "first probe" - (((methodCache at: probe + MethodCacheSelector) = selector) and: - [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue: - [newMethod := methodCache at: probe + MethodCacheMethod. - primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction) - to: #'void (*)()'. - ^true "found entry in cache; done"]. - - probe := (hash >> 1) bitAnd: MethodCacheMask. "second probe" - (((methodCache at: probe + MethodCacheSelector) = selector) and: - [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue: - [newMethod := methodCache at: probe + MethodCacheMethod. - primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction) - to: #'void (*)()'. - ^true "found entry in cache; done"]. - - probe := (hash >> 2) bitAnd: MethodCacheMask. - (((methodCache at: probe + MethodCacheSelector) = selector) and: - [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue: - [newMethod := methodCache at: probe + MethodCacheMethod. - primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction) - to: #'void (*)()'. - ^true "found entry in cache; done"]. - - ^false! Item was changed: ----- Method: StackInterpreter>>lookupMethodNoMNUEtcInClass: (in category 'callback support') ----- lookupMethodNoMNUEtcInClass: class "Lookup messageSelector in class. Answer 0 on success. Answer the splObj: index for the error selector to use on failure rather than performing MNU processing etc." | currentClass dictionary | + <inline: false> - <inline: true> currentClass := class. [currentClass ~= objectMemory nilObject] whileTrue: [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass. dictionary = objectMemory nilObject ifTrue: [lkupClass := self superclassOf: currentClass. ^SelectorCannotInterpret]. (self lookupMethodInDictionary: dictionary) ifTrue: [self addNewMethodToCache: class. ^0]. currentClass := self superclassOf: currentClass]. lkupClass := class. ^SelectorDoesNotUnderstand! Item was changed: ----- Method: TLabeledCommentNode>>emitCCodeOn:level:generator: (in category 'C code generation') ----- emitCCodeOn: aStream level: level generator: aCodeGen "Emit a C comment with optional label." self printOptionalLabelOn: aStream. + comment ifNotNil: + [aStream nextPutAll: '/* '. + aStream nextPutAll: comment. + aStream nextPutAll: ' */']. - aStream nextPutAll: '/* '. - aStream nextPutAll: comment. - aStream nextPutAll: ' */'. (asmLabel notNil "only output labels in the interpret function." and: [aCodeGen currentMethod selector == #interpret]) ifTrue: [aStream crtab: level. aCodeGen outputAsmLabel: asmLabel on: aStream]! Item was changed: ----- Method: TLabeledCommentNode>>printOn:level: (in category 'printing') ----- printOn: aStream level: level self printOptionalLabelOn: aStream. + comment ifNotNil: + [aStream nextPut: $". + aStream nextPutAll: comment. + aStream nextPut: $"]! - aStream nextPut: $". - aStream nextPutAll: comment. - aStream nextPut: $".! Item was added: + ----- Method: TMethod>>inlineBuiltin:in: (in category 'inlining') ----- + inlineBuiltin: aSendNode in: aCodeGen + | sel meth inlinedReplacement | + (aSendNode selector beginsWith: 'perform:') ifTrue: + [^self inlineFunctionCall: aSendNode asTransformedConstantPerform in: aCodeGen]. + sel := aSendNode receiver selector. + meth := aCodeGen methodNamed: sel. + (meth notNil and: [meth inline == true]) ifFalse: [^nil]. + meth isFunctional ifTrue: + [inlinedReplacement := (aCodeGen methodNamed: aSendNode receiver selector) copy + inlineFunctionCall: aSendNode receiver + in: aCodeGen. + ^TSendNode new + setSelector: aSendNode selector + receiver: inlinedReplacement + arguments: aSendNode args copy]. + (self isInlineableConditional: aSendNode in: aCodeGen) ifTrue: + [^self inlineConditional: aSendNode in: aCodeGen]. + ^nil! Item was added: + ----- Method: TMethod>>inlineConditional:in: (in category 'inlining') ----- + inlineConditional: aSendNode in: aCodeGen + "If possible answer the inlining of a conditional, otherwise answer nil. + Currently the only pattern we support is + aSend ifTrue:/ifFalse: [...] + where aSend is marked inline and always answers booleans." + self assert: (self isInlineableConditional: aSendNode in: aCodeGen). + self assert: aSendNode args first isStmtList. + ^(aSendNode args first statements size = 1 + and: [aSendNode args first statements first isReturn]) + ifTrue: [self inlineReturningConditional: aSendNode in: aCodeGen] + ifFalse: [self inlineGuardingConditional: aSendNode in: aCodeGen]! Item was changed: ----- Method: TMethod>>inlineFunctionCall:in: (in category 'inlining') ----- inlineFunctionCall: aSendNode in: aCodeGen "Answer the body of the called function, substituting the actual parameters for the formal argument variables in the method body. Assume caller has established that: 1. the method arguments are all substitutable nodes, and 2. the method to be inlined contains no additional embedded returns." | sel meth doNotRename argsForInlining substitutionDict | sel := aSendNode selector. meth := (aCodeGen methodNamed: sel) copy. + meth ifNil: + [^self inlineBuiltin: aSendNode in: aCodeGen]. - (meth isNil and: [sel beginsWith: 'perform:']) ifTrue: - [^self inlineFunctionCall: aSendNode asTransformedConstantPerform in: aCodeGen]. doNotRename := Set withAll: args. argsForInlining := aSendNode argumentsForInliningCodeGenerator: aCodeGen. meth args with: argsForInlining do: [ :argName :exprNode | exprNode isLeaf ifTrue: [doNotRename add: argName]]. (meth statements size = 2 and: [meth statements first isSend and: [meth statements first selector == #flag:]]) ifTrue: [meth statements removeFirst]. meth renameVarsForInliningInto: self except: doNotRename in: aCodeGen. meth renameLabelsForInliningInto: self. self addVarsDeclarationsAndLabelsOf: meth except: doNotRename. substitutionDict := Dictionary new: meth args size * 2. meth args with: argsForInlining do: [ :argName :exprNode | substitutionDict at: argName put: exprNode. (doNotRename includes: argName) ifFalse: [locals remove: argName]]. meth parseTree bindVariablesIn: substitutionDict. + ^meth statements first isReturn + ifTrue: [meth statements first expression] + ifFalse: [meth parseTree]! - ^meth statements first expression! Item was added: + ----- Method: TMethod>>inlineGuardingConditional:in: (in category 'inlining') ----- + inlineGuardingConditional: aSendNode in: aCodeGen + "Inline + aSend ifTrue:/ifFalse: [statements] + where aSend is inlineable and always answers booleans. We convert + the boolean returns in aSend to jumps." + | evaluateIfTrue replacementTree map lastNode evaluateLabel skipLabel method | + self assert: self == aCodeGen currentMethod. + self assert: (self isInlineableConditional: aSendNode in: aCodeGen). + self maybeBreakFor: aSendNode receiver in: aCodeGen. + evaluateIfTrue := aSendNode selector = #ifTrue:. + method := (aCodeGen methodNamed: aSendNode receiver selector) copy. + replacementTree := method inlineFunctionCall: aSendNode receiver in: aCodeGen. + map := Dictionary new. + (replacementTree statements last isReturn + and: [replacementTree statements last expression value = evaluateIfTrue]) ifTrue: + [lastNode := replacementTree statements last]. + skipLabel := TLabeledCommentNode new setLabel: + (self unusedLabelForInlining: method). + replacementTree nodesDo: + [:node| | expr | + node isReturn ifTrue: + [expr := node expression. + self assert: (expr isConstant and: [#(true false) includes: expr value]). + map + at: node + put: (expr value ~~ evaluateIfTrue + ifTrue: [TGoToNode new setLabel: skipLabel label] + ifFalse: + [node == lastNode + ifTrue: [TLabeledCommentNode new setComment: 'end ', aSendNode receiver selector, '; fall through'] + ifFalse: + [evaluateLabel ifNil: + [evaluateLabel := TLabeledCommentNode new setLabel: + (self unusedLabelForInlining: method)]. + TGoToNode new setLabel: evaluateLabel label]])]]. + replacementTree replaceNodesIn: map. + replacementTree comment: {'inline ', aSendNode receiver selector}. + self addVarsDeclarationsAndLabelsOf: method except: method args. + ^TStmtListNode new + setArguments: #() + statements: + (evaluateLabel + ifNil: [replacementTree statements, aSendNode args first statements, {skipLabel}] + ifNotNil: + [replacementTree statements, {evaluateLabel}, aSendNode args first statements, {skipLabel}])! Item was added: + ----- Method: TMethod>>inlineReturningConditional:in: (in category 'inlining') ----- + inlineReturningConditional: aSendNode in: aCodeGen + "Inline + aSend ifTrue:/ifFalse: [^expr] + where aSend is inlineable and always answers booleans. We inline ^expr + into aSend." + | returnIfTrue returnNode replacementTree map lastNode label method | + self assert: self == aCodeGen currentMethod. + self assert: (self isInlineableConditional: aSendNode in: aCodeGen). + self maybeBreakFor: aSendNode receiver in: aCodeGen. + returnIfTrue := aSendNode selector = #ifTrue:. + returnNode := aSendNode args first. + method := (aCodeGen methodNamed: aSendNode receiver selector) copy. + replacementTree := method inlineFunctionCall: aSendNode receiver in: aCodeGen. + map := Dictionary new. + (replacementTree statements last isReturn + and: [replacementTree statements last expression value = returnIfTrue not]) ifTrue: + [lastNode := replacementTree statements last]. + replacementTree nodesDo: + [:node| | expr | + node isReturn ifTrue: + [expr := node expression. + self assert: (expr isConstant and: [#(true false) includes: expr value]). + map + at: node + put: (expr value == returnIfTrue + ifTrue: [returnNode] + ifFalse: + [node == lastNode + ifTrue: [TLabeledCommentNode new setComment: 'end ', aSendNode receiver selector, '; fall through'] + ifFalse: + [label ifNil: + [label := TLabeledCommentNode new setLabel: + (self unusedLabelForInlining: method)]. + TGoToNode new setLabel: label label]])]]. + replacementTree replaceNodesIn: map. + self addVarsDeclarationsAndLabelsOf: method except: method args. + replacementTree comment: {'inline ', aSendNode receiver selector}. + ^label + ifNil: [replacementTree] + ifNotNil: + [TStmtListNode new + setArguments: #() + statements: {replacementTree. label}]! Item was changed: ----- Method: TMethod>>inlineableFunctionCall:in: (in category 'inlining') ----- inlineableFunctionCall: aNode in: aCodeGen "Answer true if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted." self maybeBreakFor: aNode in: aCodeGen. + aNode isSend ifFalse: + [^false]. + ^(aCodeGen methodNamed: aNode selector) + ifNil: + [aNode asTransformedConstantPerform + ifNil: [self isInlineableConditional: aNode in: aCodeGen] + ifNotNil: [:n| self inlineableFunctionCall: n in: aCodeGen]] + ifNotNil: + [:m| + m ~~ self + and: [m isFunctional + and: [(aCodeGen mayInline: m selector) + and: [aNode args allSatisfy: [ :a | self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]! - ^aNode isSend - and: [(aCodeGen methodNamed: aNode selector) - ifNil: - [aNode asTransformedConstantPerform - ifNil: [false] - ifNotNil: [:n| self inlineableFunctionCall: n in: aCodeGen]] - ifNotNil: - [:m| - m ~~ self - and: [m isFunctional - and: [(aCodeGen mayInline: m selector) - and: [aNode args allSatisfy: [ :a | self isSubstitutableNode: a intoMethod: m in: aCodeGen]]]]]]! Item was added: + ----- Method: TMethod>>isInlineableConditional:in: (in category 'inlining') ----- + isInlineableConditional: aSendNode in: aCodeGen + "Answer if the given send node is of the form aSend [ifTrue:|ifFalse:] [statements] + where the method for aSend is marked as inline and all returns within it answer booleans." + |method | + ^(#(ifTrue: ifFalse:) includes: aSendNode selector) + and: [aSendNode receiver isSend + and: [(method := aCodeGen methodNamed: aSendNode receiver selector) notNil + and: [method inline == true + and: [method parseTree statements last isReturn + and: [method parseTree allSatisfy: + [:node| + node isReturn not + or: [node expression isConstant + and: [#(true false) includes: node expression value]]]]]]]]! Item was changed: ----- Method: TMethod>>labels: (in category 'accessing') ----- labels: aCollection + labels := aCollection asSet! - labels := aCollection isSequenceable - ifTrue: [aCollection asOrderedCollection] - ifFalse: [aCollection asSortedCollection asOrderedCollection]! Item was changed: ----- Method: TMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initialization') ----- setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment "Initialize this method using the given information." selector := sel. definingClass := class. args := argList asOrderedCollection collect: [:arg | arg key]. locals := (localList collect: [:arg | arg key]) asSet. declarations := Dictionary new. self addTypeForSelf. primitive := aNumber. properties := methodProperties. comment := aComment. parseTree := aBlockNode. "hack; allows nodes to find their parent, etc" parseTree := aBlockNode asTranslatorNodeIn: self. + labels := Set new. - labels := OrderedCollection new. complete := false. "set to true when all possible inlining has been done" export := self extractExportDirective. static := self extractStaticDirective. canAsmLabel := self extractLabelDirective. self extractSharedCase. globalStructureBuildMethodHasFoo := false! Item was changed: ----- Method: TMethod>>tryToInlineMethodsIn: (in category 'inlining') ----- tryToInlineMethodsIn: aCodeGen "Expand any (complete) inline methods called by this method. Set the complete bit when all inlining has been done. Return true if something was inlined." | stmtLists didSomething newStatements sendsToInline | self definedAsMacro ifTrue: [complete := true. ^false]. didSomething := false. sendsToInline := Dictionary new: 100. parseTree nodesDo: [:node| (self inlineableFunctionCall: node in: aCodeGen) ifTrue: + [(self inlineFunctionCall: node in: aCodeGen) ifNotNil: + [:replacement| + sendsToInline at: node put: replacement]]] - [sendsToInline at: node put: (self inlineFunctionCall: node in: aCodeGen)]] unless: "Don't inline the arguments to asserts to keep the asserts readable" [:node| node isSend and: [node selector == #cCode:inSmalltalk: or: [aCodeGen isAssertSelector: node selector]]]. sendsToInline isEmpty ifFalse: [didSomething := true. parseTree := parseTree replaceNodesIn: sendsToInline]. didSomething ifTrue: [writtenToGlobalVarsCache := nil. ^didSomething]. stmtLists := self statementsListsForInliningIn: aCodeGen. stmtLists do: [:stmtList| newStatements := OrderedCollection new: 100. stmtList statements do: [:stmt| (self inlineCodeOrNilForStatement: stmt in: aCodeGen) ifNil: [newStatements addLast: stmt] ifNotNil: [:inlinedStmts| didSomething := true. newStatements addAllLast: inlinedStmts]]. stmtList setStatements: newStatements asArray]. didSomething ifTrue: [writtenToGlobalVarsCache := nil. ^didSomething]. complete ifFalse: [self checkForCompleteness: stmtLists in: aCodeGen. complete ifTrue: [ didSomething := true ]]. "marking a method complete is progress" ^didSomething! Item was added: + ----- Method: TMethod>>unusedLabelForInlining: (in category 'inlining') ----- + unusedLabelForInlining: sourceMethod + ^labels add: (self unusedLabelForInliningInto: sourceMethod)! Item was changed: ----- Method: TMethod>>unusedLabelForInliningInto: (in category 'inlining') ----- unusedLabelForInliningInto: targetMethod | usedLabels | + usedLabels := labels copy. - usedLabels := labels asSet. usedLabels addAll: targetMethod labels. ^self unusedNamePrefixedBy: 'l' avoiding: usedLabels! Item was changed: ----- Method: TStmtListNode>>emitCCodeOn:prependToEnd:level:generator: (in category 'C code generation') ----- emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen self emitCCommentOn: aStream level: level. statements withIndexDo: [:s :idx| + s isStmtList ifFalse: + [s emitCCommentOn: aStream level: level]. - s emitCCommentOn: aStream level: level. aStream peekLast ~~ Character tab ifTrue: [aStream tab: level]. (aNodeOrNil notNil and: [idx = statements size]) ifTrue: [s emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level generator: aCodeGen] ifFalse: [s emitCCodeOn: aStream level: level generator: aCodeGen]. (self stream: aStream endsWithAnyOf: '};') ifFalse: [s needsTrailingSemicolon ifTrue: [aStream nextPut: $;]]. aStream cr]. !

1 0

Re: [Pharo-users] Filesystem bug or limitation?
by btc＠openinworld.com 21 Jul '14

21 Jul '14

Juan Ignacio Vaccarezza wrote: > Hello all, > I'm playing with pharo filesystem and I run into an issue. > > I want to access the content of a remote windows folder from > Linux, so my idea was to mount it using mount -t cifs, which works > perfect, following that i thought I will access from pharo as any > other directory. > Instead of that if I try to make a fileReference with the mount > point path I't says it deos not exists. But if I ask the parent folder > for its childrends the mount point appears but not as a directory. > > Example: > given: > /mnt/remoteFolderMountPoint > > before mounting: > '/mnt/remoteFolderMountPoint' asFileReference exists -> true > '/mnt/remoteFolderMountPoint' asFileReference isDirectory -> true > after mounting > '/mnt/remoteFolderMountPoint' asFileReference exists -> false > '/mnt/remoteFolderMountPoint' asFileReference isDirectory -> false > > Other curious thing is that if I do: '/mnt/' asFileReference > children, it shows the mountpoint forlder that claims not to exist :S > > Any ideas? > > Thanks, > Juan > From http://php.net/manual/en/function.is-dir.php... Just a note for anyone who encounters is_dir() returning false on CIFS mount points or directories within those mount points on 2.6.31 and newer kernels: Apparently in new kernels they've started using the CIFS serverino option by default. With Windows shares this causes huge inode numbers and which apparently can cause is_dir() to return false. Adding the noserverino option to the CIFS mount will prevent this. This may only occur on 32 systems but I don't have a 64 bit install to test against. So try using "noserverino" and testing before and after with " ls -i " Alternatively maybe compiling the VM with -D_FILE_OFFSET_BITS=64 would work https://bugzilla.samba.org/show_bug.cgi?id=7707 Also http://stackoverflow.com/questions/7600863/inode-of-directory-on-mounted-sh… https://lists.samba.org/archive/samba-technical/2010-December/075074.html HTH, cheers -ben

1 0

Status of LargeIntergersPlugin
by David T. Lewis 21 Jul '14

21 Jul '14

We have updates to LargeIntegerPlugin here: > Name: VMMaker.oscog-eem.794 > Author: eem > Time: 2 July 2014, 3:40:54.432 pm > UUID: 7fd23b24-d4aa-4291-996a-760b99e0d7e2 > Ancestors: VMMaker.oscog-eem.793 > > Fix the shift for divide issues in the LargeIntegersPlugin. > Add code to generateDivide:on:indent: to spit out checking > asserts if required. > > Change the SmartSyntaxPluginCodeGenerator to generate > code that ifdefs out the remapOop:in: rigmarole on Spur. We also have a more extensive set of updates that Nicolas provided in email to the list (because saving to MC was failing at the time of the discussion). Both sets of changes seem to work in VMM trunk, and the unit tests pass with both implementations. The earlier discussion on this got sidetracked by the ZipPlugin issue, but I would like to get VMM trunk updated with whichever implementation we want to ultimately use. I'm not sure where we stand on this, so let me just ask: Nicolas: Is the LargeIntegersPlugin that you provided in recent email to vm-dev suitable for inclusion in the VMs? In other words, are you happy that this is a final version and ready for inclusion? Eliot: Is there any reason that we should not adopt the changes from Nicolas? If you are comfortable using that version, can we adopt it in trunk and oscog branches? Thanks, Dave

2 2

Re: [Vm-dev] VM Maker: VMMaker-dtl.348.mcz
by Eliot Miranda 20 Jul '14

20 Jul '14

Morning, David. On Sun, Jul 20, 2014 at 9:04 AM, <commits(a)source.squeak.org> wrote: > > David T. Lewis uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker-dtl.348.mcz > > ==================== Summary ==================== > > Name: VMMaker-dtl.348 > Author: dtl > Time: 20 July 2014, 11:57:32.241 am > UUID: 869e87ed-0476-48a8-bca8-fe779633f9ae > Ancestors: VMMaker-dtl.347 > > VMMaker 4.13.6 > Merge VMMaker.oscog-eem.826 except: > - Do not add the #initialize methods, not required because variables are > declared static, therefore guaranteed to be initialized to 0. Also would > require code generator changes for special treatment of instance side > #initialize.. > David, the #initialize methods /are/ needed. If one were to simulate this plugin (which vm developers /do/ do; none of the Cog VMs would exist without it) then the #initialize methods are required to initialize those variables to 0, not nil. > - Do not ^self unnecessarily, not required here and code generated changes > would be needed. > Could you give me the instances? I'm fairly sure I wouldn't have added a ^self if it wasn't needed. Maybe I mad a mistake? -- aloha, Eliot

2 2

VM Maker: Cog-eem.170.mcz
by commits＠source.squeak.org 20 Jul '14

20 Jul '14

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.170.mcz ==================== Summary ==================== Name: Cog-eem.170 Author: eem Time: 20 July 2014, 9:13:09.146 am UUID: 9eb639f5-0541-4205-95f2-894647dbe444 Ancestors: Cog-eem.169 Argh!! Make sure patchAndUploadNewer only patches unbranched packages. =============== Diff against Cog-eem.169 =============== Item was changed: ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadNewer (in category 'patching') ----- patchAndUploadNewer "Look for unbranched versions on the default repository that are newer than the image''s versions. Download and patch them and upload the patched versions." "(SpurBootstrapMonticelloPackagePatcher new from: 'spurpackages' to: 'trunkpackages') patchAndUploadNewer" | repo sourceRepo | sourceDir deleteLocalFiles. destDir deleteLocalFiles. repo := self repositoryForUrl: MCMcmUpdater defaultUpdateURL. sourceRepo := MCDirectoryRepository directory: sourceDir. repo cacheAllFileNamesDuring: [self packagesAndPatches keys do: [:package| | workingCopy | workingCopy := MCWorkingCopy allManagers detect: [:pkg| pkg packageName = package packageName]. (workingCopy possiblyNewerVersionsIn: repo) do: + [:newerVersion| + newerVersion packageAndBranchName = package packageName ifTrue: "Don't patch already patched packages!!!!" + [(sourceRepo includesVersionNamed: newerVersion) ifFalse: + [sourceRepo storeVersion: (repo versionNamed: newerVersion)]]]]. - [:newerVersion | - (sourceRepo includesVersionNamed: newerVersion) ifFalse: - [sourceRepo storeVersion: (repo versionNamed: newerVersion)]]]. self patchAsNeeded. + self uploadFrom: (MCDirectoryRepository directory: destDir) to: repo]! - self uploadFrom: (MCDirectoryRepository directory: destDir) to: self trunk]!

1 0

VM Maker: Cog-eem.169.mcz
by commits＠source.squeak.org 20 Jul '14

20 Jul '14

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.169.mcz ==================== Summary ==================== Name: Cog-eem.169 Author: eem Time: 20 July 2014, 9:07:22.665 am UUID: d81bd745-87e0-4649-bbc1-af7961f820fa Ancestors: Cog-eem.168 Implement patchAndUploadNewer to provide an incremental uploading of updated Spur packages. Refactor ShootoutTests to allow reporting to stdout with the comparison to the reference times. =============== Diff against Cog-eem.168 =============== Item was changed: ----- Method: ShootoutTests class>>runAllToDummyStreamVs: (in category 'benchmark scripts') ----- runAllToDummyStreamVs: referenceTimes "Transcript clear. self runAllToDummyStreamVs: self referenceTimesForClosureInterpreter" "Transcript clear. self runAllToDummyStreamVs: self referenceTimesForSqueakVM" + ^self runAllToDummyStreamVs: referenceTimes reportTo: Transcript! - | times ratios geometricMean | - times := Array new writeStream. - ratios := Array new writeStream. - (self standardSuiteTo: DummyStream basicNew) do: - [:block | | benchmark reference t | - benchmark := (self selectorForSimpleBlock: block) copyUpTo: $:. - reference := referenceTimes at: benchmark asSymbol. - Smalltalk garbageCollect. - times nextPut: (t := Time millisecondsToRun: block). - ratios nextPut: t asFloat / reference. - self report: block decompile printString time: t reference: reference on: Transcript]. - geometricMean := (ratios contents inject: 1 into: [:m :n| m * n]) raisedTo: 1 / ratios position. - Transcript - nextPutAll: 'geometric mean '; print: (geometricMean roundTo: 0.001); - nextPutAll: ' average speedup '; print: ((geometricMean - 1 * 100) roundTo: 0.01); nextPut: $%; cr; cr; flush. - ^times contents! Item was added: + ----- Method: ShootoutTests class>>runAllToDummyStreamVs:reportTo: (in category 'benchmark scripts') ----- + runAllToDummyStreamVs: referenceTimes reportTo: aStream + "Transcript clear. + self runAllToDummyStreamVs: self referenceTimesForClosureInterpreter" + "Transcript clear. + self runAllToDummyStreamVs: self referenceTimesForSqueakVM" + | times ratios geometricMean | + times := Array new writeStream. + ratios := Array new writeStream. + (self standardSuiteTo: DummyStream basicNew) do: + [:block | | benchmark reference t | + benchmark := (self selectorForSimpleBlock: block) copyUpTo: $:. + reference := referenceTimes at: benchmark asSymbol. + Smalltalk garbageCollect. + times nextPut: (t := Time millisecondsToRun: block). + ratios nextPut: t asFloat / reference. + self report: block decompile printString time: t reference: reference on: aStream]. + geometricMean := (ratios contents inject: 1 into: [:m :n| m * n]) raisedTo: 1 / ratios position. + aStream + nextPutAll: 'geometric mean '; print: (geometricMean roundTo: 0.001); + nextPutAll: ' average speedup '; print: ((geometricMean - 1 * 100) roundTo: 0.01); nextPut: $%; cr; cr; flush. + ^times contents! Item was changed: ----- Method: ShootoutTests class>>stdout (in category 'platform') ----- stdout + ^StandardFileStream stdout! - ^StandardFileStream stdOut! Item was changed: Object subclass: #SpurBootstrapMonticelloPackagePatcher + instanceVariableNames: 'sourceDir destDir packagesAndPatches' - instanceVariableNames: 'sourceDir destDir' classVariableNames: '' poolDictionaries: '' category: 'Cog-Bootstrapping'! !SpurBootstrapMonticelloPackagePatcher commentStamp: 'eem 1/15/2014 17:59' prior: 0! A SpurBootstrapMonticelloPackagePatcher is used to construct a new set of patched Monticello packages for Spur. The use case is some bootstrap process loads a set of Monticello packages. To repeat the bootstrap with a Spur image the bootstrap must use suitably patched Monticello packages containing the new method versions on the class side of SpurBootstrap. Instance Variables destDir: <FileDirectory> sourceDir: <FileDirectory> destDir - directory to which patched packages are to be written sourceDir - directory from which packages to be patched are to be read! Item was changed: ----- Method: SpurBootstrapMonticelloPackagePatcher>>packagesAndPatches (in category 'private-accessing') ----- packagesAndPatches "SpurBootstrapMonticelloPackagePatcher new packagesAndPatches" + packagesAndPatches ifNotNil: + [^packagesAndPatches]. - | packagesAndPatches | packagesAndPatches := Dictionary new. SpurBootstrap new prototypeClassNameMetaSelectorMethodDo: [:className :isMeta :selector :method| | class methodReference source | class := Smalltalk classNamed: className. isMeta ifTrue: [class := class class]. methodReference := (class includesSelector: selector) ifTrue: [(class >> selector) methodReference]. source := method getSourceFromFile asString allButFirst: method selector size - selector size. source first ~= selector first ifTrue: [source replaceFrom: 1 to: selector size with: selector startingAt: 1]. (packagesAndPatches at: (methodReference ifNotNil: [PackageOrganizer default packageOfMethod: methodReference] ifNil: [PackageOrganizer default packageOfClass: class]) ifAbsentPut: [OrderedCollection new]) add: (MCAddition of: (MCMethodDefinition className: className classIsMeta: isMeta selector: selector category: (methodReference ifNotNil: [methodReference category] ifNil: [Categorizer default]) timeStamp: method timeStamp source: source))]. ^packagesAndPatches! Item was added: + ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadNewer (in category 'patching') ----- + patchAndUploadNewer + "Look for unbranched versions on the default repository that are newer than the + image''s versions. Download and patch them and upload the patched versions." + "(SpurBootstrapMonticelloPackagePatcher new + from: 'spurpackages' + to: 'trunkpackages') + patchAndUploadNewer" + | repo sourceRepo | + sourceDir deleteLocalFiles. + destDir deleteLocalFiles. + repo := self repositoryForUrl: MCMcmUpdater defaultUpdateURL. + sourceRepo := MCDirectoryRepository directory: sourceDir. + repo cacheAllFileNamesDuring: + [self packagesAndPatches keys do: + [:package| | workingCopy | + workingCopy := MCWorkingCopy allManagers detect: [:pkg| pkg packageName = package packageName]. + (workingCopy possiblyNewerVersionsIn: repo) do: + [:newerVersion | + (sourceRepo includesVersionNamed: newerVersion) ifFalse: + [sourceRepo storeVersion: (repo versionNamed: newerVersion)]]]. + self patchAsNeeded. + self uploadFrom: (MCDirectoryRepository directory: destDir) to: self trunk]! Item was added: + ----- Method: SpurBootstrapMonticelloPackagePatcher>>repositoryForUrl: (in category 'repository population') ----- + repositoryForUrl: url + ^MCRepositoryGroup default repositories + detect: [:r| r description = url] + ifNone: [MCHttpRepository + location: url + user: 'squeak' + password: 'squeak']! Item was changed: ----- Method: SpurBootstrapMonticelloPackagePatcher>>trunk (in category 'repository population') ----- trunk + ^self repositoryForUrl: 'http://source.squeak.org/trunk'! - | url | - url := 'http://source.squeak.org/trunk'. - ^MCRepositoryGroup default repositories - detect: [:r| r description = url] - ifNone: [MCHttpRepository - location: url - user: 'squeak' - password: 'squeak']!

1 0

VM Maker: VMMaker-dtl.348.mcz
by commits＠source.squeak.org 20 Jul '14

20 Jul '14

David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.348.mcz ==================== Summary ==================== Name: VMMaker-dtl.348 Author: dtl Time: 20 July 2014, 11:57:32.241 am UUID: 869e87ed-0476-48a8-bca8-fe779633f9ae Ancestors: VMMaker-dtl.347 VMMaker 4.13.6 Merge VMMaker.oscog-eem.826 except: - Do not add the #initialize methods, not required because variables are declared static, therefore guaranteed to be initialized to 0. Also would require code generator changes for special treatment of instance side #initialize.. - Do not ^self unnecessarily, not required here and code generated changes would be needed. Name: VMMaker.oscog-eem.826 Author: eem Time: 18 July 2014, 5:25:22.251 pm Fix the ZipPlugin (InflatePlugin&DeflatePlugin) to no longer depend on specific instance sizes for ReadStream and WriteStream which allows some leniency in redefining these classes. =============== Diff against VMMaker-dtl.347 =============== Item was changed: InflatePlugin subclass: #DeflatePlugin + instanceVariableNames: 'zipHashHead zipHashTail zipHashValue zipBlockPos zipBlockStart zipLiterals zipDistances zipLiteralFreq zipDistanceFreq zipLiteralCount zipLiteralSize zipMatchCount zipMatchLengthCodes zipDistanceCodes zipCrcTable zipExtraLengthBits zipExtraDistanceBits zipBaseLength zipBaseDistance writeStreamInstSize' - instanceVariableNames: 'zipHashHead zipHashTail zipHashValue zipBlockPos zipBlockStart zipLiterals zipDistances zipLiteralFreq zipDistanceFreq zipLiteralCount zipLiteralSize zipMatchCount zipMatchLengthCodes zipDistanceCodes zipCrcTable zipExtraLengthBits zipExtraDistanceBits zipBaseLength zipBaseDistance' classVariableNames: 'DeflateHashBits DeflateHashMask DeflateHashShift DeflateHashTableSize DeflateMaxDistance DeflateMaxDistanceCodes DeflateMaxLiteralCodes DeflateMaxMatch DeflateMinMatch DeflateWindowMask DeflateWindowSize' poolDictionaries: '' category: 'VMMaker-Plugins'! !DeflatePlugin commentStamp: 'tpr 5/5/2003 11:52' prior: 0! This adds Zip deflating support. InflatePlugin should not be translated but this subclass should since it is incorporated within that class's translation process! Item was added: + ----- Method: DeflatePlugin>>determineSizeOfWriteStream: (in category 'primitive support') ----- + determineSizeOfWriteStream: rcvr + "Determine the inst size of the class above DeflateStream or + ZipEncoder by looking for the first class whose inst size is less than 7." + | class | + class := interpreterProxy fetchClassOf: rcvr. + [class ~= interpreterProxy nilObject + and: [(interpreterProxy instanceSizeOf: class) >= 7]] whileTrue: + [class := interpreterProxy superclassOf: class]. + class = interpreterProxy nilObject ifTrue: + [^false]. + writeStreamInstSize := interpreterProxy instanceSizeOf: class. + ^true + ! Item was changed: ----- Method: DeflatePlugin>>loadDeflateStreamFrom: (in category 'primitive support') ----- loadDeflateStreamFrom: rcvr | oop | <inline: false> + ((interpreterProxy isPointers: rcvr) + and: [(interpreterProxy slotSizeOf: rcvr) >= 15]) ifFalse: + [^false]. - ((interpreterProxy isPointers: rcvr) and:[ - (interpreterProxy slotSizeOf: rcvr) >= 15]) ifFalse:[^false]. oop := interpreterProxy fetchPointer: 0 ofObject: rcvr. + (interpreterProxy isBytes: oop) ifFalse: + [^false]. + writeStreamInstSize = 0 ifTrue: + [(self determineSizeOfWriteStream: rcvr) ifFalse: + [^false]. + "If the receiver wasn't valid then we derived writeStreamInstSize from an invalid source. discard it." + (interpreterProxy slotSizeOf: rcvr) < (writeStreamInstSize + 5) ifTrue: + [writeStreamInstSize := 0. + ^false]]. - (interpreterProxy isIntegerObject: oop) - ifTrue:[^false]. - (interpreterProxy isBytes: oop) - ifFalse:[^false]. zipCollection := interpreterProxy firstIndexableField: oop. zipCollectionSize := interpreterProxy byteSizeOf: oop. zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr. zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr. "zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr." + oop := interpreterProxy fetchPointer: writeStreamInstSize + 0 ofObject: rcvr. + ((interpreterProxy isWords: oop) + and: [(interpreterProxy slotSizeOf: oop) = DeflateHashTableSize]) ifFalse: + [^false]. - oop := interpreterProxy fetchPointer: 4 ofObject: rcvr. - ((interpreterProxy isIntegerObject: oop) or:[ - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. - (interpreterProxy slotSizeOf: oop) = DeflateHashTableSize ifFalse:[^false]. zipHashHead := interpreterProxy firstIndexableField: oop. + oop := interpreterProxy fetchPointer: writeStreamInstSize + 1 ofObject: rcvr. + ((interpreterProxy isWords: oop) + and: [(interpreterProxy slotSizeOf: oop) = DeflateWindowSize]) ifFalse: + [^false]. - oop := interpreterProxy fetchPointer: 5 ofObject: rcvr. - ((interpreterProxy isIntegerObject: oop) or:[ - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. - (interpreterProxy slotSizeOf: oop) = DeflateWindowSize ifFalse:[^false]. zipHashTail := interpreterProxy firstIndexableField: oop. + zipHashValue := interpreterProxy fetchInteger: writeStreamInstSize + 2 ofObject: rcvr. + zipBlockPos := interpreterProxy fetchInteger: writeStreamInstSize + 3 ofObject: rcvr. + "zipBlockStart := interpreterProxy fetchInteger: writeStreamInstSize + 4 ofObject: rcvr." + oop := interpreterProxy fetchPointer: writeStreamInstSize + 5 ofObject: rcvr. + (interpreterProxy isBytes: oop) ifFalse: + [^false]. - zipHashValue := interpreterProxy fetchInteger: 6 ofObject: rcvr. - zipBlockPos := interpreterProxy fetchInteger: 7 ofObject: rcvr. - "zipBlockStart := interpreterProxy fetchInteger: 8 ofObject: rcvr." - oop := interpreterProxy fetchPointer: 9 ofObject: rcvr. - ((interpreterProxy isIntegerObject: oop) or:[ - (interpreterProxy isBytes: oop) not]) ifTrue:[^false]. zipLiteralSize := interpreterProxy slotSizeOf: oop. zipLiterals := interpreterProxy firstIndexableField: oop. + oop := interpreterProxy fetchPointer: writeStreamInstSize + 6 ofObject: rcvr. + ((interpreterProxy isWords: oop) + and: [(interpreterProxy slotSizeOf: oop) >= zipLiteralSize]) ifFalse: + [^false]. - oop := interpreterProxy fetchPointer: 10 ofObject: rcvr. - ((interpreterProxy isIntegerObject: oop) or:[ - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. - (interpreterProxy slotSizeOf: oop) < zipLiteralSize ifTrue:[^false]. zipDistances := interpreterProxy firstIndexableField: oop. + oop := interpreterProxy fetchPointer: writeStreamInstSize + 7 ofObject: rcvr. + ((interpreterProxy isWords: oop) + and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes]) ifFalse: + [^false]. - oop := interpreterProxy fetchPointer: 11 ofObject: rcvr. - ((interpreterProxy isIntegerObject: oop) or:[ - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. - (interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes ifFalse:[^false]. zipLiteralFreq := interpreterProxy firstIndexableField: oop. + oop := interpreterProxy fetchPointer: writeStreamInstSize + 8 ofObject: rcvr. + ((interpreterProxy isWords: oop) + and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxDistanceCodes]) ifFalse: + [^false]. - oop := interpreterProxy fetchPointer: 12 ofObject: rcvr. - ((interpreterProxy isIntegerObject: oop) or:[ - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. - (interpreterProxy slotSizeOf: oop) = DeflateMaxDistanceCodes ifFalse:[^false]. zipDistanceFreq := interpreterProxy firstIndexableField: oop. + zipLiteralCount := interpreterProxy fetchInteger: writeStreamInstSize + 9 ofObject: rcvr. + zipMatchCount := interpreterProxy fetchInteger: writeStreamInstSize + 10 ofObject: rcvr. - zipLiteralCount := interpreterProxy fetchInteger: 13 ofObject: rcvr. - zipMatchCount := interpreterProxy fetchInteger: 14 ofObject: rcvr. ^interpreterProxy failed not! Item was changed: ----- Method: DeflatePlugin>>loadZipEncoderFrom: (in category 'primitive support') ----- loadZipEncoderFrom: rcvr | oop | <inline: false> + writeStreamInstSize = 0 ifTrue: + [(self determineSizeOfWriteStream: rcvr) ifFalse: + [^false]. + "If the receiver wasn't valid then we derived writeStreamInstSize from an invalid source. discard it." + (interpreterProxy slotSizeOf: rcvr) < (writeStreamInstSize + 3) ifTrue: + [writeStreamInstSize := 0. + ^false]]. + ((interpreterProxy isPointers: rcvr) + and: [(interpreterProxy slotSizeOf: rcvr) >= (writeStreamInstSize + 3)]) ifFalse: + [^false]. - ((interpreterProxy isPointers: rcvr) and:[ - (interpreterProxy slotSizeOf: rcvr) >= 6]) ifFalse:[^false]. oop := interpreterProxy fetchPointer: 0 ofObject: rcvr. + (interpreterProxy isBytes: oop) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isIntegerObject: oop) - ifTrue:[^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipCollection := interpreterProxy firstIndexableField: oop. zipCollectionSize := interpreterProxy byteSizeOf: oop. zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr. zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr. "zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr." + zipBitBuf := interpreterProxy fetchInteger: writeStreamInstSize + 1 ofObject: rcvr. + zipBitPos := interpreterProxy fetchInteger: writeStreamInstSize + 2 ofObject: rcvr. - zipBitBuf := interpreterProxy fetchInteger: 4 ofObject: rcvr. - zipBitPos := interpreterProxy fetchInteger: 5 ofObject: rcvr. ^interpreterProxy failed not! Item was changed: ----- Method: DeflatePlugin>>primitiveDeflateBlock (in category 'primitives') ----- primitiveDeflateBlock "Primitive. Deflate the current contents of the receiver." | goodMatch chainLength lastIndex rcvr result | <export: true> <inline: false> interpreterProxy methodArgumentCount = 3 ifFalse:[^interpreterProxy primitiveFail]. goodMatch := interpreterProxy stackIntegerValue: 0. chainLength := interpreterProxy stackIntegerValue: 1. lastIndex := interpreterProxy stackIntegerValue: 2. rcvr := interpreterProxy stackObjectValue: 3. interpreterProxy failed ifTrue:[^nil]. self cCode:'' inSmalltalk:[ zipMatchLengthCodes := CArrayAccessor on: ZipWriteStream matchLengthCodes. zipDistanceCodes := CArrayAccessor on: ZipWriteStream distanceCodes]. (self loadDeflateStreamFrom: rcvr) ifFalse:[^interpreterProxy primitiveFail]. result := self deflateBlock: lastIndex chainLength: chainLength goodMatch: goodMatch. interpreterProxy failed ifFalse:[ "Store back modified values" + interpreterProxy storeInteger: writeStreamInstSize + 2 ofObject: rcvr withValue: zipHashValue. + interpreterProxy storeInteger: writeStreamInstSize + 3 ofObject: rcvr withValue: zipBlockPos. + interpreterProxy storeInteger: writeStreamInstSize + 9 ofObject: rcvr withValue: zipLiteralCount. + interpreterProxy storeInteger: writeStreamInstSize + 10 ofObject: rcvr withValue: zipMatchCount]. - interpreterProxy storeInteger: 6 ofObject: rcvr withValue: zipHashValue. - interpreterProxy storeInteger: 7 ofObject: rcvr withValue: zipBlockPos. - interpreterProxy storeInteger: 13 ofObject: rcvr withValue: zipLiteralCount. - interpreterProxy storeInteger: 14 ofObject: rcvr withValue: zipMatchCount]. interpreterProxy failed ifFalse:[ interpreterProxy pop: 4. interpreterProxy pushBool: result. ].! Item was changed: ----- Method: DeflatePlugin>>primitiveUpdateAdler32 (in category 'primitives') ----- primitiveUpdateAdler32 "Primitive. Update a 32bit CRC value." | collection stopIndex startIndex length bytePtr s1 adler32 s2 b | <export: true> <var: #adler32 type:'unsigned int '> <var: #bytePtr type:'unsigned char *'> interpreterProxy methodArgumentCount = 4 ifFalse:[^interpreterProxy primitiveFail]. collection := interpreterProxy stackObjectValue: 0. stopIndex := interpreterProxy stackIntegerValue: 1. startIndex := interpreterProxy stackIntegerValue: 2. adler32 := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 3). interpreterProxy failed ifTrue:[^0]. ((interpreterProxy isBytes: collection) and:[stopIndex >= startIndex and:[startIndex > 0]]) ifFalse:[^interpreterProxy primitiveFail]. length := interpreterProxy byteSizeOf: collection. (stopIndex <= length) ifFalse:[^interpreterProxy primitiveFail]. bytePtr := interpreterProxy firstIndexableField: collection. startIndex := startIndex - 1. stopIndex := stopIndex - 1. s1 := adler32 bitAnd: 16rFFFF. s2 := (adler32 >> 16) bitAnd: 16rFFFF. startIndex to: stopIndex do:[:i| b := bytePtr at: i. s1 := (s1 + b) \\ 65521. s2 := (s2 + s1) \\ 65521. ]. adler32 := (s2 bitShift: 16) + s1. + interpreterProxy + pop: 5 "args + rcvr" + thenPush: (interpreterProxy positive32BitIntegerFor: adler32)! - interpreterProxy pop: 5. "args + rcvr" - interpreterProxy push: (interpreterProxy positive32BitIntegerFor: adler32).! Item was changed: ----- Method: DeflatePlugin>>primitiveUpdateGZipCrc32 (in category 'primitives') ----- primitiveUpdateGZipCrc32 "Primitive. Update a 32bit CRC value." | collection stopIndex startIndex crc length bytePtr | <export: true> + <var: #bytePtr type: #'unsigned char *'> - <var: #crc type:'unsigned int '> - <var: #bytePtr type:'unsigned char *'> - <var: #crcTable type:'unsigned int *'> interpreterProxy methodArgumentCount = 4 ifFalse:[^interpreterProxy primitiveFail]. collection := interpreterProxy stackObjectValue: 0. stopIndex := interpreterProxy stackIntegerValue: 1. startIndex := interpreterProxy stackIntegerValue: 2. crc := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 3). + interpreterProxy failed ifTrue: [^0]. - interpreterProxy failed ifTrue:[^0]. ((interpreterProxy isBytes: collection) and:[stopIndex >= startIndex and:[startIndex > 0]]) ifFalse:[^interpreterProxy primitiveFail]. length := interpreterProxy byteSizeOf: collection. (stopIndex <= length) ifFalse:[^interpreterProxy primitiveFail]. bytePtr := interpreterProxy firstIndexableField: collection. self cCode:'' inSmalltalk:[zipCrcTable := CArrayAccessor on: GZipWriteStream crcTable]. startIndex := startIndex - 1. stopIndex := stopIndex - 1. + startIndex to: stopIndex do: + [:i| + crc := (zipCrcTable at: ((crc bitXor: (bytePtr at: i)) bitAnd: 255)) bitXor: (crc >> 8)]. + interpreterProxy + pop: 5 "args + rcvr" + thenPush: (interpreterProxy positive32BitIntegerFor: crc)! - startIndex to: stopIndex do:[:i| - crc := (zipCrcTable at: ((crc bitXor: (bytePtr at: i)) bitAnd: 255)) bitXor: (crc >> 8). - ]. - interpreterProxy pop: 5. "args + rcvr" - interpreterProxy push: (interpreterProxy positive32BitIntegerFor: crc).! Item was changed: ----- Method: DeflatePlugin>>primitiveZipSendBlock (in category 'primitives') ----- primitiveZipSendBlock | distTree litTree distStream litStream rcvr result | <export: true> interpreterProxy methodArgumentCount = 4 ifFalse:[^interpreterProxy primitiveFail]. distTree := interpreterProxy stackObjectValue: 0. litTree := interpreterProxy stackObjectValue: 1. distStream := interpreterProxy stackObjectValue: 2. litStream := interpreterProxy stackObjectValue: 3. rcvr := interpreterProxy stackObjectValue: 4. interpreterProxy failed ifTrue:[^nil]. (self loadZipEncoderFrom: rcvr) ifFalse:[^interpreterProxy primitiveFail]. ((interpreterProxy isPointers: distTree) and:[ (interpreterProxy slotSizeOf: distTree) >= 2]) ifFalse:[^interpreterProxy primitiveFail]. ((interpreterProxy isPointers: litTree) and:[ (interpreterProxy slotSizeOf: litTree) >= 2]) ifFalse:[^interpreterProxy primitiveFail]. ((interpreterProxy isPointers: litStream) and:[ (interpreterProxy slotSizeOf: litStream) >= 3]) ifFalse:[^interpreterProxy primitiveFail]. ((interpreterProxy isPointers: distStream) and:[ (interpreterProxy slotSizeOf: distStream) >= 3]) ifFalse:[^interpreterProxy primitiveFail]. self cCode:'' inSmalltalk:[ zipMatchLengthCodes := CArrayAccessor on: ZipWriteStream matchLengthCodes. zipDistanceCodes := CArrayAccessor on: ZipWriteStream distanceCodes. zipExtraLengthBits := CArrayAccessor on: ZipWriteStream extraLengthBits. zipExtraDistanceBits := CArrayAccessor on: ZipWriteStream extraDistanceBits. zipBaseLength := CArrayAccessor on: ZipWriteStream baseLength. zipBaseDistance := CArrayAccessor on: ZipWriteStream baseDistance]. result := self sendBlock: litStream with: distStream with: litTree with: distTree. interpreterProxy failed ifFalse:[ interpreterProxy storeInteger: 1 ofObject: rcvr withValue: zipPosition. + interpreterProxy storeInteger: readStreamInstSize + 1 ofObject: rcvr withValue: zipBitBuf. + interpreterProxy storeInteger: readStreamInstSize + 2 ofObject: rcvr withValue: zipBitPos. - interpreterProxy storeInteger: 4 ofObject: rcvr withValue: zipBitBuf. - interpreterProxy storeInteger: 5 ofObject: rcvr withValue: zipBitPos. ]. interpreterProxy failed ifFalse:[ interpreterProxy pop: 5. "rcvr + args" interpreterProxy pushInteger: result. ].! Item was changed: ----- Method: DeflatePlugin>>sendBlock:with:with:with: (in category 'encoding') ----- sendBlock: literalStream with: distanceStream with: litTree with: distTree "Require: zipCollection, zipCollectionSize, zipPosition, zipBitBuf, zipBitPos. " | oop litPos litLimit litArray distArray lit dist sum llBitLengths llCodes distBitLengths distCodes code extra litBlCount distBlCount | + <var: #litArray type: #'unsigned char *'> + <var: #distArray type: #'unsigned int *'> + <var: #llBitLengths type: #'unsigned int *'> + <var: #llCodes type: #'unsigned int *'> + <var: #distBitLengths type: #'unsigned int *'> + <var: #distCodes type: #'unsigned int *'> - <var: #litArray type:'unsigned char *'> - <var: #distArray type:'unsigned int *'> - <var: #llBitLengths type:'unsigned int *'> - <var: #llCodes type:'unsigned int *'> - <var: #distBitLengths type:'unsigned int *'> - <var: #distCodes type:'unsigned int *'> oop := interpreterProxy fetchPointer: 0 ofObject: literalStream. litPos := interpreterProxy fetchInteger: 1 ofObject: literalStream. litLimit := interpreterProxy fetchInteger: 2 ofObject: literalStream. + (litPos <= litLimit + and: [(interpreterProxy isBytes: oop) + and: [litLimit <= (interpreterProxy byteSizeOf: oop)]]) ifFalse: + [^interpreterProxy primitiveFail]. - ((interpreterProxy isIntegerObject: oop) not and:[litPos <= litLimit and:[ - litLimit <= (interpreterProxy byteSizeOf: oop) and:[interpreterProxy isBytes: oop]]]) - ifFalse:[^interpreterProxy primitiveFail]. litArray := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 0 ofObject: distanceStream. + ((interpreterProxy isWords: oop) + and: [litLimit <= (interpreterProxy slotSizeOf: oop) + and: [(interpreterProxy fetchInteger: 1 ofObject: distanceStream) = litPos + and: [(interpreterProxy fetchInteger: 2 ofObject: distanceStream) = litLimit]]]) ifFalse: + [^interpreterProxy primitiveFail]. - ((interpreterProxy isIntegerObject: oop) not and:[ - (interpreterProxy fetchInteger: 1 ofObject: distanceStream) = litPos and:[ - (interpreterProxy fetchInteger: 2 ofObject: distanceStream) = litLimit]]) - ifFalse:[^interpreterProxy primitiveFail]. - ((interpreterProxy isWords: oop) and:[ - litLimit <= (interpreterProxy slotSizeOf: oop)]) - ifFalse:[^interpreterProxy primitiveFail]. distArray := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 0 ofObject: litTree. + (interpreterProxy isWords: oop) ifFalse: + [^interpreterProxy primitiveFail]. - ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop]) - ifFalse:[^interpreterProxy primitiveFail]. litBlCount := interpreterProxy slotSizeOf: oop. llBitLengths := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 1 ofObject: litTree. + ((interpreterProxy isWords: oop) + and: [litBlCount = (interpreterProxy slotSizeOf: oop)]) ifFalse: + [^interpreterProxy primitiveFail]. - ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop]) - ifFalse:[^interpreterProxy primitiveFail]. - (litBlCount = (interpreterProxy slotSizeOf: oop)) - ifFalse:[^interpreterProxy primitiveFail]. llCodes := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 0 ofObject: distTree. + (interpreterProxy isWords: oop) ifFalse: + [^interpreterProxy primitiveFail]. - ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop]) - ifFalse:[^interpreterProxy primitiveFail]. distBlCount := interpreterProxy slotSizeOf: oop. distBitLengths := interpreterProxy firstIndexableField: oop. oop := interpreterProxy fetchPointer: 1 ofObject: distTree. + ((interpreterProxy isWords: oop) + and: [distBlCount = (interpreterProxy slotSizeOf: oop)]) ifFalse: + [^interpreterProxy primitiveFail]. - ((interpreterProxy isIntegerObject: oop) not and:[interpreterProxy isWords: oop]) - ifFalse:[^interpreterProxy primitiveFail]. - (distBlCount = (interpreterProxy slotSizeOf: oop)) - ifFalse:[^interpreterProxy primitiveFail]. distCodes := interpreterProxy firstIndexableField: oop. - interpreterProxy failed ifTrue:[^nil]. - self nextZipBits: 0 put: 0. "Flush pending bits if necessary" sum := 0. [litPos < litLimit and:[zipPosition + 4 < zipCollectionSize]] whileTrue:[ lit := litArray at: litPos. dist := distArray at: litPos. litPos := litPos + 1. dist = 0 ifTrue:["literal" sum := sum + 1. lit < litBlCount ifFalse:[^interpreterProxy primitiveFail]. self nextZipBits: (llBitLengths at: lit) put: (llCodes at: lit). ] ifFalse:["match" sum := sum + lit + DeflateMinMatch. lit < 256 ifFalse:[^interpreterProxy primitiveFail]. code := zipMatchLengthCodes at: lit. code < litBlCount ifFalse:[^interpreterProxy primitiveFail]. self nextZipBits: (llBitLengths at: code) put: (llCodes at: code). extra := zipExtraLengthBits at: code - 257. extra = 0 ifFalse:[ lit := lit - (zipBaseLength at: code - 257). self nextZipBits: extra put: lit]. dist := dist - 1. dist < 16r8000 ifFalse:[^interpreterProxy primitiveFail]. dist < 256 ifTrue:[code := zipDistanceCodes at: dist] ifFalse:[code := zipDistanceCodes at: 256 + (dist >> 7)]. code < distBlCount ifFalse:[^interpreterProxy primitiveFail]. self nextZipBits: (distBitLengths at: code) put: (distCodes at: code). extra := zipExtraDistanceBits at: code. extra = 0 ifFalse:[ dist := dist - (zipBaseDistance at: code). self nextZipBits: extra put: dist]. ]. ]. interpreterProxy failed ifTrue:[^nil]. interpreterProxy storeInteger: 1 ofObject: literalStream withValue: litPos. interpreterProxy storeInteger: 1 ofObject: distanceStream withValue: litPos. ^sum! Item was changed: InterpreterPlugin subclass: #InflatePlugin + instanceVariableNames: 'zipCollection zipReadLimit zipPosition zipState zipBitBuf zipBitPos zipSource zipSourcePos zipSourceLimit zipLitTable zipDistTable zipCollectionSize zipLitTableSize zipDistTableSize readStreamInstSize' - instanceVariableNames: 'zipCollection zipReadLimit zipPosition zipState zipBitBuf zipBitPos zipSource zipSourcePos zipSourceLimit zipLitTable zipDistTable zipCollectionSize zipLitTableSize zipDistTableSize' classVariableNames: 'MaxBits StateNoMoreData' poolDictionaries: '' category: 'VMMaker-Plugins'! !InflatePlugin commentStamp: '<historical>' prior: 0! This plugin implements the one crucial function for efficiently decompressing streams.! Item was added: + ----- Method: InflatePlugin class>>simulatorClass (in category 'simulation') ----- + simulatorClass + "For running from Smalltalk - answer a class that can be used to simulate the receiver, + or nil if you want the primitives in this module to always fail, causing simulation to fall + through to the Smalltalk code. By default every non-TestInterpreterPlugin can simulate itself." + + ^DeflatePlugin! Item was added: + ----- Method: InflatePlugin>>determineSizeOfReadStream: (in category 'primitive support') ----- + determineSizeOfReadStream: rcvr + "Determine the inst size of the class above DeflateStream by + looking for the first class whose inst size is less than 13." + | class | + class := interpreterProxy fetchClassOf: rcvr. + [class ~= interpreterProxy nilObject + and: [(interpreterProxy instanceSizeOf: class) >= 13]] whileTrue: + [class := interpreterProxy superclassOf: class]. + class = interpreterProxy nilObject ifTrue: + [^false]. + readStreamInstSize := interpreterProxy instanceSizeOf: class. + ^true! Item was changed: ----- Method: InflatePlugin>>primitiveInflateDecompressBlock (in category 'primitives') ----- primitiveInflateDecompressBlock "Primitive. Inflate a single block." | oop rcvr | <export: true> + interpreterProxy methodArgumentCount = 2 ifFalse: + [^interpreterProxy primitiveFail]. - interpreterProxy methodArgumentCount = 2 ifFalse:[^interpreterProxy primitiveFail]. "distance table" + oop := interpreterProxy stackValue: 0. + (interpreterProxy isWords: oop) ifFalse: + [^interpreterProxy primitiveFail]. - oop := interpreterProxy stackObjectValue: 0. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy isWords: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipDistTable := interpreterProxy firstIndexableField: oop. zipDistTableSize := interpreterProxy slotSizeOf: oop. "literal table" + oop := interpreterProxy stackValue: 1. + (interpreterProxy isWords: oop) ifFalse: + [^interpreterProxy primitiveFail]. - oop := interpreterProxy stackObjectValue: 1. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy isWords: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipLitTable := interpreterProxy firstIndexableField: oop. zipLitTableSize := interpreterProxy slotSizeOf: oop. "Receiver (InflateStream)" + rcvr := interpreterProxy stackValue: 2. + (interpreterProxy isPointers: rcvr) ifFalse: + [^interpreterProxy primitiveFail]. - rcvr := interpreterProxy stackObjectValue: 2. - interpreterProxy failed ifTrue:[^nil]. - (interpreterProxy isPointers: rcvr) - ifFalse:[^interpreterProxy primitiveFail]. - (interpreterProxy slotSizeOf: rcvr) < 9 - ifTrue:[^interpreterProxy primitiveFail]. - "All the integer instvars" + readStreamInstSize = 0 ifTrue: + [(self determineSizeOfReadStream: rcvr) ifFalse: + [^interpreterProxy primitiveFail]. + "If the receiver wasn't valid then we derived readStreamInstSize from an invalid source. discard it." + (interpreterProxy slotSizeOf: rcvr) < (readStreamInstSize + 8) ifTrue: + [readStreamInstSize := 0. + ^interpreterProxy primitiveFail]]. + (interpreterProxy slotSizeOf: rcvr) < (readStreamInstSize + 8) ifTrue: + [^interpreterProxy primitiveFail]. + zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr. + zipState := interpreterProxy fetchInteger: readStreamInstSize + 0 ofObject: rcvr. + zipBitBuf := interpreterProxy fetchInteger: readStreamInstSize + 1 ofObject: rcvr. + zipBitPos := interpreterProxy fetchInteger: readStreamInstSize + 2 ofObject: rcvr. + zipSourcePos := interpreterProxy fetchInteger: readStreamInstSize + 4 ofObject: rcvr. + zipSourceLimit := interpreterProxy fetchInteger: readStreamInstSize + 5 ofObject: rcvr. - zipState := interpreterProxy fetchInteger: 3 ofObject: rcvr. - zipBitBuf := interpreterProxy fetchInteger: 4 ofObject: rcvr. - zipBitPos := interpreterProxy fetchInteger: 5 ofObject: rcvr. - zipSourcePos := interpreterProxy fetchInteger: 7 ofObject: rcvr. - zipSourceLimit := interpreterProxy fetchInteger: 8 ofObject: rcvr. interpreterProxy failed ifTrue:[^nil]. zipReadLimit := zipReadLimit - 1. zipSourcePos := zipSourcePos - 1. zipSourceLimit := zipSourceLimit - 1. "collection" oop := interpreterProxy fetchPointer: 0 ofObject: rcvr. + (interpreterProxy isBytes: oop) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isIntegerObject: oop) - ifTrue:[^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipCollection := interpreterProxy firstIndexableField: oop. zipCollectionSize := interpreterProxy byteSizeOf: oop. "source" + oop := interpreterProxy fetchPointer: readStreamInstSize + 3 ofObject: rcvr. + (interpreterProxy isBytes: oop) ifFalse: + [^interpreterProxy primitiveFail]. - oop := interpreterProxy fetchPointer: 6 ofObject: rcvr. - (interpreterProxy isIntegerObject: oop) - ifTrue:[^interpreterProxy primitiveFail]. - (interpreterProxy isBytes: oop) - ifFalse:[^interpreterProxy primitiveFail]. zipSource := interpreterProxy firstIndexableField: oop. "do the primitive" self zipDecompressBlock. + interpreterProxy failed ifFalse: "store modified values back" + [interpreterProxy storeInteger: 2 ofObject: rcvr withValue: zipReadLimit + 1. + interpreterProxy storeInteger: readStreamInstSize + 0 ofObject: rcvr withValue: zipState. + interpreterProxy storeInteger: readStreamInstSize + 1 ofObject: rcvr withValue: zipBitBuf. + interpreterProxy storeInteger: readStreamInstSize + 2 ofObject: rcvr withValue: zipBitPos. + interpreterProxy storeInteger: readStreamInstSize + 4 ofObject: rcvr withValue: zipSourcePos + 1. + interpreterProxy pop: 2]! - interpreterProxy failed ifFalse:[ - "store modified values back" - interpreterProxy storeInteger: 2 ofObject: rcvr withValue: zipReadLimit + 1. - interpreterProxy storeInteger: 3 ofObject: rcvr withValue: zipState. - interpreterProxy storeInteger: 4 ofObject: rcvr withValue: zipBitBuf. - interpreterProxy storeInteger: 5 ofObject: rcvr withValue: zipBitPos. - interpreterProxy storeInteger: 7 ofObject: rcvr withValue: zipSourcePos + 1. - interpreterProxy pop: 2. - ].! Item was changed: ----- Method: VMMaker class>>versionString (in category 'version testing') ----- versionString "VMMaker versionString" + ^'4.13.6'! - ^'4.13.5'!

1 0

VM Maker: VMMaker.oscog-eem.829.mcz
by commits＠source.squeak.org 20 Jul '14

20 Jul '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.829.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.829 Author: eem Time: 19 July 2014, 12:52:08.556 pm UUID: 001843e1-2851-457f-b750-16e46963fa47 Ancestors: VMMaker.oscog-eem.828 Add vmParameter 52 to answer the capacity of the root table (in Spur a.k.a. the rememberedSet). Delete all the explicit initializing to nil in primitiveVMParameter since the array is instantiated normally (filled with nil). =============== Diff against VMMaker.oscog-eem.828 =============== Item was added: + ----- Method: ObjectMemory>>rootTableCapacity (in category 'interpreter access') ----- + rootTableCapacity + ^RootTableSize! Item was added: + ----- Method: SpurMemoryManager>>rootTableCapacity (in category 'scavenger') ----- + rootTableCapacity + ^self numSlotsOf: self rememberedSetObj! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') ----- (excessive size, no diff calculated)

1 0

VM Maker: VMMaker.oscog-eem.829.mcz
by commits＠source.squeak.org 20 Jul '14

20 Jul '14

1 0

VM Maker: VMMaker.oscog-eem.828.mcz
by commits＠source.squeak.org 20 Jul '14

20 Jul '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.828.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.828 Author: eem Time: 19 July 2014, 12:32:26.551 pm UUID: 54a0b096-54ef-4c86-a382-d413bf54329d Ancestors: VMMaker.oscog-eem.827 Spur: Make sure to abort if the attempt to grow the remembered set fails. Try to grow by another 1k slots if doubling fails, then abort. Change the defaultEdenBytes to 4Mb. =============== Diff against VMMaker.oscog-eem.827 =============== Item was changed: ----- Method: SpurGenerationScavenger>>growRememberedSet (in category 'store check') ----- growRememberedSet | obj numSlots newObj base | <inline: false> "Don't ruin locality in remember:" <var: #base type: #'sqInt *'> obj := manager rememberedSetObj. numSlots := manager numSlotsOf: obj. self assert: numSlots >= 1024. newObj := manager allocatePinnedSlots: numSlots * 2. + newObj ifNil: + [newObj := manager allocatePinnedSlots: numSlots + 1024. + newObj ifNil: + [self error: 'could not grow remembered set']]. manager rememberedSetObj: newObj. base := manager firstIndexableField: newObj. 0 to: rememberedSetSize - 1 do: [:i| base at: i put: (rememberedSet at: i)]. "if growing in the middle of a GC, need to preserve marked status." (manager isMarked: obj) ifTrue: [manager setIsMarkedOf: newObj to: true; setIsMarkedOf: obj to: false]. manager freeObject: obj. rememberedSet := base. rememberedSetLimit := numSlots * 2. rememberedSetRedZone := rememberedSetLimit * 3 + 3 // 4! Item was changed: ----- Method: SpurMemoryManager>>defaultEdenBytes (in category 'snapshot') ----- defaultEdenBytes + "Answer the default amount of memory to allocate for the eden space. + The actual value can be set via vmParameterAt: and/or a preference in the ini file. + The shootout tests seem to plateau at 5 or 6Mb" - "Return the default amount of memory to allocate for the eden space. - The actual value can be set via vmParameterAt: and/or a preference in the ini file." <inline: false> + ^4 * 1024 * 1024! - ^2 * 1024 * 1024!

1 0

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

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 July 2014