Vm-dev February 2014

vm-dev@lists.squeakfoundation.org

33 participants
83 discussions

VM Maker: VMMaker.oscog-eem.611.mcz
by commits＠source.squeak.org 07 Feb '14

07 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.611.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.611 Author: eem Time: 6 February 2014, 5:34:59.528 pm UUID: 83908c61-3751-4074-b6e6-e5283e45f50f Ancestors: VMMaker.oscog-eem.610 Fix slip in StackInterpreter>>postBecomeAction:. Must follow receivers after every become (even if become effects flags are 0) since e.g. a becommed string can be the receiver in a super send, and so, because super sends don't trap, must be unforwarded. Add some asserts to catch this error in *activateNewMethod & slowPrimitiveResponse. =============== Diff against VMMaker.oscog-eem.610 =============== Item was changed: ----- Method: CoInterpreter>>activateNewMethod (in category 'message sending') ----- activateNewMethod | methodHeader numArgs numTemps rcvr errorCode inInterpreter switched | methodHeader := self headerOf: newMethod. numTemps := self temporaryCountOfMethodHeader: methodHeader. numArgs := self argumentCountOfMethodHeader: methodHeader. rcvr := self stackValue: numArgs. "could new rcvr be set at point of send?" + self assert: (objectMemory isOopForwarded: rcvr) not. "Because this is an uncogged method we need to continue via the interpreter. We could have been reached either from the interpreter, in which case we should simply return, or from a machine code frame or from a compiled primitive. In these latter two cases we must longjmp back to the interpreter. The instructionPointer tells us which path we took. If the sender was an interpreter frame but called through a (failing) primitive then make sure we restore the saved instruction pointer and avoid pushing ceReturnToInterpreterPC which is only valid between an interpreter caller frame and a machine code callee frame." (inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse: [instructionPointer = cogit ceReturnToInterpreterPC ifTrue: [instructionPointer := self iframeSavedIP: framePointer]]. self push: instructionPointer. self push: framePointer. framePointer := stackPointer. self push: newMethod. self setMethod: newMethod methodHeader: methodHeader. self push: objectMemory nilObject. "FxThisContext field" self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs). self push: 0. "FoxIFSavedIP" self push: rcvr. "clear remaining temps to nil" numArgs+1 to: numTemps do: [:i | self push: objectMemory nilObject]. instructionPointer := (self initialPCForHeader: methodHeader method: newMethod) - 1. (self methodHeaderHasPrimitive: methodHeader) ifTrue: ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts with a long store temp. Strictly no need to skip the store because it's effectively a noop." instructionPointer := instructionPointer + (self sizeOfCallPrimitiveBytecode: methodHeader). primFailCode ~= 0 ifTrue: [(objectMemory byteAt: instructionPointer + 1) = (self longStoreBytecodeForHeader: methodHeader) ifTrue: [errorCode := self getErrorObjectFromPrimFailCode. self stackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"]. primFailCode := 0]]. "Now check for stack overflow or an event (interrupt, must scavenge, etc)." switched := true. stackPointer < stackLimit ifTrue: [switched := self handleStackOverflowOrEventAllowContextSwitch: (self canContextSwitchIfActivating: newMethod header: methodHeader)]. self returnToExecutive: inInterpreter postContextSwitch: switched! Item was changed: ----- Method: CoInterpreter>>internalActivateNewMethod (in category 'message sending') ----- internalActivateNewMethod | methodHeader numTemps rcvr errorCode switched | <inline: true> methodHeader := self rawHeaderOf: newMethod. self assert: (self isCogMethodReference: methodHeader) not. numTemps := self temporaryCountOfMethodHeader: methodHeader. rcvr := self internalStackValue: argumentCount. "could new rcvr be set at point of send?" + self assert: (objectMemory isOopForwarded: rcvr) not. self internalPush: localIP. self internalPush: localFP. localFP := localSP. self internalPush: newMethod. self setMethod: newMethod methodHeader: methodHeader. self internalPush: objectMemory nilObject. "FxThisContext field" self internalPush: (self encodeFrameFieldHasContext: false isBlock: false numArgs: (self argumentCountOfMethodHeader: methodHeader)). self internalPush: 0. "FoxIFSavedIP" self internalPush: rcvr. "Initialize temps..." argumentCount + 1 to: numTemps do: [:i | self internalPush: objectMemory nilObject]. "-1 to account for pre-increment in fetchNextBytecode" localIP := self pointerForOop: (self initialPCForHeader: methodHeader method: newMethod) - 1. (self methodHeaderHasPrimitive: methodHeader) ifTrue: ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts with a long store temp. Strictly no need to skip the store because it's effectively a noop." localIP := localIP + (self sizeOfCallPrimitiveBytecode: methodHeader). primFailCode ~= 0 ifTrue: [(objectMemory byteAt: localIP + 1) = (self longStoreBytecodeForHeader: methodHeader) ifTrue: [errorCode := self getErrorObjectFromPrimFailCode. self internalStackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"]. primFailCode := 0]]. self assert: (self frameNumArgs: localFP) == argumentCount. self assert: (self frameIsBlockActivation: localFP) not. self assert: (self frameHasContext: localFP) not. "Now check for stack overflow or an event (interrupt, must scavenge, etc)." localSP < stackLimit ifTrue: [self externalizeIPandSP. switched := self handleStackOverflowOrEventAllowContextSwitch: (self canContextSwitchIfActivating: newMethod header: methodHeader). self returnToExecutive: true postContextSwitch: switched. self internalizeIPandSP]! Item was changed: ----- Method: CoInterpreter>>justActivateNewMethod (in category 'message sending') ----- justActivateNewMethod | methodHeader activateCogMethod cogMethod numArgs numTemps rcvr errorCode initialIP | <var: #cogMethod type: #'CogMethod *'> <var: #initialIP type: #usqInt> <inline: true> methodHeader := self rawHeaderOf: newMethod. (activateCogMethod := self isCogMethodReference: methodHeader) ifTrue: [cogMethod := self cCoerceSimple: methodHeader to: #'CogMethod *'. methodHeader := cogMethod methodHeader]. numTemps := self temporaryCountOfMethodHeader: methodHeader. numArgs := self argumentCountOfMethodHeader: methodHeader. rcvr := self stackValue: numArgs. "could new rcvr be set at point of send?" + self assert: (objectMemory isOopForwarded: rcvr) not. (activateCogMethod and: [instructionPointer >= objectMemory startOfMemory]) ifTrue: [self iframeSavedIP: framePointer put: instructionPointer. instructionPointer := cogit ceReturnToInterpreterPC]. self push: instructionPointer. self push: framePointer. framePointer := stackPointer. initialIP := self initialPCForHeader: methodHeader method: newMethod. activateCogMethod ifTrue: [self push: cogMethod asUnsignedInteger. self push: objectMemory nilObject. "FoxThisContext field" instructionPointer := cogMethod asUnsignedInteger + cogMethod stackCheckOffset] ifFalse: [self push: newMethod. self setMethod: newMethod methodHeader: methodHeader. self push: objectMemory nilObject. "FoxThisContext field" self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs). self push: 0. "FoxIFSavedIP" instructionPointer := initialIP - 1]. self push: rcvr. "clear remaining temps to nil" numArgs+1 to: numTemps do: [:i | self push: objectMemory nilObject]. (self methodHeaderHasPrimitive: methodHeader) ifTrue: ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts with a long store temp. Strictly no need to skip the store because it's effectively a noop." initialIP := initialIP + (self sizeOfCallPrimitiveBytecode: methodHeader). activateCogMethod ifFalse: [instructionPointer := initialIP]. primFailCode ~= 0 ifTrue: [(objectMemory byteAt: initialIP + 1) = (self longStoreBytecodeForHeader: methodHeader) ifTrue: [errorCode := self getErrorObjectFromPrimFailCode. self stackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"]. primFailCode := 0]]. ^methodHeader! Item was changed: ----- Method: StackInterpreter>>internalActivateNewMethod (in category 'message sending') ----- internalActivateNewMethod | methodHeader numTemps rcvr errorCode | <inline: true> methodHeader := self headerOf: newMethod. numTemps := self temporaryCountOfMethodHeader: methodHeader. rcvr := self internalStackValue: argumentCount. "could new rcvr be set at point of send?" + self assert: (objectMemory isOopForwarded: rcvr) not. self internalPush: localIP. self internalPush: localFP. localFP := localSP. self internalPush: newMethod. self setMethod: newMethod methodHeader: methodHeader. self internalPush: (self encodeFrameFieldHasContext: false isBlock: false numArgs: (self argumentCountOfMethodHeader: methodHeader)). self internalPush: objectMemory nilObject. "FxThisContext field" self internalPush: rcvr. "Initialize temps..." argumentCount + 1 to: numTemps do: [:i | self internalPush: objectMemory nilObject]. "-1 to account for pre-increment in fetchNextBytecode" localIP := self pointerForOop: (self initialPCForHeader: methodHeader method: newMethod) - 1. (self methodHeaderHasPrimitive: methodHeader) ifTrue: ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts with a long store temp. Strictly no need to skip the store because it's effectively a noop." localIP := localIP + (self sizeOfCallPrimitiveBytecode: methodHeader). primFailCode ~= 0 ifTrue: [(objectMemory byteAt: localIP + 1) = (self longStoreBytecodeForHeader: methodHeader) ifTrue: [errorCode := self getErrorObjectFromPrimFailCode. self internalStackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"]. primFailCode := 0]]. self assert: (self frameNumArgs: localFP) == argumentCount. self assert: (self frameIsBlockActivation: localFP) not. self assert: (self frameHasContext: localFP) not. "Now check for stack overflow or an event (interrupt, must scavenge, etc)." localSP < stackLimit ifTrue: [self externalizeIPandSP. self handleStackOverflowOrEventAllowContextSwitch: (self canContextSwitchIfActivating: newMethod header: methodHeader). self internalizeIPandSP]! Item was changed: ----- Method: StackInterpreter>>justActivateNewMethod (in category 'message sending') ----- justActivateNewMethod | methodHeader numArgs numTemps rcvr errorCode | <inline: true> methodHeader := self headerOf: newMethod. numTemps := self temporaryCountOfMethodHeader: methodHeader. numArgs := self argumentCountOfMethodHeader: methodHeader. rcvr := self stackValue: numArgs. "could new rcvr be set at point of send?" + self assert: (objectMemory isOopForwarded: rcvr) not. self push: instructionPointer. self push: framePointer. framePointer := stackPointer. self push: newMethod. self setMethod: newMethod methodHeader: methodHeader. self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs). self push: objectMemory nilObject. "FxThisContext field" self push: rcvr. "clear remaining temps to nil" numArgs+1 to: numTemps do: [:i | self push: objectMemory nilObject]. instructionPointer := (self initialPCForHeader: methodHeader method: newMethod) - 1. (self methodHeaderHasPrimitive: methodHeader) ifTrue: ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts with a long store temp. Strictly no need to skip the store because it's effectively a noop." instructionPointer := instructionPointer + (self sizeOfCallPrimitiveBytecode: methodHeader). primFailCode ~= 0 ifTrue: [(objectMemory byteAt: instructionPointer + 1) = (self longStoreBytecodeForHeader: methodHeader) ifTrue: [errorCode := self getErrorObjectFromPrimFailCode. self stackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"]. primFailCode := 0]]. ^methodHeader! Item was changed: ----- Method: StackInterpreter>>postBecomeAction: (in category 'object memory support') ----- postBecomeAction: theBecomeEffectsFlags + "Insulate the stack zone from the effects of a become. + All receivers must be unfollowed for two reasons: + 1. inst var access is direct with no read barrier + 2. super sends (always to the receiver) have no class check and so don't trap + for forwarded receivers. + Methods must be unfollowed since bytecode access is direct with no read barrier. + But this only needs to be done if the becomeEffectsFlags indicate that a + CompiledMethod was becommed. + The sceduler state must be followed, but only if the becomeEffectsFlags indicate + that a pointer object was becommed." + self followForwardingPointersInStackZone: theBecomeEffectsFlags. theBecomeEffectsFlags ~= 0 ifTrue: + [(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue: - [self followForwardingPointersInStackZone: theBecomeEffectsFlags. - (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue: [self followForwardedMethodsInMethodCache. self followForwardedMethodsInMethodZone]. "for CoInterpreter" self followForwardingPointersInScheduler]! Item was changed: ----- Method: StackInterpreter>>slowPrimitiveResponse (in category 'primitive support') ----- slowPrimitiveResponse "Invoke a normal (non-quick) primitive. Called under the assumption that primFunctionPointer has been preloaded." | nArgs savedFramePointer savedStackPointer | <inline: true> <asmLabel: false> <var: #savedFramePointer type: #'char *'> <var: #savedStackPointer type: #'char *'> + self assert: (objectMemory isOopForwarded: (self stackValue: argumentCount)) not. FailImbalancedPrimitives ifTrue: [nArgs := argumentCount. savedStackPointer := stackPointer. savedFramePointer := framePointer]. self initPrimCall. self dispatchFunctionPointer: primitiveFunctionPointer. "In Spur a primitive may fail due to encountering a forwarder. On failure check the accessorDepth for the primitive and if non-negative scan the args to the depth, following any forwarders. Retry the primitive if any are found." (objectMemory hasSpurMemoryManagerAPI and: [self successful not and: [(objectMemory isOopCompiledMethod: newMethod) and: [self checkForAndFollowForwardedPrimitiveState]]]) ifTrue: [self initPrimCall. self dispatchFunctionPointer: primitiveFunctionPointer]. (FailImbalancedPrimitives and: [self successful and: [framePointer = savedFramePointer and: [(self isMachineCodeFrame: framePointer) not]]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:" [stackPointer ~= (savedStackPointer + (nArgs * BytesPerWord)) ifTrue: [self flag: 'Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context'. "This is necessary but insufficient; the result may still have been written to the stack. At least we'll know something is wrong." stackPointer := savedStackPointer. self failUnbalancedPrimitive]]. "If we are profiling, take accurate primitive measures" nextProfileTick > 0 ifTrue: [self checkProfileTick: newMethod]. ^self successful!

1 0

One cannot pass Morphic event's along the Morhp chain from the simulation host World to the running simulation on the target World.
by gettimothy 07 Feb '14

07 Feb '14

I have some questions on how to proceed at the bottom of this post. In the host simulation environment, one cannot interact with the running simulation using the standard Morphic "event chain". One cannot do so because from the host environment, there is no World in the simulation; there is only a painted picture of a World. The key to seeing this is to grok what a running simulation actually is. StackInterpreterSimulator >> run "..simulation setup code.." [true] whileTrue: [self assertValidExecutionPointers. atEachStepBlock value. "N.B. may be nil" self dispatchOn: currentBytecode in: BytecodeTable. self incrementByteCount]. "..we never get here..." There is no 'hook' for me to chain the Morphic event's down into, there are only bytecodes being fetched and executed . (which is totally cool and awesome, btw). Those bytecodes paint a pretty picture on an ImageMorph placed on a Frame placed within a SystemWindow as seen here in StackInterpreterSimulater >> openAsMorph "...." window addMorph: (displayView := ImageMorph new image: displayForm) frame: (0@0 corner: 1(a)0.8). "...." That image is not a PasteUpMorph named TheWorld that can respond to events--it is just a pretty picture. That ladies and gentleman is the point where us fat and coddled coder Hobbit's have to enter the dragon's cave, leaving the comfortable environment of the Squeak API for whatever strange and dangerous world lies below; Me? I decided to post here instead before venturing in (: So, having learned this the hard way, there are a couple of strategies I could take--RFB, or maybe Nebraska-- to get events over to the target image but before doing that I have to ask is it really necessary? My goal is to port the StackInterpeter to native 64 (and after that 64x64). Presumably Eliot managed to do the original work without the use of direct interaction with morphic on the running world, so shouldn't my task now be to emulate whatever techiques Eliot uses? If so, that raises the final point. What exactly are those techniques? Specifically, given a running simulation, how does one produce a new VM? Do we boot up the target image on which we have developed and run VMMaker the standard way? Finally, direct interaction with the runnig simulation world is desirable, I will be happy to implement it. Just please inform me of what strategy you would prefer and I will try to get it done. Thank you for your time.

8 35

VM Maker: Cog-eem.134.mcz
by commits＠source.squeak.org 07 Feb '14

07 Feb '14

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.134.mcz ==================== Summary ==================== Name: Cog-eem.134 Author: eem Time: 6 February 2014, 3:11:45.304 pm UUID: 0c1023d1-6676-4f09-a5e0-f80c13b6d2c7 Ancestors: Cog-eem.133 Spur bootstrap: Fix selectors of replacement methods; these used to be a string containing ClassPROTOTYPEselector... Add WideString at: & at:put: primitives. =============== Diff against Cog-eem.133 =============== Item was added: + ----- Method: SpurBootstrap class>>WideStringPROTOTYPEat: (in category 'method prototypes') ----- + WideStringPROTOTYPEat: index + "Answer the Character stored in the field of the receiver indexed by the + argument. Primitive. Fail if the index argument is not an Integer or is out + of bounds. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 63> + ^index isInteger + ifTrue: + [self errorSubscriptBounds: index] + ifFalse: + [index isNumber + ifTrue: [self at: index asInteger] + ifFalse: [self errorNonIntegerIndex]]! Item was added: + ----- Method: SpurBootstrap class>>WideStringPROTOTYPEat:put: (in category 'method prototypes') ----- + WideStringPROTOTYPEat: index put: aCharacter + "Store the Character into the field of the receiver indicated by the index. + Primitive. Fail if the index is not an Integer or is out of bounds, or if the + argument is not a Character. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 64> + ^aCharacter isCharacter + ifTrue: + [index isInteger + ifTrue: [self errorSubscriptBounds: index] + ifFalse: [self errorNonIntegerIndex]] + ifFalse: + [self errorImproperStore]! Item was changed: ----- Method: SpurBootstrap>>installableMethodFor:selector:className:isMeta: (in category 'bootstrap methods') ----- installableMethodFor: aCompiledMethod selector: selector className: className isMeta: isMeta + "Create a sourceless method to install in the bootstrapped image. It will allow the + bootstrap to limp along until the relevant transformed Monticello package is loaded." + | compiledMethodClass sourcelessMethod bytes newMethod | - | compiledMethodClass sourcelessMethod bytes newMethod methodClass | compiledMethodClass := self findClassNamed: (self findSymbol: #CompiledMethod). + "the prototypes have source pointers. the Character methods to be replaced don't." - "the prototypes hve source pointers. the Character methods to be replaced don't." sourcelessMethod := aCompiledMethod trailer hasSourcePointer ifTrue: [aCompiledMethod copyWithTempsFromMethodNode: aCompiledMethod methodNode] ifFalse: [aCompiledMethod]. bytes := sourcelessMethod size - sourcelessMethod initialPC + 1. newMethod := self interpreter: oldInterpreter object: compiledMethodClass perform: (self findSymbol: #newMethod:header:) withArguments: { oldHeap integerObjectOf: bytes. oldHeap integerObjectOf: sourcelessMethod header }. + 1 to: sourcelessMethod numLiterals - 2 do: - 1 to: sourcelessMethod numLiterals - 1 do: [:i| | literal oop | literal := sourcelessMethod literalAt: i. - literal isMethodProperties ifTrue: - [literal := selector]. oop := (literal isLiteral or: [literal isVariableBinding]) ifTrue: [literal isInteger ifTrue: [oldHeap integerObjectOf: literal] ifFalse: [literalMap at: literal ifAbsent: [self findLiteral: literal]]] ifFalse: "should be a VMObjectProxy" [literal oop]. oldHeap storePointer: i ofObject: newMethod withValue: oop]. + oldHeap + storePointer: sourcelessMethod numLiterals - 1 + ofObject: newMethod + withValue: (selector isSymbol + ifTrue: [self findSymbol: selector] + ifFalse: [selector oop]); + storePointer: sourcelessMethod numLiterals + ofObject: newMethod + withValue: (self methodClassForClassName: className + isMeta: isMeta). - methodClass := self methodClassForClassName: className isMeta: isMeta. - oldHeap storePointer: sourcelessMethod numLiterals ofObject: newMethod withValue: methodClass. sourcelessMethod initialPC to: sourcelessMethod size do: [:i| oldHeap storeByte: i - 1 ofObject: newMethod withValue: (sourcelessMethod byteAt: i)]. ^newMethod!

1 0

VM Maker: Cog-eem.133.mcz
by commits＠source.squeak.org 06 Feb '14

06 Feb '14

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.133.mcz ==================== Summary ==================== Name: Cog-eem.133 Author: eem Time: 5 February 2014, 7:59:10.717 pm UUID: 298eac1e-f169-461c-b48a-421ca2689ef1 Ancestors: Cog-eem.132 Fix rewriting of Character methods to delete the method(s) that assign to value. =============== Diff against Cog-eem.132 =============== Item was changed: + ----- Method: SpurBootstrapMonticelloPackagePatcher>>modifiedCharacterDefinitionsIn: (in category 'private-accessing') ----- - ----- Method: SpurBootstrapMonticelloPackagePatcher>>modifiedCharacterDefinitionsIn: (in category 'patching') ----- modifiedCharacterDefinitionsIn: definitions | rewriter | rewriter := RBParseTreeRewriter new. + rewriter + replace: 'value' with: 'self asInteger'; + replace: 'value := ``@args' with: 'DELETEME'. - rewriter replace: 'value' with: 'self asInteger'. ^((definitions select: [:d| d isMethodDefinition and: [d fullClassName = #Character]]) collect: [:d| { d. self patchDefinition: d withRewriter: rewriter} ] thenSelect: [:pair| pair first source ~= pair second source]) collect: [:pair| pair second]! Item was changed: ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchForPackage:withPatches:snapshot: (in category 'patching') ----- patchForPackage: package withPatches: patches snapshot: snapshot (package includesClass: Character) ifTrue: [patches addAll: ((self modifiedCharacterDefinitionsIn: snapshot definitions) select: [:def| patches noneSatisfy: [:addition| addition definition selector = def selector and: [addition definition className = def className and: [addition definition classIsMeta = def classIsMeta]]]] thenCollect: + [:def| + ((def source includesSubString: 'DELETEME') + ifTrue: [MCRemoval] + ifFalse: [MCAddition]) of: def])]. - [:def| MCAddition of: def])]. ^MCPatch operations: patches!

1 0

VM Maker: Cog-eem.132.mcz
by commits＠source.squeak.org 06 Feb '14

06 Feb '14

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.132.mcz ==================== Summary ==================== Name: Cog-eem.132 Author: eem Time: 5 February 2014, 7:42:40.367 pm UUID: 77121e2f-26ba-4ec5-9fa0-25883794b032 Ancestors: Cog-eem.131 Fix package rewriting of Spur bootstrap method prototypes for the binary selector hack. =============== Diff against Cog-eem.131 =============== Item was changed: ----- Method: SpurBootstrapMonticelloPackagePatcher>>packagesAndPatches (in category 'private-accessing') ----- packagesAndPatches "SpurBootstrapMonticelloPackagePatcher new packagesAndPatches" | packagesAndPatches | packagesAndPatches := Dictionary new. SpurBootstrap new prototypeClassNameMetaSelectorMethodDo: + [:className :isMeta :selector :method| | class methodReference source | - [:className :isMeta :selector :method| | class methodReference | 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))]. - source: (method getSourceFromFile asString allButFirst: method selector size - selector size)))]. ^packagesAndPatches!

1 0

VM Maker: VMMaker.oscog-eem.610.mcz
by commits＠source.squeak.org 06 Feb '14

06 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.610.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.610 Author: eem Time: 5 February 2014, 7:21:23.697 pm UUID: 1f5ba92f-b8cd-4144-8ebf-5cff693870ac Ancestors: VMMaker.oscog-eem.609 Make StackInterpreterPrimitives>>primitiveObjectPointsTo correct for both Spur and SqueakV3. =============== Diff against VMMaker.oscog-eem.609 =============== 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. Written to use literalHeaderOf: so that in Cog subclasses cogged methods (whose headers point to the machine code method) are still correctly scanned, for the header as well as literals." + | rcvr thang header fmt numSlots methodHeader | - | rcvr thang header fmt lastField 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)] - lastField := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr) * BytesPerOop] ifFalse: + [numSlots := objectMemory numSlotsOf: rcvr]] - [lastField := (objectMemory sizeBitsOfSafe: rcvr) - objectMemory baseHeaderSize]] ifFalse: [fmt < objectMemory firstCompiledMethodFormat "no pointers" ifTrue: [^self pop: 2 thenPushBool: false]. "CompiledMethod: contains both pointers and bytes:" methodHeader := self headerOf: rcvr. methodHeader = thang ifTrue: [^self pop: 2 thenPushBool: true]. + numSlots := (self literalCountOfHeader: methodHeader) + 1]. - lastField := ((self literalCountOfHeader: methodHeader) + 1) * BytesPerOop]. + self assert: numSlots - 1 * BytesPerOop + objectMemory baseHeaderSize = (objectMemory lastPointerOf: rcvr). + objectMemory baseHeaderSize + to: numSlots - 1 * BytesPerOop + objectMemory baseHeaderSize + by: BytesPerOop + do: [:i| + (self longAt: rcvr + i) = thang ifTrue: + [^self pop: 2 thenPushBool: true]]. - objectMemory baseHeaderSize to: lastField by: objectMemory bytesPerOop do: - [:i | - (self longAt: rcvr + i) = thang ifTrue: - [^self pop: 2 thenPushBool: true]]. self pop: 2 thenPushBool: false! Item was added: + ----- Method: StackInterpreterSimulator>>primitiveObjectPointsTo (in category 'object access primitives') ----- + primitiveObjectPointsTo + "self halt." + ^super primitiveObjectPointsTo!

1 0

VM Crash while shrinking
by Colin Putney 06 Feb '14

06 Feb '14

Hi all, My shrink script seems pretty good at flushing out bugs. After finding a few issues in the image code, I started hitting this VM crash consistently. Colin sweep failed to find exact end of memory Squeak VM version: 4.0 4.0.2776 Mac OS X built on Aug 22 2013 10:08:05 Compiler: 4.2.1 (Apple Inc. build 5666) (dot 3) [Production VM] Built from: CoInterpreter VMMaker.oscog-eem.331 uuid: 37d2e4b0-2f37-4e2d-8313-c63637785e59 Aug 22 2013 With: StackToRegisterMappingCogit VMMaker.oscog-eem.333 uuid: 84da9cb8-7f30-4cb7-b4fb-239a11f63b54 Aug 22 2013 Revision: VM: r2776 http://www.squeakvm.org/svn/squeak/branches/Cog Plugins: r2545 http://squeakvm.org/svn/squeak/trunk/platforms/Cross/plugins C stack backtrace: 0 Squeak 0x000700a1 reportStackState + 145 1 Squeak 0x0007037a error + 26 2 Squeak 0x000ea831 fullGC + 689 3 Squeak 0x000f7460 primitiveFullGC + 64 4 ??? 0x048c10a3 0x0 + 76288163 5 Squeak 0x00101d9a interpret + 2970 6 Squeak 0x0005ee00 EventLoopEventHandler + 144 7 HIToolbox 0x915d5eb9 _Z22_InvokeEventHandlerUPPP25OpaqueEventHandlerCallRefP14OpaqueEventRefPvPFlS0_S2_S3_E + 36 8 HIToolbox 0x9142964f _ZL23DispatchEventToHandlersP14EventTargetRecP14OpaqueEventRefP14HandlerCallRec + 1452 9 HIToolbox 0x91428968 _ZL30SendEventToEventTargetInternalP14OpaqueEventRefP20OpaqueEventTargetRefP14HandlerCallRec + 386 10 HIToolbox 0x914287e0 SendEventToEventTargetWithOptions + 94 11 HIToolbox 0x9145c6a9 _ZL29ToolboxEventDispatcherHandlerP25OpaqueEventHandlerCallRefP14OpaqueEventRefPv + 1757 12 HIToolbox 0x91429a95 _ZL23DispatchEventToHandlersP14EventTargetRecP14OpaqueEventRefP14HandlerCallRec + 2546 13 HIToolbox 0x91428968 _ZL30SendEventToEventTargetInternalP14OpaqueEventRefP20OpaqueEventTargetRefP14HandlerCallRec + 386 14 HIToolbox 0x9143baf1 SendEventToEventTarget + 88 15 HIToolbox 0x915d55a3 ToolboxEventDispatcher + 82 16 HIToolbox 0x915d5463 RunApplicationEventLoop + 240 17 Squeak 0x0005e61a RunApplicationEventLoopWithSqueak + 218 18 Squeak 0x000706e2 main + 690 19 Squeak 0x00002486 start + 54 Smalltalk stack dump: 0xbffb8270 M SmalltalkImage>garbageCollect 0x4c4487c: a(n) SmalltalkImage 0xbffb8294 I Symbol class>compactSymbolTable 0x4c0e120: a(n) Symbol class 0xbffb82b4 I Symbol class>cleanUp 0x4c0e120: a(n) Symbol class 0xbffb82d4 I Symbol class(Behavior)>cleanUp: 0x4c0e120: a(n) Symbol class 0xbffb82f4 M [] in SmalltalkImage>cleanUp:except: 0x4c4487c: a(n) SmalltalkImage 0xbffb832c M [] in OrderedCollection(Collection)>do:displayingProgress:every: 0x58fe240: a(n) OrderedCollection 0xbffb834c M OrderedCollection>do: 0x58fe240: a(n) OrderedCollection 0xbffb8384 I [] in OrderedCollection(Collection)>do:displayingProgress:every: 0x58fe240: a(n) OrderedCollection 0xbffb83ac M [] in MorphicUIManager>displayProgress:at:from:to:during: 0x4d97048: a(n) MorphicUIManager 0xbffb83c8 M BlockClosure>on:do: 0x58fe8c8: a(n) BlockClosure 0xbffb7228 M [] in MorphicUIManager>displayProgress:at:from:to:during: 0x4d97048: a(n) MorphicUIManager 0xbffb7248 M BlockClosure>ensure: 0x58fe834: a(n) BlockClosure 0xbffb726c M MorphicUIManager>displayProgress:at:from:to:during: 0x4d97048: a(n) MorphicUIManager 0xbffb72a0 I ProgressInitiationException>defaultResumeValue 0x58fe3e0: a(n) ProgressInitiationException 0xbffb72c4 I ProgressInitiationException(Exception)>resume 0x58fe3e0: a(n) ProgressInitiationException 0xbffb72e4 I ProgressInitiationException>defaultAction 0x58fe3e0: a(n) ProgressInitiationException 0xbffb7300 M UndefinedObject>handleSignal: 0x4900004: a(n) UndefinedObject 0xbffb7320 M MethodContext(ContextPart)>handleSignal: 0x57051f8: a(n) MethodContext 0xbffb7340 M MethodContext(ContextPart)>handleSignal: 0x56fdc44: a(n) MethodContext 0xbffb7360 M MethodContext(ContextPart)>handleSignal: 0x58fe4d0: a(n) MethodContext 0xbffb7380 M MethodContext(ContextPart)>handleSignal: 0x58f5844: a(n) MethodContext 0xbffb739c M ProgressInitiationException(Exception)>signal 0x58fe3e0: a(n) ProgressInitiationException 0xbffb73bc I ProgressInitiationException>display:at:from:to:during: 0x58fe3e0: a(n) ProgressInitiationException 0xbffaead4 I ProgressInitiationException class>display:at:from:to:during: 0x4da0354: a(n) ProgressInitiationException class 0xbffaeb08 I ByteString(String)>displayProgressAt:from:to:during: 0x543d590: a(n) ByteString 0xbffaeb38 I ByteString(String)>displayProgressFrom:to:during: 0x543d590: a(n) ByteString 0xbffaeb70 I OrderedCollection(Collection)>do:displayingProgress:every: 0x58fe240: a(n) OrderedCollection 0xbffaeb9c I OrderedCollection(Collection)>do:displayingProgress: 0x58fe240: a(n) OrderedCollection 0xbffaebc8 I SmalltalkImage>cleanUp:except: 0x4c4487c: a(n) SmalltalkImage 0xbffb6a68 I SmalltalkImage>cleanUp: 0x4c4487c: a(n) SmalltalkImage 0xbffb6a90 I UndefinedObject()>? 0x4900004: a(n) UndefinedObject 0xbffb6ab4 M Compiler>evaluateCue:ifFail: 0x58f6408: a(n) Compiler 0xbffb6ad8 M Compiler>evaluateCue:ifFail:logged: 0x58f6408: a(n) Compiler 0xbffb6b00 M Compiler>evaluate:in:to:notifying:ifFail:logged: 0x58f6408: a(n) Compiler 0xbffb6b30 M Compiler class>evaluate:for:notifying:logged: 0x4e295e4: a(n) Compiler class 0xbffb6b58 M Compiler class>evaluate:for:logged: 0x4e295e4: a(n) Compiler class 0xbffb6b7c M Compiler class>evaluate:logged: 0x4e295e4: a(n) Compiler class 0xbffb6bac I [] in MultiByteFileStream(PositionableStream)>fileInAnnouncing: 0x58dbfec: a(n) MultiByteFileStream 0xbffb6bc8 M BlockClosure>on:do: 0x58f581c: a(n) BlockClosure 0xbffb5ad8 I [] in MultiByteFileStream(PositionableStream)>fileInAnnouncing: 0x58dbfec: a(n) MultiByteFileStream 0xbffb5b00 M [] in MorphicUIManager>displayProgress:at:from:to:during: 0x4d97048: a(n) MorphicUIManager 0xbffb5b1c M BlockClosure>on:do: 0x58dce0c: a(n) BlockClosure 0xbffb5b50 I [] in MorphicUIManager>displayProgress:at:from:to:during: 0x4d97048: a(n) MorphicUIManager 0xbffb5b70 M BlockClosure>ensure: 0x58dcd78: a(n) BlockClosure 0xbffb5b9c I MorphicUIManager>displayProgress:at:from:to:during: 0x4d97048: a(n) MorphicUIManager 0xbffb5bd0 I ProgressInitiationException>defaultResumeValue 0x58dcab4: a(n) ProgressInitiationException 0xbffb61f4 I ProgressInitiationException(Exception)>resume 0x58dcab4: a(n) ProgressInitiationException 0xbffb6214 I ProgressInitiationException>defaultAction 0x58dcab4: a(n) ProgressInitiationException 0xbffb6238 I UndefinedObject>handleSignal: 0x4900004: a(n) UndefinedObject 0xbffb6258 M MethodContext(ContextPart)>handleSignal: 0x57051f8: a(n) MethodContext 0xbffb6280 I MethodContext(ContextPart)>handleSignal: 0x56fdc44: a(n) MethodContext 0xbffb62a4 I ProgressInitiationException(Exception)>signal 0x58dcab4: a(n) ProgressInitiationException 0xbffb62c4 I ProgressInitiationException>display:at:from:to:during: 0x58dcab4: a(n) ProgressInitiationException 0xbffb62f8 I ProgressInitiationException class>display:at:from:to:during: 0x4da0354: a(n) ProgressInitiationException class 0xbffb632c I ByteString(String)>displayProgressAt:from:to:during: 0x58dca1c: a(n) ByteString 0xbffb635c I ByteString(String)>displayProgressFrom:to:during: 0x58dca1c: a(n) ByteString 0xbffb638c I MultiByteFileStream(PositionableStream)>fileInAnnouncing: 0x58dbfec: a(n) MultiByteFileStream 0xbffb63b0 I MultiByteFileStream(FileStream)>fileIn 0x58dbfec: a(n) MultiByteFileStream 0xbffb63d0 I MultiByteFileStream>fileIn 0x58dbfec: a(n) MultiByteFileStream 0xbffb3a7c I [] in UndefinedObject()>? 0x4900004: a(n) UndefinedObject 0xbffb3aa8 I [] in MultiByteFileStream class(FileStream class)>detectFile:do: 0x4d3fd5c: a(n) MultiByteFileStream class 0xbffb3ac8 M BlockClosure>ensure: 0x58dc110: a(n) BlockClosure 0xbffb3af0 I MultiByteFileStream class(FileStream class)>detectFile:do: 0x4d3fd5c: a(n) MultiByteFileStream class 0xbffb3b18 I MultiByteFileStream class(FileStream class)>oldFileNamed:do: 0x4d3fd5c: a(n) MultiByteFileStream class 0xbffb3b40 I UnixFileDirectory(FileDirectory)>oldFileNamed:do: 0x570490c: a(n) UnixFileDirectory 0xbffb3b6c I [] in UndefinedObject()>? 0x4900004: a(n) UndefinedObject 0xbffb3b98 I [] in UndefinedObject()>? 0x4900004: a(n) UndefinedObject 0xbffb3bd0 I UndefinedObject()>? 0x4900004: a(n) UndefinedObject 0x56fde48 s Compiler>evaluateCue:ifFail: 0x56fddd4 s Compiler>evaluateCue:ifFail:logged: 0x57052b0 s Compiler>evaluate:in:to:notifying:ifFail:logged: 0x56fdd30 s Compiler class>evaluate:for:notifying:logged: 0x570530c s Compiler class>evaluate:for:logged: 0x5705368 s Compiler class>evaluate:logged: 0x56fd4d8 s [] in RWBinaryOrTextStream(PositionableStream)>fileInAnnouncing: 0x56fdc44 s BlockClosure>on:do: 0x56fd450 s [] in RWBinaryOrTextStream(PositionableStream)>fileInAnnouncing: 0x570519c s [] in MorphicUIManager>displayProgress:at:from:to:during: 0x57051f8 s BlockClosure>on:do: 0x56fd3bc s [] in MorphicUIManager>displayProgress:at:from:to:during: 0x5705254 s BlockClosure>ensure: 0x56fd328 s MorphicUIManager>displayProgress:at:from:to:during: 0x56fd14c s ProgressInitiationException>defaultResumeValue 0x56fd204 s ProgressInitiationException(Exception)>resume 0x56fd1a8 s ProgressInitiationException>defaultAction 0x5704fd0 s UndefinedObject>handleSignal: 0x56fd094 s ProgressInitiationException(Exception)>signal 0x56fd0f0 s ProgressInitiationException>display:at:from:to:during: 0x570502c s ProgressInitiationException class>display:at:from:to:during: 0x5705088 s ByteString(String)>displayProgressAt:from:to:during: 0x57050e4 s ByteString(String)>displayProgressFrom:to:during: 0x56fcfe4 s RWBinaryOrTextStream(PositionableStream)>fileInAnnouncing: 0x5705140 s RWBinaryOrTextStream(PositionableStream)>fileIn 0x56fbfd0 s CodeLoader>installSourceFile: 0x56fcf50 s [] in CodeLoader>installSourceFiles 0x5704e04 s Array(SequenceableCollection)>do: 0x56fbeac s CodeLoader>installSourceFiles 0x56fbd48 s ProjectLauncher>startUpAfterLogin 0x5704e60 s ProjectLauncher>startUp 0x5704ebc s [] in AutoStart class>startUp: 0x5704f18 s WorldState>runStepMethodsIn: 0x5704f74 s PasteUpMorph>runStepMethods 0x56e2d84 s WorldState>doOneCycleNowFor: 0x56e2d28 s WorldState>doOneCycleFor: 0x56e2ccc s PasteUpMorph>doOneCycle 0x4e3c924 s [] in MorphicProject()>? 0x4e3c5c8 s [] in BlockClosure()>? Most recent primitives primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primRenderScanline:with: primFinishedProcessing primGetTimes: primGetCounts: primGetBezierStats: wait at:put: signal @ @ basicNew @ perform:with: @ @ perform:with: @ basicNew basicNew new: @ basicNew at:put: @ basicNew at:put: @ @ basicNew at:put: @ @ basicNew at:put: copyBits copyBits copyBits copyBits @ @ basicNew copyBits copyBits @ perform:with: @ @ perform:with: @ basicNew @ @ basicNew @ perform:with: @ @ perform:with: @ basicNew copyBits @ perform:with: @ @ perform:with: @ basicNew @ @ basicNew @ @ @ basicNew @ perform:with: @ @ perform:with: @ basicNew copyBits @ @ basicNew @ @ primDisplayString:from:to:map:xTable:kern: @ primDisplayString:from:to:map:xTable:kern: @ @ @ perform:with: @ @ perform:with: @ basicNew @ @ basicNew @ perform:with: @ @ perform:with: @ basicNew copyBits @ perform:with: @ @ perform:with: @ basicNew @ @ basicNew @ @ @ basicNew @ perform:with: @ @ perform:with: @ basicNew copyBits @ @ basicNew @ @ primDisplayString:from:to:map:xTable:kern: @ primDisplayString:from:to:map:xTable:kern: @ @ @ perform:with: @ @ perform:with: @ basicNew @ @ basicNew @ perform:with: @ @ perform:with: @ basicNew copyBits @ @ basicNew @ @ primDisplayString:from:to:map:xTable:kern: @ primDisplayString:from:to:map:xTable:kern: @ @ at:put: basicNew new: basicNew new: basicNew new: at:put: wait signal primShowRectLeft:right:top:bottom: primitiveDeferUpdates: forceDisplayUpdate findNextUnwindContextUpTo: tempAt: tempAt:put: tempAt: terminateTo: tempAt:put: findNextUnwindContextUpTo: terminateTo: millisecondClockValue basicNew new: someInstance nextInstance at:put: nextInstance at:put: new: replaceFrom:to:with:startingAt: value: value: millisecondClockValue basicNew new: at:put: basicNew new: basicNew > new: at:put: at:put: basicNew new: millisecondClockValue primitiveGarbageCollect **IncrementalGC** **FullGC** stack page bytes 2048 available headroom 1252 minimum unused headroom 1464 (sweep failed to find exact end of memory)

1 0

VM Maker: Cog-eem.131.mcz
by commits＠source.squeak.org 06 Feb '14

06 Feb '14

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.131.mcz ==================== Summary ==================== Name: Cog-eem.131 Author: eem Time: 5 February 2014, 3:19:18.198 pm UUID: d441f4c0-9e39-4495-802d-c5d46af4283c Ancestors: Cog-eem.130 Update SpurBootstrapMonticelloPackagePatcher to rewrite Character methods that refer to value inst var. Update references to BrowserEnvironment to RBBrowserEnvironment. Tag transformed packages with Cog package version. Add or improve comments in several Character methods. Add a method that documents which packages refactoring browser packages need to be loaded for the code editing operations in the Cog package. =============== Diff against Cog-eem.130 =============== Item was changed: - SystemOrganization addCategory: #Cog! SystemOrganization addCategory: #'Cog-Benchmarks-DeltaBlue'! SystemOrganization addCategory: #'Cog-Benchmarks-Richards'! SystemOrganization addCategory: #'Cog-Benchmarks-SMark'! SystemOrganization addCategory: #'Cog-Benchmarks-Shootout'! SystemOrganization addCategory: #'Cog-Bootstrapping'! SystemOrganization addCategory: #'Cog-Morphing Bytecode Set'! SystemOrganization addCategory: #'Cog-ProcessorPlugins'! SystemOrganization addCategory: #'Cog-Processors'! SystemOrganization addCategory: #'Cog-Processors-Tests'! SystemOrganization addCategory: #'Cog-Scripting'! SystemOrganization addCategory: #'Cog-Scripts'! SystemOrganization addCategory: #'Cog-Tests'! SystemOrganization addCategory: #'Cog-Benchmarks'! Item was changed: ----- Method: CogScripts class>>changedMethodsForObjectMemorySends (in category 'separate vm scripts') ----- changedMethodsForObjectMemorySends "Answer the methods in StackInterpreter and subclasses that change if sends to self for methods implemented in ObjectMemory, NewObjectMemory (& NewObjectMemorySE ?) become sends to objectMemory." "CogScripts changedMethodsForObjectMemorySends" | selectors rules model environment sortedChanges | selectors := { ObjectMemory. NewObjectMemory. "NewObjectMemorySE" } inject: Set new into: [:sels :class| sels addAll: class selectors; yourself]. rules := RBParseTreeRewriter new. rules replace: 'self `@method: ``@args' with: 'objectMemory `@method: ``@args' when: [:node| selectors includes: node selector]. #( 'nilObj' 'trueObj' 'falseObj') do: [:instVar| rules replace: instVar, ' := ``@args' with: 'objectMemory ', instVar, 'ect: ``@args'; replace: instVar with: 'objectMemory ', instVar, 'ect']. self readWriteVars do: [:instVar| rules replace: instVar, ' := ``@args' with: 'objectMemory ', instVar, ': ``@args'; replace: instVar with: 'objectMemory ', instVar]. self readOnlyVars do: [:instVar| rules replace: instVar with: 'objectMemory ', instVar]. model := RBNamespace new. + environment := RBBrowserEnvironment new forClasses: - environment := BrowserEnvironment new forClasses: { StackInterpreter. CoInterpreter. CoInterpreterMT. StackInterpreterSimulator. CogVMSimulator }. environment classesAndSelectorsDo: [ :class :selector | | tree | "(class == StackInterpreter and: [selector == #isContextHeader:]) ifTrue: [self halt]." "(class == StackInterpreter and: [selector == #isIndexable:]) ifTrue: [self halt]." "(class == StackInterpreter and: [selector == #printContextCallStackOf:]) ifTrue: [self halt]." tree := class parseTreeFor: selector. (rules executeTree: tree) ifTrue: [model compile: rules tree newSource in: class classified: (class whichCategoryIncludesSelector: selector)]]. false ifTrue: [model changes inspect]. false ifTrue: "shortest change:" [(model changes changes inject: model changes changes first into: [:c1 :c2| c1 printString size < c2 printString size ifTrue: [c1] ifFalse: [c2]]) inspect]. sortedChanges := model changes changes asSortedCollection: [:c1 :c2| c1 changeClass == c2 changeClass ifTrue: [c1 selector <= c2 selector] ifFalse: [c2 changeClass inheritsFrom: c1 changeClass]]. true ifTrue: [MessageSetTextDifferencer openMessageList: (sortedChanges collect: [:mr| { MethodReference class: mr changeClass selector: mr selector. TextReference new text: mr source class: mr class selector: mr selector }]) name: 'self foo <-> objectMemory foo et al' autoSelect: nil]. ^sortedChanges! Item was changed: ----- Method: CogScripts class>>doClassSide (in category 'separate vm scripts') ----- doClassSide "self doClassSide" | classes rules model env sortedChanges | classes := (PackageInfo named: 'VMMaker') classes. classes := classes select: [:c| classes anySatisfy: [:d| d name last = $S and: [d name allButLast = c name]]]. rules := RBParseTreeRewriter new. model := RBNamespace new. + env := RBBrowserEnvironment new forClasses: classes. - env := BrowserEnvironment new forClasses: classes. classes do: [:c| rules replace: c name with: c name, 'S']. env classesAndSelectorsDo: [:class :selector| | tree | class isMeta ifTrue: [tree := class parseTreeFor: selector. rules executeTree: tree. model compile: rules tree newSource in: class classified: (class whichCategoryIncludesSelector: selector)]]. false ifTrue: [model changes inspect]. false ifTrue: "shortest change:" [(model changes changes inject: model changes changes first into: [:c1 :c2| c1 printString size < c2 printString size ifTrue: [c1] ifFalse: [c2]]) inspect]. sortedChanges := model changes changes asSortedCollection: [:c1 :c2| c1 changeClass == c2 changeClass ifTrue: [c1 selector <= c2 selector] ifFalse: [c2 changeClass inheritsFrom: c1 changeClass]]. true ifTrue: [MessageSetTextDifferencer openMessageList: (sortedChanges collect: [:mr| { MethodReference class: mr changeClass selector: mr selector. TextReference new text: mr source class: mr class selector: mr selector }]) name: 'class side' autoSelect: nil]. sortedChanges do: [:mr| (Smalltalk classNamed: (mr changeClass theNonMetaClass name, 'S') asSymbol) class compile: mr source classified: (mr changeClass whichCategoryIncludesSelector: mr selector) withStamp: (mr source asString = (mr changeClass sourceCodeAt: mr selector) asString ifTrue: [(mr changeClass >> mr selector) timeStamp] ifFalse: [Utilities changeStamp copyReplaceAll: Utilities authorInitials with: Utilities authorInitials, ' (objmem refactor)']) notifying: nil]! Item was added: + ----- Method: CogScripts class>>refactoringPackages (in category 'documentation') ----- + refactoringPackages + "to use the source editing facilities in the refactoring browser that this class uses load + AST-Core + AST-Semantic + Refactoring-Core + Refactoring-Environment + Refactoring-Changes + in that order from http://www.squeaksource.com/rb. Relevant tests are + AST-Tests-Core + AST-Tests-Semantic + Refactoring-Tests-Core + Refactoring-Tests-Environment + Refactoring-Tests-Changes"! Item was changed: ----- Method: SpurBootstrap class>>CharacterPROTOTYPEasInteger (in category 'method prototypes') ----- CharacterPROTOTYPEasInteger + "Answer the receiver's character code." <primitive: 171> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrap class>>CharacterPROTOTYPEasciiValue (in category 'method prototypes') ----- CharacterPROTOTYPEasciiValue + "Answer the receiver's character code. + This will be ascii for characters with value <= 127, + and Unicode for those with higher values." <primitive: 171> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrap class>>CharacterPROTOTYPEclone (in category 'method prototypes') ----- CharacterPROTOTYPEclone + "Answer the receiver, because Characters are unique." ^self! Item was changed: ----- Method: SpurBootstrap class>>CharacterPROTOTYPEcopy (in category 'method prototypes') ----- CharacterPROTOTYPEcopy + "Answer the receiver, because Characters are unique." ^self! Item was changed: ----- Method: SpurBootstrap class>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') ----- CharacterPROTOTYPEdeepCopy + "Answer the receiver, because Characters are unique." ^self! Item was changed: ----- Method: SpurBootstrap class>>CharacterPROTOTYPEhash (in category 'method prototypes') ----- CharacterPROTOTYPEhash + "Hash is reimplemented because = is implemented. + Answer the receiver's character code." <primitive: 171> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrap class>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') ----- CharacterPROTOTYPEidentityHash + "Answer the receiver's character code." <primitive: 171> ^self primitiveFailed! Item was changed: ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') ----- CharacterPROTOTYPEshallowCopy + "Answer the receiver, because Characters are unique." ^self! Item was changed: ----- Method: SpurBootstrap class>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') ----- CharacterPROTOTYPEveryDeepCopyWith: deepCopier + "Answer the receiver, because Characters are unique." ^self! Item was changed: ----- Method: SpurBootstrap class>>CharacterclassPROTOTYPEvalue: (in category 'method prototypes') ----- CharacterclassPROTOTYPEvalue: anInteger + "Answer the Character whose value is anInteger." <primitive: 170> ^self primitiveFailed! Item was added: + ----- Method: SpurBootstrapMonticelloPackagePatcher>>modifiedCharacterDefinitionsIn: (in category 'patching') ----- + modifiedCharacterDefinitionsIn: definitions + | rewriter | + rewriter := RBParseTreeRewriter new. + rewriter replace: 'value' with: 'self asInteger'. + ^((definitions select: [:d| d isMethodDefinition and: [d fullClassName = #Character]]) + collect: [:d| { d. self patchDefinition: d withRewriter: rewriter} ] + thenSelect: [:pair| pair first source ~= pair second source]) + collect: [:pair| pair second]! Item was changed: ----- Method: SpurBootstrapMonticelloPackagePatcher>>patch (in category 'patching') ----- patch "(SpurBootstrapMonticelloPackagePatcher new from: '/Users/eliot/Glue/repositories/nsboot/smalltalk' to: '/Users/eliot/Glue/repositories/spurnsboot/smalltalk') patch" + "(SpurBootstrapMonticelloPackagePatcher new + from: '/Users/eliot/Glue/repositories/nsboot/Squeak4.3/squeak-package-cache' + to: '/Users/eliot/Glue/repositories/nsboot/Squeak4.3/package-cache') + patch" self packagesAndPatches keysAndValuesDo: [:package :patches| (self filesForPackage: package in: sourceDir) do: [:packageFile| self patchPackage: packageFile with: patches for: package]]! Item was added: + ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchDefinition:withRewriter: (in category 'patching') ----- + patchDefinition: aMCMethodDefinition withRewriter: aRBParseTreeRewriter + | parseTree | + parseTree := RBParser + parseMethod: aMCMethodDefinition source + onError: [:str :pos | self halt]. + aRBParseTreeRewriter executeTree: parseTree. + ^MCMethodDefinition + className: aMCMethodDefinition className + classIsMeta:aMCMethodDefinition classIsMeta + selector: aMCMethodDefinition selector + category: aMCMethodDefinition category + timeStamp: aMCMethodDefinition timeStamp + source: aRBParseTreeRewriter tree newSource! Item was changed: ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchForPackage:withPatches:snapshot: (in category 'patching') ----- patchForPackage: package withPatches: patches snapshot: snapshot (package includesClass: Character) ifTrue: + [patches addAll: ((self modifiedCharacterDefinitionsIn: snapshot definitions) + select: + [:def| + patches noneSatisfy: + [:addition| + addition definition selector = def selector + and: [addition definition className = def className + and: [addition definition classIsMeta = def classIsMeta]]]] + thenCollect: + [:def| MCAddition of: def])]. - [snapshot halt]. ^MCPatch operations: patches! Item was changed: ----- Method: SpurBootstrapMonticelloPackagePatcher>>version:withPatches:for: (in category 'patching') ----- version: version withPatches: patches for: package | snapshot ancestry | snapshot := MCPatcher apply: (self patchForPackage: package withPatches: patches snapshot: version snapshot) to: version snapshot. ancestry := MCWorkingAncestry new addAncestor: version info. ^MCVersion package: version package info: (ancestry infoWithName: version info name + message: version info name, + ' patched for Spur by ', + (CCodeGenerator new shortMonticelloDescriptionForClass: self class)) - message: version info name, ' patched for Spur') snapshot: snapshot dependencies: {} "punt on computing dependencies; there are't any so far" !

1 0

Re: [Vm-dev] VM Maker: VMMaker.oscog-eem.597.mcz
by Eliot Miranda 05 Feb '14

05 Feb '14

Hi All, I'd be grateful for a second set of eyes to review my changes in plugin land. The idea here was to eliminate as many isIntegerObject: sends where the intent is to fail if interpreterProxy isImmediate:. There are other cleanups too; some places where it is assumed the start of an object is object + 4 (instead of object + BaseHeaderSize, which hopefully will fix some Spur bugs, where BaseHeaderSize is 8). But there are a fair few fixes and I could have made a mistake. TIA On Thu, Jan 30, 2014 at 4:33 PM, <commits(a)source.squeak.org> wrote: > > Eliot Miranda uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-eem.597.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-eem.597 > Author: eem > Time: 30 January 2014, 4:31:41.523 pm > UUID: c9a71dd4-c394-4a8f-aa4d-a6d4dc3ff220 > Ancestors: VMMaker.oscog-eem.596 > > Fix markAndTraceStackPage: for Spur. Stack references to > forwarders must be followed before calling markAndTrace:. > > Fix eliminateAndFreeForwarders; it assumed that no forwarder can > reference a new object after scavenge. That's not true due to > transitive references. > > Fix SpurMemoryManager>>become:with:twoWay:copyHash: to follow > the specialObjectsOop if it has been forwarded. > > Plugins (and the form print prim): > Fix some egregious oop + 4 and oop + 8 references with the correct > oop + BaseHeaderSize. > Reduce the use of isIntegerObject:. isWords:, isBytes: > et al fail for immediates anyway. > Use var:type: where appropriate and use symbols for 'char *' et al. > Replace some uses of cCode: 'aFunction(args)' with a send of the > equivalent albeit non-existent selector. This may allow simulation > at some point in the future. > > =============== Diff against VMMaker.oscog-eem.596 =============== > > Item was changed: > ----- Method: AsynchFilePlugin>>asyncFileValueOf: (in category > 'primitives') ----- > asyncFileValueOf: oop > + "Answer a pointer to the first byte of the async file record > within the given Smalltalk bytes object, or nil if oop is not an async file > record." > - "Return a pointer to the first byte of the async file record > within the given Smalltalk bytes object, or nil if oop is not an async file > record." > > <returnTypeC: 'AsyncFile *'> > interpreterProxy success: > + ((interpreterProxy isBytes: oop) > + and: [(interpreterProxy slotSizeOf: oop) = (self cCode: > 'sizeof(AsyncFile)')]). > + ^interpreterProxy failed > + ifTrue: [nil] > + ifFalse: [self cCoerceSimple: (interpreterProxy > firstIndexableField: oop) to: 'AsyncFile *']! > - ((interpreterProxy isIntegerObject: oop) not and: > - [(interpreterProxy isBytes: oop) and: > - [(interpreterProxy slotSizeOf: oop) = (self cCode: > 'sizeof(AsyncFile)')]]). > - interpreterProxy failed ifTrue: [^ nil]. > - ^ self cCode: '(AsyncFile *) (oop + 4)' > - ! > > Item was changed: > ----- Method: B3DAcceleratorPlugin>>stackLightArrayValue: (in category > 'primitive support') ----- > stackLightArrayValue: stackIndex > "Load an Array of B3DPrimitiveLights from the given stack index" > | oop array arraySize | > <inline: false> > array := interpreterProxy stackObjectValue: stackIndex. > + array = nil ifTrue:[^nil]. "really??" > - array = nil ifTrue:[^nil]. > array = interpreterProxy nilObject ifTrue:[^nil]. > + (interpreterProxy isArray: array) > - (interpreterProxy fetchClassOf: array) = interpreterProxy > classArray > ifFalse:[^interpreterProxy primitiveFail]. > arraySize := interpreterProxy slotSizeOf: array. > 0 to: arraySize-1 do:[:i| > oop := interpreterProxy fetchPointer: i ofObject: array. > - (interpreterProxy isIntegerObject: oop) > - ifTrue:[^interpreterProxy primitiveFail]. > ((interpreterProxy isWords: oop) and:[(interpreterProxy > slotSizeOf: oop) = 32]) > ifFalse:[^interpreterProxy primitiveFail]. > ]. > ^array! > > Item was changed: > ----- Method: BalloonEngineBase>>loadFormsFrom: (in category 'loading > state') ----- > loadFormsFrom: arrayOop > "Check all the forms from arrayOop." > | formOop bmBits bmBitsSize bmWidth bmHeight bmDepth ppw bmRaster | > (interpreterProxy isArray: arrayOop) ifFalse:[^false]. > formArray := arrayOop. > 0 to: (interpreterProxy slotSizeOf: formArray) - 1 do:[:i| > formOop := interpreterProxy fetchPointer: i ofObject: > formArray. > - (interpreterProxy isIntegerObject: formOop) > ifTrue:[^false]. > (interpreterProxy isPointers: formOop) ifFalse:[^false]. > (interpreterProxy slotSizeOf: formOop) < 5 ifTrue:[^false]. > bmBits := interpreterProxy fetchPointer: 0 ofObject: > formOop. > + (interpreterProxy fetchClassOf: bmBits) = interpreterProxy > classBitmap > - (interpreterProxy fetchClassOf: bmBits) == > interpreterProxy classBitmap > ifFalse:[^false]. > bmBitsSize := interpreterProxy slotSizeOf: bmBits. > bmWidth := interpreterProxy fetchInteger: 1 ofObject: > formOop. > bmHeight := interpreterProxy fetchInteger: 2 ofObject: > formOop. > bmDepth := interpreterProxy fetchInteger: 3 ofObject: > formOop. > interpreterProxy failed ifTrue:[^false]. > (bmWidth >= 0 and:[bmHeight >= 0]) ifFalse:[^false]. > ppw := 32 // bmDepth. > bmRaster := bmWidth + (ppw-1) // ppw. > bmBitsSize = (bmRaster * bmHeight) > ifFalse:[^false]. > ]. > ^true! > > Item was changed: > ----- Method: BalloonEngineBase>>primitiveGetFailureReason (in category > 'primitives-access') ----- > primitiveGetFailureReason > "Return the reason why the last operation failed." > <export: true> > <inline: false> > | failCode | > interpreterProxy methodArgumentCount = 0 > ifFalse:[^interpreterProxy primitiveFailFor: > PrimErrBadNumArgs]. > engine := interpreterProxy stackValue: 0. > "Note -- don't call loadEngineFrom here because this will override > the stopReason with Zero" > + (interpreterProxy isImmediate: engine) ifTrue:[^interpreterProxy > primitiveFailFor: GEFEngineIsInteger]. > - (interpreterProxy isIntegerObject: engine) > ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineIsInteger]. > (interpreterProxy isPointers: engine) ifFalse:[^interpreterProxy > primitiveFailFor: GEFEngineIsWords]. > (interpreterProxy slotSizeOf: engine) < BEBalloonEngineSize > ifTrue:[^interpreterProxy primitiveFailFor: GEFEngineTooSmall]. > (failCode := self loadWorkBufferFrom: > (interpreterProxy fetchPointer: BEWorkBufferIndex > ofObject: engine)) = 0 > ifFalse:[^interpreterProxy primitiveFailFor: > failCode]. > interpreterProxy pop: 1. > interpreterProxy pushInteger: self stopReasonGet.! > > Item was changed: > ----- Method: > BalloonEnginePlugin>>loadBitmapFill:colormap:tile:from:along:normal:xIndex: > (in category 'fills-bitmaps') ----- > loadBitmapFill: formOop colormap: cmOop tile: tileFlag from: point1 > along: point2 normal: point3 xIndex: xIndex > "Load the bitmap fill." > | bmFill cmSize cmBits bmBits bmBitsSize bmWidth bmHeight bmDepth > ppw bmRaster | > + <var: #cmBits type: #'int *'> > + <var: #point1 type: #'int *'> > + <var: #point2 type: #'int *'> > + <var: #point3 type: #'int *'> > - <var: #cmBits type:'int *'> > - <var: #point1 type:'int *'> > - <var: #point2 type:'int *'> > - <var: #point3 type:'int *'> > > cmOop == interpreterProxy nilObject ifTrue:[ > cmSize := 0. > cmBits := nil. > ] ifFalse:[ > + (interpreterProxy fetchClassOf: cmOop) = interpreterProxy > classBitmap > - (interpreterProxy fetchClassOf: cmOop) == interpreterProxy > classBitmap > ifFalse:[^interpreterProxy primitiveFail]. > cmSize := interpreterProxy slotSizeOf: cmOop. > cmBits := interpreterProxy firstIndexableField: cmOop. > ]. > - (interpreterProxy isIntegerObject: formOop) > - ifTrue:[^interpreterProxy primitiveFail]. > (interpreterProxy isPointers: formOop) > ifFalse:[^interpreterProxy primitiveFail]. > (interpreterProxy slotSizeOf: formOop) < 5 > ifTrue:[^interpreterProxy primitiveFail]. > bmBits := interpreterProxy fetchPointer: 0 ofObject: formOop. > + (interpreterProxy fetchClassOf: bmBits) = interpreterProxy > classBitmap > - (interpreterProxy fetchClassOf: bmBits) == interpreterProxy > classBitmap > ifFalse:[^interpreterProxy primitiveFail]. > bmBitsSize := interpreterProxy slotSizeOf: bmBits. > bmWidth := interpreterProxy fetchInteger: 1 ofObject: formOop. > bmHeight := interpreterProxy fetchInteger: 2 ofObject: formOop. > bmDepth := interpreterProxy fetchInteger: 3 ofObject: formOop. > interpreterProxy failed ifTrue:[^nil]. > (bmWidth >= 0 and:[bmHeight >= 0]) ifFalse:[^interpreterProxy > primitiveFail]. > (bmDepth = 32) | (bmDepth = 8) | (bmDepth = 16) | > (bmDepth = 1) | (bmDepth = 2) | (bmDepth = 4) > ifFalse:[^interpreterProxy primitiveFail]. > (cmSize = 0 or:[cmSize = (1 << bmDepth)]) > ifFalse:[^interpreterProxy primitiveFail]. > ppw := 32 // bmDepth. > bmRaster := bmWidth + (ppw-1) // ppw. > bmBitsSize = (bmRaster * bmHeight) > ifFalse:[^interpreterProxy primitiveFail]. > bmFill := self allocateBitmapFill: cmSize colormap: cmBits. > engineStopped ifTrue:[^nil]. > self bitmapWidthOf: bmFill put: bmWidth. > self bitmapHeightOf: bmFill put: bmHeight. > self bitmapDepthOf: bmFill put: bmDepth. > self bitmapRasterOf: bmFill put: bmRaster. > self bitmapSizeOf: bmFill put: bmBitsSize. > self bitmapTileFlagOf: bmFill put: tileFlag. > self objectIndexOf: bmFill put: xIndex. > self loadFillOrientation: bmFill > from: point1 along: point2 normal: point3 > width: bmWidth height: bmHeight. > ^bmFill! > > Item was changed: > ----- Method: CameraPlugin>>primGetFrame (in category 'primitives') ----- > primGetFrame > "Copy a camera frame into the given Bitmap. The Bitmap should be > for a Form of depth 32 that is the same width and height as the current > camera frame. Fail if the camera is not open or if the bitmap is not the > right size. If successful, answer the number of frames received from the > camera since the last call. If this is zero, then there has been no change." > > | cameraNum bitmapOop bitmap pixCount result | > <export: true> > + <var: 'bitmap' type: #'unsigned char *'> > - <var: 'bitmap' declareC: 'unsigned char *bitmap'> > > cameraNum := interpreterProxy stackIntegerValue: 1. > bitmapOop := interpreterProxy stackValue: 0. > + interpreterProxy success: (interpreterProxy isWords: bitmapOop). > + interpreterProxy failed ifTrue: > + [^ 0]. > + bitmap := self cCoerce: (interpreterProxy firstIndexableField: > bitmapOop) to: #'unsigned char *'. > - ((interpreterProxy isIntegerObject: bitmapOop) or: > - [(interpreterProxy isWords: bitmapOop) not]) ifTrue: [ > - interpreterProxy success: false. > - ^ 0]. > - bitmap := self cCoerce: (interpreterProxy firstIndexableField: > bitmapOop) to: 'unsigned char *'. > pixCount := interpreterProxy stSizeOf: bitmapOop. > > + result := self Camera: cameraNum Get: bitmap Frame: pixCount. > - result := self cCode: 'CameraGetFrame(cameraNum, bitmap, > pixCount)'. > result < 0 ifTrue: [ > interpreterProxy success: false. > ^ 0]. > > interpreterProxy pop: 3 thenPush: (interpreterProxy > integerObjectOf: result). "pop rcvr & args, push int result" > ^ 0 > > ! > > Item was changed: > ----- Method: CoInterpreter>>markAndTraceStackPage: (in category 'object > memory support') ----- > markAndTraceStackPage: thePage > | theSP theFP frameRcvrOffset callerFP oop | > <var: #thePage type: #'StackPage *'> > <var: #theSP type: #'char *'> > <var: #theFP type: #'char *'> > <var: #frameRcvrOffset type: #'char *'> > <var: #callerFP type: #'char *'> > <inline: false> > > self assert: (stackPages isFree: thePage) not. > self assert: thePage trace ~= StackPageTraced. > thePage trace: StackPageTraced. > > theSP := thePage headSP. > theFP := thePage headFP. > "Skip the instruction pointer on top of stack of inactive pages." > thePage = stackPage ifFalse: > [theSP := theSP + BytesPerWord]. > [frameRcvrOffset := self frameReceiverOffset: theFP. > [theSP <= frameRcvrOffset] whileTrue: > [oop := stackPages longAt: theSP. > + (objectMemory isOopForwarded: oop) ifTrue: > + [oop := objectMemory followForwarded: oop. > + stackPages longAt: theSP put: oop]. > (objectMemory isImmediate: oop) ifFalse: > [objectMemory markAndTrace: oop]. > theSP := theSP + BytesPerWord]. > (self frameHasContext: theFP) ifTrue: > [self assert: (objectMemory isContext: (self frameContext: > theFP)). > objectMemory markAndTrace: (self frameContext: theFP)]. > (self isMachineCodeFrame: theFP) > ifTrue: [self markAndTraceMachineCodeMethod: (self > mframeCogMethod: theFP)] > ifFalse: [objectMemory markAndTrace: (self iframeMethod: > theFP)]. > (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: > [theSP := theFP + FoxCallerSavedIP + BytesPerWord. > theFP := callerFP]. > theSP := theFP + FoxCallerSavedIP + BytesPerWord. "caller ip is > ceBaseReturnPC" > [theSP <= thePage baseAddress] whileTrue: > [oop := stackPages longAt: theSP. > + (objectMemory isOopForwarded: oop) ifTrue: > + [oop := objectMemory followForwarded: oop. > + stackPages longAt: theSP put: oop]. > (objectMemory isImmediate: oop) ifFalse: > [objectMemory markAndTrace: oop]. > theSP := theSP + BytesPerWord]! > > 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]. > - (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: 4 ofObject: rcvr. > + ((interpreterProxy isWords: oop) > + and: [(interpreterProxy slotSizeOf: oop) = DeflateHashTableSize]) > ifFalse: > + [^false]. > - ((interpreterProxy isIntegerObject: oop) or:[ > - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. > - (interpreterProxy slotSizeOf: oop) = DeflateHashTableSize > ifFalse:[^false]. > zipHashHead := interpreterProxy firstIndexableField: oop. > oop := interpreterProxy fetchPointer: 5 ofObject: rcvr. > + ((interpreterProxy isWords: oop) > + and: [(interpreterProxy slotSizeOf: oop) = DeflateWindowSize]) > ifFalse: > + [^false]. > - ((interpreterProxy isIntegerObject: oop) or:[ > - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. > - (interpreterProxy slotSizeOf: oop) = DeflateWindowSize > ifFalse:[^false]. > zipHashTail := interpreterProxy firstIndexableField: oop. > 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 isBytes: oop) ifFalse: > + [^false]. > - ((interpreterProxy isIntegerObject: oop) or:[ > - (interpreterProxy isBytes: oop) not]) ifTrue:[^false]. > zipLiteralSize := interpreterProxy slotSizeOf: oop. > zipLiterals := interpreterProxy firstIndexableField: oop. > > oop := interpreterProxy fetchPointer: 10 ofObject: rcvr. > + ((interpreterProxy isWords: oop) > + and: [(interpreterProxy slotSizeOf: oop) >= zipLiteralSize]) > ifFalse: > + [^false]. > - ((interpreterProxy isIntegerObject: oop) or:[ > - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. > - (interpreterProxy slotSizeOf: oop) < zipLiteralSize > ifTrue:[^false]. > zipDistances := interpreterProxy firstIndexableField: oop. > > oop := interpreterProxy fetchPointer: 11 ofObject: rcvr. > + ((interpreterProxy isWords: oop) > + and: [(interpreterProxy slotSizeOf: oop) = > DeflateMaxLiteralCodes]) ifFalse: > + [^false]. > - ((interpreterProxy isIntegerObject: oop) or:[ > - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. > - (interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes > ifFalse:[^false]. > zipLiteralFreq := interpreterProxy firstIndexableField: oop. > > oop := interpreterProxy fetchPointer: 12 ofObject: rcvr. > + ((interpreterProxy isWords: oop) > + and: [(interpreterProxy slotSizeOf: oop) = > DeflateMaxDistanceCodes]) ifFalse: > + [^false]. > - ((interpreterProxy isIntegerObject: oop) or:[ > - (interpreterProxy isWords: oop) not]) ifTrue:[^false]. > - (interpreterProxy slotSizeOf: oop) = DeflateMaxDistanceCodes > ifFalse:[^false]. > zipDistanceFreq := interpreterProxy firstIndexableField: oop. > > 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> > + ((interpreterProxy isPointers: rcvr) > + and: [(interpreterProxy slotSizeOf: rcvr) >= 6]) 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: 4 ofObject: rcvr. > zipBitPos := interpreterProxy fetchInteger: 5 ofObject: rcvr. > > ^interpreterProxy failed not! > > 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: > ----- Method: FFIPlugin>>ffiArgument:Spec:Class: (in category 'callout > support') ----- > ffiArgument: oop Spec: argSpec Class: argClass > "Callout support. Prepare the given oop as argument. > argSpec defines the compiled spec for the argument. > argClass (if non-nil) defines the required (super)class for the > argument." > | valueOop oopClass isStruct nilOop | > <inline: false> > oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class > (we'll need it)" > nilOop := interpreterProxy nilObject. > "Do the necessary type checks" > argClass == nilOop ifFalse:[ > "Type check 1: > Is the required class of the argument a subclass of > ExternalStructure?" > (interpreterProxy includesBehavior: argClass > ThatOf: interpreterProxy > classExternalStructure) > ifFalse:[^self ffiFail: FFIErrorWrongType]. "Nope. > Fail." > "Type check 2: > Is the class of the argument a subclass of required class?" > ((nilOop == oop) or:[interpreterProxy includesBehavior: > oopClass ThatOf: argClass]) > ifFalse:[^self ffiFail: > FFIErrorCoercionFailed]. "Nope. Fail." > "Okay, we've passed the type check (so far)" > ]. > > "Check if oopClass is a subclass of ExternalStructure. > If this is the case we'll work on it's handle and not the actual > oop." > isStruct := false. > + ((interpreterProxy isImmediate: oop) or:[oop == nilOop]) ifFalse:[ > + "#isPointers: will fail if oop is immediate so don't even > attempt to use it" > - ((interpreterProxy isIntegerObject: oop) or:[oop == nilOop]) > ifFalse:[ > - "#isPointers: will fail if oop is SmallInteger so don't > even attempt to use it" > (interpreterProxy isPointers: oop) > ifTrue:[isStruct := interpreterProxy > includesBehavior: oopClass > ThatOf: > interpreterProxy classExternalStructure. > (argClass == nilOop or:[isStruct]) > ifFalse:[^self ffiFail: > FFIErrorCoercionFailed]]. > "note: the test for #isPointers: above should speed up > execution since no pointer type ST objects are allowed in external calls > and thus if #isPointers: is true then the arg must be ExternalStructure to > work. If it isn't then the code fails anyways so speed isn't an issue" > ]. > > "Determine valueOop (e.g., the actual oop to pass as argument)" > isStruct > ifTrue:[valueOop := interpreterProxy fetchPointer: 0 > ofObject: oop] > ifFalse:[valueOop := oop]. > > "Fetch and check the contents of the compiled spec" > - (interpreterProxy isIntegerObject: argSpec) > - ifTrue:[self ffiFail: FFIErrorWrongType. ^nil]. > (interpreterProxy isWords: argSpec) > ifFalse:[self ffiFail: FFIErrorWrongType. ^nil]. > ffiArgSpecSize := interpreterProxy slotSizeOf: argSpec. > ffiArgSpecSize = 0 ifTrue:[self ffiFail: FFIErrorWrongType. ^nil]. > ffiArgSpec := self cCoerce: (interpreterProxy firstIndexableField: > argSpec) to: 'int'. > ffiArgHeader := interpreterProxy longAt: ffiArgSpec. > > "Do the actual preparation of the argument" > "Note: Order is important since FFIFlagStructure + FFIFlagPointer > is used to represent 'typedef void* VoidPointer' and VoidPointer really is > *struct* not pointer." > > (ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[ > "argument must be ExternalStructure" > isStruct ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. > (ffiArgHeader anyMask: FFIFlagAtomic) > ifTrue:[^self ffiFail: FFIErrorWrongType]. "bad > combination" > ^self ffiPushStructureContentsOf: valueOop]. > > (ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[ > + "no integers (or characters) for pointers please" > + (interpreterProxy isImmediate: oop) > - "no integers for pointers please" > - (interpreterProxy isIntegerObject: oop) > ifTrue:[^self ffiFail: FFIErrorIntAsPointer]. > > "but allow passing nil pointer for any pointer type" > oop == interpreterProxy nilObject ifTrue:[^self > ffiPushPointer: nil]. > > "argument is reference to either atomic or structure type" > (ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[ > isStruct "e.g., ExternalData" > ifTrue:[^self ffiAtomicStructByReference: > oop Class: oopClass] > ifFalse:[^self ffiAtomicArgByReference: > oop Class: oopClass]. > "********* NOTE: The above uses 'oop' not > 'valueOop' (for ExternalData) ******" > ]. > > "Needs to be external structure here" > isStruct ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. > ^self ffiPushPointerContentsOf: valueOop]. > > (ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[ > "argument is atomic value" > self ffiArgByValue: valueOop. > ^0]. > "None of the above - bad spec" > ^self ffiFail: FFIErrorWrongType! > > Item was changed: > ----- Method: FFIPlugin>>ffiCheckReturn:With: (in category 'callout > support') ----- > ffiCheckReturn: retSpec With: retClass > "Make sure we can return an object of the given type" > <inline: true> > retClass == interpreterProxy nilObject ifFalse:[ > (interpreterProxy includesBehavior: retClass > ThatOf: interpreterProxy > classExternalStructure) > ifFalse:[^self ffiFail: FFIErrorBadReturn]]. > ffiRetClass := retClass. > > - (interpreterProxy isIntegerObject: retSpec) > - ifTrue:[self ffiFail: FFIErrorWrongType. ^nil]. > (interpreterProxy isWords: retSpec) > ifFalse:[self ffiFail: FFIErrorWrongType. ^nil]. > ffiRetSpecSize := interpreterProxy slotSizeOf: retSpec. > ffiRetSpecSize = 0 ifTrue:[self ffiFail: FFIErrorWrongType. ^nil]. > ffiRetSpec := self cCoerce: (interpreterProxy firstIndexableField: > retSpec) to: 'int'. > ffiRetHeader := interpreterProxy longAt: ffiRetSpec. > (self isAtomicType: ffiRetHeader) ifFalse:[ > (ffiRetClass == interpreterProxy nilObject) > ifTrue:[^self ffiFail: FFIErrorBadReturn]]. > (self ffiCan: (self cCoerce: ffiRetSpec to:'int*') Return: > ffiRetSpecSize) > ifFalse:[self ffiFail: FFIErrorBadReturn]. "cannot return > this type" > ^0! > > Item was changed: > ----- Method: FFIPlugin>>ffiContentsOfHandle:errCode: (in category > 'callout support') ----- > ffiContentsOfHandle: oop errCode: errCode > "Make sure that the given oop is a valid external handle" > <inline: true> > - (interpreterProxy isIntegerObject: oop) > - ifTrue:[^self ffiFail: errCode]. > (interpreterProxy isBytes: oop) > ifFalse:[^self ffiFail: errCode]. > ((interpreterProxy byteSizeOf: oop) == 4) > ifFalse:[^self ffiFail: errCode]. > ^interpreterProxy fetchPointer: 0 ofObject: oop! > > Item was changed: > ----- Method: FFIPlugin>>ffiIntegerValueOf: (in category 'callout > support') ----- > ffiIntegerValueOf: oop > "Support for generic callout. Return an integer value that is > coerced as C would do." > | oopClass | > <inline: true> > (interpreterProxy isIntegerObject: oop) ifTrue:[^interpreterProxy > integerValueOf: oop]. > oop == interpreterProxy nilObject ifTrue:[^0]. "@@: should we > really allow this????" > oop == interpreterProxy falseObject ifTrue:[^0]. > oop == interpreterProxy trueObject ifTrue:[^1]. > oopClass := interpreterProxy fetchClassOf: oop. > oopClass == interpreterProxy classFloat > ifTrue:[^(interpreterProxy floatValueOf: oop) asInteger]. > oopClass == interpreterProxy classCharacter > + ifTrue:[^interpreterProxy characterValueOf: oop]. > - ifTrue:[^interpreterProxy fetchInteger: 0 ofObject: oop]. > oopClass == interpreterProxy classLargePositiveInteger > ifTrue:[^interpreterProxy positive32BitValueOf: oop]. > ^interpreterProxy signed32BitValueOf: oop "<- will fail if not > integer"! > > Item was changed: > ----- Method: FFIPlugin>>ffiValidateExternalData:AtomicType: (in > category 'callout support') ----- > ffiValidateExternalData: oop AtomicType: atomicType > "Validate if the given oop (an instance of ExternalData) can be > passed as a pointer to the given atomic type." > | ptrType specOop spec specType | > <inline: true> > ptrType := interpreterProxy fetchPointer: 1 ofObject: oop. > - (interpreterProxy isIntegerObject: ptrType) > - ifTrue:[^self ffiFail: FFIErrorWrongType]. > (interpreterProxy isPointers: ptrType) > ifFalse:[^self ffiFail: FFIErrorWrongType]. > (interpreterProxy slotSizeOf: ptrType) < 2 > ifTrue:[^self ffiFail: FFIErrorWrongType]. > specOop := interpreterProxy fetchPointer: 0 ofObject: ptrType. > - (interpreterProxy isIntegerObject: specOop) > - ifTrue:[^self ffiFail: FFIErrorWrongType]. > (interpreterProxy isWords: specOop) > ifFalse:[^self ffiFail: FFIErrorWrongType]. > (interpreterProxy slotSizeOf: specOop) = 0 > ifTrue:[^self ffiFail: FFIErrorWrongType]. > spec := interpreterProxy fetchPointer: 0 ofObject: specOop. > (self isAtomicType: spec) > ifFalse:[^self ffiFail: FFIErrorWrongType]. > specType := self atomicTypeOf: spec. > specType ~= atomicType ifTrue:[ > "allow for signed/unsigned conversion but nothing else" > (atomicType > FFITypeBool and:[atomicType < > FFITypeSingleFloat]) > ifFalse:[^self ffiFail: FFIErrorCoercionFailed]. > ((atomicType >> 1) = (specType >> 1)) > ifFalse:[^self ffiFail: FFIErrorCoercionFailed]]. > ^0! > > Item was changed: > ----- Method: Interpreter>>primitiveFormPrint (in category 'I/O > primitives') ----- > primitiveFormPrint > "On platforms that support it, this primitive prints the receiver, > assumed to be a Form, to the default printer." > > | landscapeFlag vScale hScale rcvr bitsArray w h > depth pixelsPerWord wordsPerLine bitsArraySize ok | > > <var: #vScale type: 'double '> > <var: #hScale type: 'double '> > landscapeFlag := self booleanValueOf: self stackTop. > vScale := self floatValueOf: (self stackValue: 1). > hScale := self floatValueOf: (self stackValue: 2). > rcvr := self stackValue: 3. > (rcvr isIntegerObject: rcvr) ifTrue: [self success: false]. > successFlag ifTrue: [ > ((self isPointers: rcvr) and: [(self lengthOf: rcvr) >= > 4]) > ifFalse: [self success: false]]. > successFlag ifTrue: [ > bitsArray := self fetchPointer: 0 ofObject: rcvr. > w := self fetchInteger: 1 ofObject: rcvr. > h := self fetchInteger: 2 ofObject: rcvr. > depth := self fetchInteger: 3 ofObject: rcvr. > (w > 0 and: [h > 0]) ifFalse: [self success: false]. > pixelsPerWord := 32 // depth. > wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord. > ((rcvr isIntegerObject: rcvr) not and: [self > isWordsOrBytes: bitsArray]) > ifTrue: [ > bitsArraySize := self byteLengthOf: > bitsArray. > self success: (bitsArraySize = > (wordsPerLine * h * 4))] > ifFalse: [self success: false]]. > successFlag ifTrue: [ > + ok := self cCode: 'ioFormPrint(bitsArray + BaseHeaderSize, > w, h, depth, hScale, vScale, landscapeFlag)'. > - BytesPerWord = 8 > - ifTrue: [ok := self cCode: 'ioFormPrint(bitsArray > + 8, w, h, depth, hScale, vScale, landscapeFlag)'] > - ifFalse: [ok := self cCode: 'ioFormPrint(bitsArray > + 4, w, h, depth, hScale, vScale, landscapeFlag)']. > self success: ok]. > successFlag ifTrue: [ > self pop: 3]. "pop hScale, vScale, and landscapeFlag; > leave rcvr on stack" > ! > > Item was changed: > ----- Method: InterpreterPrimitives>>primitiveFormPrint (in category > 'I/O primitives') ----- > primitiveFormPrint > "On platforms that support it, this primitive prints the receiver, > assumed to be a Form, to the default printer." > > | landscapeFlag vScale hScale rcvr bitsArray w h > depth pixelsPerWord wordsPerLine bitsArraySize ok | > > <var: #vScale type: 'double '> > <var: #hScale type: 'double '> > landscapeFlag := self booleanValueOf: self stackTop. > vScale := self floatValueOf: (self stackValue: 1). > hScale := self floatValueOf: (self stackValue: 2). > rcvr := self stackValue: 3. > + ((objectMemory isPointers: rcvr) > + and: [(objectMemory lengthOf: rcvr) >= 4]) ifFalse: > + [self success: false]. > + self successful ifTrue: > + [bitsArray := objectMemory fetchPointer: 0 ofObject: rcvr. > - (rcvr isIntegerObject: rcvr) ifTrue: [self success: false]. > - self successful ifTrue: [ > - ((objectMemory isPointers: rcvr) and: [(objectMemory > lengthOf: rcvr) >= 4]) > - ifFalse: [self success: false]]. > - self successful ifTrue: [ > - bitsArray := objectMemory fetchPointer: 0 ofObject: rcvr. > w := self fetchInteger: 1 ofObject: rcvr. > h := self fetchInteger: 2 ofObject: rcvr. > depth := self fetchInteger: 3 ofObject: rcvr. > (w > 0 and: [h > 0]) ifFalse: [self success: false]. > pixelsPerWord := 32 // depth. > wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord. > + (objectMemory isWordsOrBytes: bitsArray) > + ifTrue: > + [bitsArraySize := objectMemory > byteLengthOf: bitsArray. > - ((rcvr isIntegerObject: rcvr) not and: [objectMemory > isWordsOrBytes: bitsArray]) > - ifTrue: [ > - bitsArraySize := objectMemory > byteLengthOf: bitsArray. > self success: (bitsArraySize = > (wordsPerLine * h * 4))] > ifFalse: [self success: false]]. > + self successful ifTrue: > + [ok := self cCode: 'ioFormPrint(bitsArray + > BaseHeaderSize, w, h, depth, hScale, vScale, landscapeFlag)'. > - self successful ifTrue: [ > - BytesPerWord = 8 > - ifTrue: [ok := self cCode: 'ioFormPrint(bitsArray > + 8, w, h, depth, hScale, vScale, landscapeFlag)'] > - ifFalse: [ok := self cCode: 'ioFormPrint(bitsArray > + 4, w, h, depth, hScale, vScale, landscapeFlag)']. > self success: ok]. > + self successful ifTrue: > + [self pop: 3] "pop hScale, vScale, and landscapeFlag; > leave rcvr on stack"! > - self successful ifTrue: [ > - self pop: 3]. "pop hScale, vScale, and landscapeFlag; > leave rcvr on stack"! > > Item was changed: > ----- Method: InterpreterProxy>>isArray: (in category 'testing') ----- > isArray: oop > + ^(self isNonImmediate: oop) and: [oop class instSpec = 2]! > - ^(self isIntegerObject: oop) not and:[(oop class format bitAnd: > 15) = 2] > - ! > > Item was changed: > ----- Method: InterpreterProxy>>stackObjectValue: (in category 'stack > access') ----- > stackObjectValue: offset > | oop | > oop := self stackValue: offset. > + (self isImmediate: oop) ifTrue: [self primitiveFail. ^ nil]. > - (self isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil]. > ^oop! > > Item was changed: > ----- Method: JPEGReaderPlugin>>colorComponent:from: (in category > 'decoding') ----- > colorComponent: aColorComponent from: oop > <var: #aColorComponent type: 'int *'> > - (interpreterProxy isIntegerObject: oop) ifTrue:[^false]. > (interpreterProxy isPointers: oop) ifFalse:[^false]. > (interpreterProxy slotSizeOf: oop) < MinComponentSize > ifTrue:[^false]. > aColorComponent at: CurrentXIndex put: > (interpreterProxy fetchInteger: CurrentXIndex ofObject: > oop). > aColorComponent at: CurrentYIndex put: > (interpreterProxy fetchInteger: CurrentYIndex ofObject: > oop). > aColorComponent at: HScaleIndex put: > (interpreterProxy fetchInteger: HScaleIndex ofObject: oop). > aColorComponent at: VScaleIndex put: > (interpreterProxy fetchInteger: VScaleIndex ofObject: oop). > aColorComponent at: BlockWidthIndex put: > (interpreterProxy fetchInteger: BlockWidthIndex ofObject: > oop). > aColorComponent at: MCUWidthIndex put: > (interpreterProxy fetchInteger: MCUWidthIndex ofObject: > oop). > aColorComponent at: PriorDCValueIndex put: > (interpreterProxy fetchInteger: PriorDCValueIndex > ofObject: oop). > ^interpreterProxy failed not! > > Item was changed: > ----- Method: JPEGReaderPlugin>>colorComponentBlocks:from: (in category > 'decoding') ----- > colorComponentBlocks: blocks from: oop > | arrayOop max blockOop | > <var: #blocks type: 'int **'> > - (interpreterProxy isIntegerObject: oop) ifTrue:[^false]. > (interpreterProxy isPointers: oop) ifFalse:[^false]. > (interpreterProxy slotSizeOf: oop) < MinComponentSize > ifTrue:[^false]. > > arrayOop := interpreterProxy fetchPointer: MCUBlockIndex ofObject: > oop. > - (interpreterProxy isIntegerObject: arrayOop) ifTrue:[^false]. > (interpreterProxy isPointers: arrayOop) ifFalse:[^false]. > max := interpreterProxy slotSizeOf: arrayOop. > max > MaxMCUBlocks ifTrue:[^false]. > 0 to: max-1 do:[:i| > blockOop := interpreterProxy fetchPointer: i ofObject: > arrayOop. > - (interpreterProxy isIntegerObject: blockOop) > ifTrue:[^false]. > (interpreterProxy isWords: blockOop) ifFalse:[^false]. > (interpreterProxy slotSizeOf: blockOop) = DCTSize2 > ifFalse:[^false]. > blocks at: i put: (interpreterProxy firstIndexableField: > blockOop). > ]. > ^interpreterProxy failed not! > > Item was changed: > ----- Method: JPEGReaderPlugin>>loadJPEGStreamFrom: (in category 'stream > support') ----- > loadJPEGStreamFrom: streamOop > | oop sz | > - (interpreterProxy slotSizeOf: streamOop) < 5 ifTrue:[^false]. > (interpreterProxy isPointers: streamOop) ifFalse:[^false]. > + (interpreterProxy slotSizeOf: streamOop) < 5 ifTrue:[^false]. > oop := interpreterProxy fetchPointer: 0 ofObject: streamOop. > - (interpreterProxy isIntegerObject: oop) ifTrue:[^false]. > (interpreterProxy isBytes: oop) ifFalse:[^false]. > jsCollection := interpreterProxy firstIndexableField: oop. > sz := interpreterProxy byteSizeOf: oop. > jsPosition := interpreterProxy fetchInteger: 1 ofObject: streamOop. > jsReadLimit := interpreterProxy fetchInteger: 2 ofObject: > streamOop. > jsBitBuffer := interpreterProxy fetchInteger: 3 ofObject: > streamOop. > jsBitCount := interpreterProxy fetchInteger: 4 ofObject: streamOop. > interpreterProxy failed ifTrue:[^false]. > sz < jsReadLimit ifTrue:[^false]. > (jsPosition < 0 or:[jsPosition >= jsReadLimit]) ifTrue:[^false]. > ^true! > > Item was changed: > ----- Method: NewspeakInterpreter>>primitiveFormPrint (in category 'I/O > primitives') ----- > primitiveFormPrint > "On platforms that support it, this primitive prints the receiver, > assumed to be a Form, to the default printer." > > | landscapeFlag vScale hScale rcvr bitsArray w h > depth pixelsPerWord wordsPerLine bitsArraySize ok | > > <var: #vScale type: 'double '> > <var: #hScale type: 'double '> > landscapeFlag := self booleanValueOf: self stackTop. > vScale := self floatValueOf: (self stackValue: 1). > hScale := self floatValueOf: (self stackValue: 2). > rcvr := self stackValue: 3. > (rcvr isIntegerObject: rcvr) ifTrue: [self success: false]. > self successful ifTrue: [ > ((self isPointers: rcvr) and: [(self lengthOf: rcvr) >= > 4]) > ifFalse: [self success: false]]. > self successful ifTrue: [ > bitsArray := self fetchPointer: 0 ofObject: rcvr. > w := self fetchInteger: 1 ofObject: rcvr. > h := self fetchInteger: 2 ofObject: rcvr. > depth := self fetchInteger: 3 ofObject: rcvr. > (w > 0 and: [h > 0]) ifFalse: [self success: false]. > pixelsPerWord := 32 // depth. > wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord. > ((rcvr isIntegerObject: rcvr) not and: [self > isWordsOrBytes: bitsArray]) > ifTrue: [ > bitsArraySize := self byteLengthOf: > bitsArray. > self success: (bitsArraySize = > (wordsPerLine * h * 4))] > ifFalse: [self success: false]]. > self successful ifTrue: [ > + ok := self cCode: 'ioFormPrint(bitsArray + BaseHeaderSize, > w, h, depth, hScale, vScale, landscapeFlag)'. > - BytesPerWord = 8 > - ifTrue: [ok := self cCode: 'ioFormPrint(bitsArray > + 8, w, h, depth, hScale, vScale, landscapeFlag)'] > - ifFalse: [ok := self cCode: 'ioFormPrint(bitsArray > + 4, w, h, depth, hScale, vScale, landscapeFlag)']. > self success: ok]. > self successful ifTrue: [ > self pop: 3]. "pop hScale, vScale, and landscapeFlag; > leave rcvr on stack" > ! > > Item was changed: > ----- Method: ScratchPlugin>>primOpenPortNamed (in category 'serial > port') ----- > primOpenPortNamed > "Open the port with the given name and baud rate." > > | nameStr src nameOop baudRate count portNum | > <export: true> > <var: 'nameStr' declareC: 'char nameStr[1000]'> > + <var: 'src' type: #'char *'> > - <var: 'src' declareC: 'char * src'> > > nameOop := interpreterProxy stackValue: 1. > baudRate := interpreterProxy stackIntegerValue: 0. > > + interpreterProxy success: (interpreterProxy isBytes: nameOop). > - ((interpreterProxy isIntegerObject: nameOop) or: > - [(interpreterProxy isBytes: nameOop) not]) ifTrue: [ > - interpreterProxy success: false. > - ^ 0]. > > interpreterProxy failed ifTrue: [^ 0]. > > + src := self cCoerce: (interpreterProxy firstIndexableField: > nameOop) to: #'char *'. > - src := self cCoerce: (interpreterProxy firstIndexableField: > nameOop) to: 'char *'. > count := interpreterProxy stSizeOf: nameOop. > 0 to: count - 1 do: [:i | nameStr at: i put: (src at: i)]. > nameStr at: count put: 0. > > + portNum := self SerialPortOpen: nameStr PortNamed: baudRate. > - portNum := self cCode: 'SerialPortOpenPortNamed(nameStr, > baudRate)'. > portNum = -1 ifTrue: [interpreterProxy success: false. ^ 0]. > > interpreterProxy "pop args and rcvr, push result" > pop: 3 > thenPush: (interpreterProxy integerObjectOf: portNum). > > ^ 0 > ! > > Item was changed: > ----- Method: ScratchPlugin>>primRead (in category 'serial port') ----- > primRead > "Read data from the given serial port into the given buffer (a > ByteArray or String). Answer the number of bytes read." > > + | portNum bufOop bytesRead | > - | portNum bufOop bufPtr bufSize bytesRead | > <export: true> > - <var: 'bufPtr' declareC: 'char *bufPtr'> > > portNum := interpreterProxy stackIntegerValue: 1. > bufOop := interpreterProxy stackValue: 0. > > + interpreterProxy success: (interpreterProxy isBytes: bufOop). > + interpreterProxy failed ifTrue: [^ 0]. > - ((interpreterProxy isIntegerObject: bufOop) or: > - [(interpreterProxy isBytes: bufOop) not]) ifTrue: [ > - interpreterProxy success: false. > - ^ 0]. > - bufPtr := self cCoerce: (interpreterProxy firstIndexableField: > bufOop) to: 'char *'. > - bufSize := interpreterProxy stSizeOf: bufOop. > - interpreterProxy failed ifTrue: [^ nil]. > > + bytesRead := self Serial: portNum > + Port: (self cCoerce: > (interpreterProxy firstIndexableField: bufOop) to: 'char *') > + Read: (interpreterProxy > stSizeOf: bufOop). > - bytesRead := self cCode: 'SerialPortRead(portNum, bufPtr, > bufSize)'. > > interpreterProxy pop: 3. > "pop args and rcvr" > interpreterProxy pushInteger: bytesRead. "push result" > + ^ 0! > - ^ 0 > - ! > > Item was changed: > ----- Method: ScratchPlugin>>primWrite (in category 'serial port') ----- > primWrite > "Write data to the given serial port from the given buffer (a > ByteArray or String). Answer the number of bytes written." > > + | portNum bufOop bytesWritten | > - | portNum bufOop bufPtr bufSize bytesWritten | > <export: true> > - <var: 'bufPtr' declareC: 'char *bufPtr'> > > portNum := interpreterProxy stackIntegerValue: 1. > bufOop := interpreterProxy stackValue: 0. > > + interpreterProxy success: (interpreterProxy isBytes: bufOop). > + interpreterProxy failed ifTrue: [^ 0]. > - ((interpreterProxy isIntegerObject: bufOop) or: > - [(interpreterProxy isBytes: bufOop) not]) ifTrue: [ > - interpreterProxy success: false. > - ^ 0]. > - bufPtr := self cCoerce: (interpreterProxy firstIndexableField: > bufOop) to: 'char *'. > - bufSize := interpreterProxy stSizeOf: bufOop. > - interpreterProxy failed ifTrue: [^ nil]. > > + bytesWritten := self Serial: portNum > + Port: (self cCoerce: > (interpreterProxy firstIndexableField: bufOop) to: 'char *') > + Write: (interpreterProxy > stSizeOf: bufOop). > - bytesWritten := self cCode: 'SerialPortWrite(portNum, bufPtr, > bufSize)'. > > + interpreterProxy pop: 3. > "pop args and rcvr" > - interpreterProxy pop: 3. > "pop args and rcvr" > interpreterProxy pushInteger: bytesWritten. "push result" > + ^ 0! > - ^ 0 > - ! > > Item was changed: > ----- Method: ScratchPlugin>>primitiveIsHidden (in category 'os > functions') ----- > primitiveIsHidden > "Answer true if the file or folder with the given path should be > hidden from the user. On Windows, this is the value of the 'hidden' file > property." > > | pathOop src count fullPath result | > <export: true> > <var: 'fullPath' declareC: 'char fullPath[1000]'> > + <var: 'src' type: #'char *'> > - <var: 'src' declareC: 'char * src'> > > pathOop := interpreterProxy stackValue: 0. > > + interpreterProxy success: (interpreterProxy isBytes: pathOop). > - ((interpreterProxy isIntegerObject: pathOop) or: > - [(interpreterProxy isBytes: pathOop) not]) ifTrue: [ > - interpreterProxy success: false]. > > interpreterProxy failed ifTrue: [^ 0]. > > + src := self cCoerce: (interpreterProxy firstIndexableField: > pathOop) to: #'char *'. > - src := self cCoerce: (interpreterProxy firstIndexableField: > pathOop) to: 'char *'. > count := interpreterProxy stSizeOf: pathOop. > count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0]. > 0 to: count - 1 do: [:i | fullPath at: i put: (src at: i)]. > fullPath at: count put: 0. > > + result := self IsFileOrFolderHidden: fullPath. > - result := self cCode: 'IsFileOrFolderHidden(fullPath)'. > > interpreterProxy pop: 2. "pop arg and rcvr" > interpreterProxy pushBool: result ~= 0. "push result" > + ^ 0! > - ^ 0 > - > - ! > > Item was changed: > ----- Method: ScratchPlugin>>primitiveOpenURL (in category 'os > functions') ----- > primitiveOpenURL > "Open a web browser on the given URL." > > | urlStr src urlOop count | > <export: true> > <var: 'urlStr' declareC: 'char urlStr[2000]'> > + <var: 'src' type: #'char *'> > - <var: 'src' declareC: 'char * src'> > > urlOop := interpreterProxy stackValue: 0. > > + interpreterProxy success: (interpreterProxy isBytes: urlOop). > - ((interpreterProxy isIntegerObject: urlOop) or: > - [(interpreterProxy isBytes: urlOop) not]) ifTrue: [ > - interpreterProxy success: false]. > > interpreterProxy failed ifTrue: [^ 0]. > > + src := self cCoerce: (interpreterProxy firstIndexableField: > urlOop) to: #'char *'. > - src := self cCoerce: (interpreterProxy firstIndexableField: > urlOop) to: 'char *'. > count := interpreterProxy stSizeOf: urlOop. > count >= 2000 ifTrue: [interpreterProxy success: false. ^ 0]. > 0 to: count - 1 do: [:i | urlStr at: i put: (src at: i)]. > urlStr at: count put: 0. > > + self OpenURL: urlStr. > - self cCode: 'OpenURL(urlStr)'. > > interpreterProxy pop: 1. "pop arg, leave rcvr on stack" > + ^ 0! > - ^ 0 > - > - ! > > Item was changed: > ----- Method: ScratchPlugin>>primitiveSetUnicodePasteBuffer (in category > 'os functions') ----- > primitiveSetUnicodePasteBuffer > "Set the Mac OS X Unicode paste buffer." > > | utf16 strOop count | > <export: true> > + <var: 'utf16' declareC: 'short *utf16'> > - <var: 'utf16' declareC: 'short int *utf16'> > > strOop := interpreterProxy stackValue: 0. > > + interpreterProxy success: (interpreterProxy isBytes: strOop). > - ((interpreterProxy isIntegerObject: strOop) or: > - [(interpreterProxy isBytes: strOop) not]) ifTrue: [ > - interpreterProxy success: false]. > > interpreterProxy failed ifTrue: [^ 0]. > > + utf16 := self cCoerce: (interpreterProxy firstIndexableField: > strOop) to: #'short *'. > - utf16 := self cCoerce: (interpreterProxy firstIndexableField: > strOop) to: 'short int *'. > count := interpreterProxy stSizeOf: strOop. > > + self SetUnicodePaste: utf16 Buffer: count. > - self cCode: 'SetUnicodePasteBuffer(utf16, count)'. > > interpreterProxy pop: 1. "pop arg, leave rcvr on stack" > + ^ 0! > - ^ 0 > - > - ! > > Item was changed: > ----- Method: ScratchPlugin>>primitiveSetWindowTitle (in category 'os > functions') ----- > primitiveSetWindowTitle > "Set the title of the Scratch window." > > | titleStr src titleOop count | > <export: true> > <var: 'titleStr' declareC: 'char titleStr[1000]'> > + <var: 'src' type: #'char *'> > - <var: 'src' declareC: 'char * src'> > > titleOop := interpreterProxy stackValue: 0. > > + interpreterProxy success: (interpreterProxy isBytes: titleOop). > - ((interpreterProxy isIntegerObject: titleOop) or: > - [(interpreterProxy isBytes: titleOop) not]) ifTrue: [ > - interpreterProxy success: false]. > > interpreterProxy failed ifTrue: [^ 0]. > > + src := self cCoerce: (interpreterProxy firstIndexableField: > titleOop) to: #'char *'. > - src := self cCoerce: (interpreterProxy firstIndexableField: > titleOop) to: 'char *'. > count := interpreterProxy stSizeOf: titleOop. > count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0]. > 0 to: count - 1 do: [:i | titleStr at: i put: (src at: i)]. > titleStr at: count put: 0. > > + self SetScratchWindowTitle: titleStr. > - self cCode: 'SetScratchWindowTitle(titleStr)'. > > interpreterProxy pop: 1. "pop arg, leave rcvr on stack" > + ^ 0! > - ^ 0 > - > - ! > > Item was changed: > ----- Method: ScratchPlugin>>primitiveShortToLongPath (in category 'os > functions') ----- > primitiveShortToLongPath > "On Windows, convert a short file/path name into a long one. Fail > on other platforms." > > | shortPath longPath ptr shortPathOop result count resultOop | > <export: true> > <var: 'shortPath' declareC: 'char shortPath[1000]'> > <var: 'longPath' declareC: 'char longPath[1000]'> > + <var: 'ptr' type: #'char *'> > - <var: 'ptr' declareC: 'char * ptr'> > > shortPathOop := interpreterProxy stackValue: 0. > > + (interpreterProxy isBytes: shortPathOop) ifFalse: > + [interpreterProxy success: false. ^ 0]. > - ((interpreterProxy isIntegerObject: shortPathOop) or: > - [(interpreterProxy isBytes: shortPathOop) not]) ifTrue: [ > - interpreterProxy success: false. ^ 0]. > > + ptr := self cCoerce: (interpreterProxy firstIndexableField: > shortPathOop) to: #'char *'. > - ptr := self cCoerce: (interpreterProxy firstIndexableField: > shortPathOop) to: 'char *'. > count := interpreterProxy stSizeOf: shortPathOop. > count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0]. > 0 to: count - 1 do: [:i | shortPath at: i put: (ptr at: i)]. > shortPath at: count put: 0. > > result := self cCode: 'WinShortToLongPath(shortPath, longPath, > 1000)'. > result = -1 ifTrue: [interpreterProxy success: false. ^ 0]. > > + count := self strlen: longPath. > - count := self cCode: 'strlen(longPath)'. > resultOop := interpreterProxy instantiateClass: interpreterProxy > classString indexableSize: count. > + ptr := self cCoerce: (interpreterProxy firstIndexableField: > resultOop) to: #'char *'. > - ptr := self cCoerce: (interpreterProxy firstIndexableField: > resultOop) to: 'char *'. > 0 to: count - 1 do: [:i | ptr at: i put: (longPath at: i)]. > > interpreterProxy pop: 2 thenPush: resultOop. "pop arg and rcvr, > push result" > + ^ 0! > - ^ 0 > - ! > > Item was changed: > ----- Method: SoundCodecPlugin>>primitiveGSMDecode (in category 'gsm > 6.10 codec') ----- > primitiveGSMDecode > > | dstIndex dst srcIndex src frameCount state srcSize dstSize > result srcDelta dstDelta | > <export: true> > dstIndex := interpreterProxy stackIntegerValue: 0. > + dst := interpreterProxy stackValue: 1. > - dst := interpreterProxy stackObjectValue: 1. > srcIndex := interpreterProxy stackIntegerValue: 2. > + src := interpreterProxy stackValue: 3. > - src := interpreterProxy stackObjectValue: 3. > frameCount := interpreterProxy stackIntegerValue: 4. > + state := interpreterProxy stackValue: 5. > - state := interpreterProxy stackObjectValue: 5. > interpreterProxy success: (interpreterProxy isWords: dst). > interpreterProxy success: (interpreterProxy isBytes: src). > interpreterProxy success: (interpreterProxy isBytes: state). > interpreterProxy failed ifTrue:[^ nil]. > srcSize := interpreterProxy slotSizeOf: src. > dstSize := (interpreterProxy slotSizeOf: dst) * 2. > + self cCode: 'gsmDecode(state + BaseHeaderSize, frameCount, src, > srcIndex, srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'. > - self cCode: 'gsmDecode(state + 4, frameCount, src, srcIndex, > srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'. > interpreterProxy failed ifTrue:[^ nil]. > result := interpreterProxy makePointwithxValue: srcDelta yValue: > dstDelta. > interpreterProxy failed ifTrue:[^ nil]. > + interpreterProxy pop: 6 thenPush: result! > - interpreterProxy pop: 6. > - interpreterProxy push: result. > - ! > > Item was changed: > ----- Method: SoundCodecPlugin>>primitiveGSMEncode (in category 'gsm > 6.10 codec') ----- > primitiveGSMEncode > > | dstIndex dst srcIndex src frameCount state srcSize dstSize > result srcDelta dstDelta | > <export: true> > dstIndex := interpreterProxy stackIntegerValue: 0. > + dst := interpreterProxy stackValue: 1. > - dst := interpreterProxy stackObjectValue: 1. > srcIndex := interpreterProxy stackIntegerValue: 2. > + src := interpreterProxy stackValue: 3. > - src := interpreterProxy stackObjectValue: 3. > frameCount := interpreterProxy stackIntegerValue: 4. > + state := interpreterProxy stackValue: 5. > - state := interpreterProxy stackObjectValue: 5. > interpreterProxy success: (interpreterProxy isBytes: dst). > interpreterProxy success: (interpreterProxy isWords: src). > interpreterProxy success: (interpreterProxy isBytes: state). > interpreterProxy failed ifTrue:[^ nil]. > srcSize := (interpreterProxy slotSizeOf: src) * 2. > dstSize := interpreterProxy slotSizeOf: dst. > + self cCode: 'gsmEncode(state + BaseHeaderSize, frameCount, src, > srcIndex, srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'. > - self cCode: 'gsmEncode(state + 4, frameCount, src, srcIndex, > srcSize, dst, dstIndex, dstSize, &srcDelta, &dstDelta)'. > interpreterProxy failed ifTrue:[^ nil]. > result := interpreterProxy makePointwithxValue: srcDelta yValue: > dstDelta. > interpreterProxy failed ifTrue:[^ nil]. > + interpreterProxy pop: 6 thenPush: result! > - interpreterProxy pop: 6. > - interpreterProxy push: result. > - ! > > Item was changed: > ----- Method: SoundCodecPlugin>>primitiveGSMNewState (in category 'gsm > 6.10 codec') ----- > primitiveGSMNewState > > + | state | > - | stateBytes state | > <export: true> > - stateBytes := self cCode: 'gsmStateBytes()'. > state := interpreterProxy > + instantiateClass: interpreterProxy > classByteArray > + indexableSize: self gsmStateBytes. > + self gsmInitState: state + BaseHeaderSize. > + interpreterProxy pop: 1 thenPush: state! > - instantiateClass: interpreterProxy classByteArray > - indexableSize: stateBytes. > - self cCode: 'gsmInitState(state + 4)'. > - interpreterProxy pop: 1. > - interpreterProxy push: state. > - ! > > Item was changed: > ----- Method: SpurMemoryManager>>become:with:twoWay:copyHash: (in > category 'become api') ----- > become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag > "All references to each object in array1 are swapped with all > references to the > corresponding object in array2. That is, all pointers to one > object are replaced > with with pointers to the other. The arguments must be arrays of > the same length. > Answers PrimNoErr if the primitive succeeds, otherwise a relevant > error code." > "Implementation: Uses lazy forwarding to defer updating references > until message send." > | ec | > self assert: becomeEffectsFlags = 0. > self leakCheckBecome ifTrue: > [self runLeakCheckerForFullGC: true]. > (self isArray: array1) ifFalse: > [^PrimErrBadReceiver]. > ((self isArray: array2) > and: [(self numSlotsOf: array1) = (self numSlotsOf: array2)]) > ifFalse: > [^PrimErrBadArgument]. > (twoWayFlag or: [copyHashFlag]) > ifTrue: > [ec := self containsOnlyValidBecomeObjects: array1 > and: array2] > ifFalse: > [self followForwardedObjectFields: array2 toDepth: > 0. > ec := self containsOnlyValidBecomeObjects: array1]. > ec ~= 0 ifTrue: [^ec]. > > coInterpreter preBecomeAction. > twoWayFlag > ifTrue: > [self innerBecomeObjectsIn: array1 and: array2 > copyHash: copyHashFlag] > ifFalse: > [self innerBecomeObjectsIn: array1 to: array2 > copyHash: copyHashFlag]. > self postBecomeScanClassTable. > + self followSpecialObjectsOop. > coInterpreter postBecomeAction: becomeEffectsFlags. > becomeEffectsFlags := 0. > > self leakCheckBecome ifTrue: > [self runLeakCheckerForFullGC: true]. > > ^PrimNoErr "success"! > > Item was changed: > ----- Method: SpurMemoryManager>>eliminateAndFreeForwarders (in category > 'gc - global') ----- > eliminateAndFreeForwarders > "As the final phase of global garbage collect, sweep the heap to > follow > forwarders, then free forwarders, coalescing with free space as > we go." > | lowestFree firstFree lastFree | > <inline: false> > self flag: 'this might be unnecessary. if we were to track > firstFreeChunk we might be able to repeat the > freeUnmarkedObjectsAndSortAndCoalesceFreeSpace; compact cycle until > firstFreeChunk reaches a fixed point'. > self assert: (self isForwarded: nilObj) not. > self assert: (self isForwarded: falseObj) not. > self assert: (self isForwarded: trueObj) not. > self assert: (self isForwarded: self freeListsObj) not. > self assert: (self isForwarded: hiddenRootsObj) not. > self assert: (self isForwarded: classTableFirstPage) not. > + self followSpecialObjectsOop. > - (self isForwarded: specialObjectsOop) ifTrue: > - [specialObjectsOop := self followForwarded: > specialObjectsOop]. > "N.B. we don't have to explicitly do mapInterpreterOops > since the scavenge below will do it." > self followForwardedObjStacks. > scavenger followRememberedForwardersAndForgetFreeObjects. > self doScavenge: DontTenureButDoUnmark. > self checkFreeSpace. > lowestFree := 0. > "sweep, following forwarders in all live objects, and finding the > first forwarder." > self allOldSpaceEntitiesDo: > [:o| > ((self isFreeObject: o) or: [self isForwarded: o]) > ifTrue: > [lowestFree = 0 ifTrue: > [lowestFree := o]] > ifFalse: > [0 to: (self numPointerSlotsOf: o) - 1 do: > [:i| | f | > f := self fetchPointer: i > ofObject: o. > (self isOopForwarded: f) ifTrue: > [f := self > followForwarded: f. > + self storePointer: i > ofObject: o withValue: f]]]]. > - self assert: (self > isYoung: f) not. > - self > storePointerUnchecked: i ofObject: o withValue: f]]]]. > self checkFreeSpace. > lowestFree = 0 ifTrue: "yeah, right..." > [^self]. > firstFree := lastFree := 0. > "Sweep from lowest forwarder, coalescing runs of forwarders and > free objects." > self allOldSpaceEntitiesFrom: lowestFree do: > [:o| > (self isFreeObject: o) > ifTrue: "two cases, isolated, in which case leave > alone, or adjacent, > in which case, remove from free > set prior to coalesce." > [| next | > next := self objectAfter: o limit: > endOfMemory. > self assert: (next = endOfMemory or: > [(self isFreeObject: next) not]). "free chunks have already been coalesced" > (firstFree ~= 0 > or: [next ~= endOfMemory and: [self > isForwarded: next]]) ifTrue: > [firstFree = 0 ifTrue: > [firstFree := o]. > lastFree := o. > self detachFreeObject: o. > self checkFreeSpace]] > ifFalse: > [(self isForwarded: o) > ifTrue: > [firstFree = 0 ifTrue: > [firstFree := o]. > lastFree := o] > ifFalse: > [firstFree ~= 0 ifTrue: > [| start bytes | > start := self > startOfObject: firstFree. > bytes := (self > addressAfter: lastFree) - start. > self > addFreeChunkWithBytes: bytes at: start. > self > checkFreeSpace]. > firstFree := 0]]]. > firstFree ~= 0 ifTrue: > [| start bytes | > start := self startOfObject: firstFree. > bytes := (self addressAfter: lastFree) - start. > self addFreeChunkWithBytes: bytes at: start]. > self checkFreeSpace! > > Item was added: > + ----- Method: SpurMemoryManager>>followSpecialObjectsOop (in category > 'become implementation') ----- > + followSpecialObjectsOop > + (self isForwarded: specialObjectsOop) ifTrue: > + [specialObjectsOop := self followForwarded: > specialObjectsOop]! > > Item was changed: > ----- Method: StackInterpreter>>markAndTraceStackPage: (in category > 'object memory support') ----- > markAndTraceStackPage: thePage > | theSP theFP frameRcvrOffset callerFP oop | > <var: #thePage type: #'StackPage *'> > <var: #theSP type: #'char *'> > <var: #theFP type: #'char *'> > <var: #frameRcvrOffset type: #'char *'> > <var: #callerFP type: #'char *'> > <inline: false> > > self assert: (stackPages isFree: thePage) not. > self assert: thePage trace ~= StackPageTraced. > thePage trace: StackPageTraced. > > theSP := thePage headSP. > theFP := thePage headFP. > "Skip the instruction pointer on top of stack of inactive pages." > thePage = stackPage ifFalse: > [theSP := theSP + BytesPerWord]. > [frameRcvrOffset := self frameReceiverOffset: theFP. > [theSP <= frameRcvrOffset] whileTrue: > [oop := stackPages longAt: theSP. > + (objectMemory isOopForwarded: oop) ifTrue: > + [oop := objectMemory followForwarded: oop. > + stackPages longAt: theSP put: oop]. > (objectMemory isImmediate: oop) ifFalse: > [objectMemory markAndTrace: oop]. > theSP := theSP + BytesPerWord]. > (self frameHasContext: theFP) ifTrue: > [self assert: (objectMemory isContext: (self frameContext: > theFP)). > objectMemory markAndTrace: (self frameContext: theFP)]. > objectMemory markAndTrace: (self iframeMethod: theFP). > (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: > [theSP := theFP + FoxCallerSavedIP + BytesPerWord. > theFP := callerFP]. > theSP := theFP + FoxCallerSavedIP. "caller ip is > frameCallerContext in a base frame" > [theSP <= thePage baseAddress] whileTrue: > [oop := stackPages longAt: theSP. > + (objectMemory isOopForwarded: oop) ifTrue: > + [oop := objectMemory followForwarded: oop. > + stackPages longAt: theSP put: oop]. > (objectMemory isImmediate: oop) ifFalse: > [objectMemory markAndTrace: oop]. > theSP := theSP + BytesPerWord]! > > Item was changed: > ----- Method: ThreadedFFIPlugin>>ffiArgument:Spec:Class:in: (in category > 'callout support') ----- > ffiArgument: oop Spec: argSpec Class: argClass in: calloutState > "Callout support. Prepare the given oop as argument. > argSpec defines the compiled spec for the argument. > argClass (if non-nil) defines the required (super)class for the > argument." > <var: #calloutState type: #'CalloutState *'> > | valueOop oopClass isStruct nilOop | > <inline: false> > oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class > (we'll need it)" > nilOop := interpreterProxy nilObject. > "Do the necessary type checks" > argClass = nilOop ifFalse:[ > "Type check 1: > Is the required class of the argument a subclass of > ExternalStructure?" > (interpreterProxy includesBehavior: argClass > ThatOf: interpreterProxy > classExternalStructure) > ifFalse:[^FFIErrorWrongType]. "Nope. Fail." > "Type check 2: > Is the class of the argument a subclass of required class?" > ((nilOop = oop) or:[interpreterProxy includesBehavior: > oopClass ThatOf: argClass]) > ifFalse:[^FFIErrorCoercionFailed]. "Nope. > Fail." > "Okay, we've passed the type check (so far)" > ]. > > "Check if oopClass is a subclass of ExternalStructure. > If this is the case we'll work on it's handle and not the actual > oop." > isStruct := false. > + ((interpreterProxy isImmediate: oop) or:[oop = nilOop]) ifFalse:[ > + "#isPointers: will fail if oop is immediate so don't even > attempt to use it" > - ((interpreterProxy isIntegerObject: oop) or:[oop = nilOop]) > ifFalse:[ > - "#isPointers: will fail if oop is SmallInteger so don't > even attempt to use it" > (interpreterProxy isPointers: oop) > ifTrue:[isStruct := interpreterProxy > includesBehavior: oopClass > ThatOf: > interpreterProxy classExternalStructure. > (argClass = nilOop or:[isStruct]) > > ifFalse:[^FFIErrorCoercionFailed]]. > "note: the test for #isPointers: above should speed up > execution since no pointer type ST objects are allowed in external calls > and thus if #isPointers: is true then the arg must be ExternalStructure to > work. If it isn't then the code fails anyways so speed isn't an issue" > ]. > > "Determine valueOop (e.g., the actual oop to pass as argument)" > isStruct > ifTrue:[valueOop := interpreterProxy fetchPointer: 0 > ofObject: oop] > ifFalse:[valueOop := oop]. > > "Fetch and check the contents of the compiled spec" > - (interpreterProxy isIntegerObject: argSpec) > - ifTrue:[^FFIErrorWrongType]. > (interpreterProxy isWords: argSpec) > ifFalse:[^FFIErrorWrongType]. > calloutState ffiArgSpecSize: (interpreterProxy slotSizeOf: > argSpec). > calloutState ffiArgSpecSize = 0 ifTrue:[^FFIErrorWrongType]. > calloutState ffiArgSpec: (interpreterProxy firstIndexableField: > argSpec). > calloutState ffiArgHeader: (interpreterProxy longAt: calloutState > ffiArgSpec). > > "Do the actual preparation of the argument" > "Note: Order is important since FFIFlagStructure + FFIFlagPointer > is used to represent 'typedef void* VoidPointer' and VoidPointer really is > *struct* not pointer." > > (calloutState ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[ > "argument must be ExternalStructure" > isStruct ifFalse:[^FFIErrorCoercionFailed]. > (calloutState ffiArgHeader anyMask: FFIFlagAtomic) > ifTrue:[^FFIErrorWrongType]. "bad combination" > ^self ffiPushStructureContentsOf: valueOop in: > calloutState]. > > (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[ > + "no integers (or characters) for pointers please" > + (interpreterProxy isImmediate: oop) > - "no integers for pointers please" > - (interpreterProxy isIntegerObject: oop) > ifTrue:[^FFIErrorIntAsPointer]. > > "but allow passing nil pointer for any pointer type" > oop = nilOop ifTrue:[^self ffiPushPointer: nil in: > calloutState]. > > "argument is reference to either atomic or structure type" > (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[ > isStruct "e.g., ExternalData" > ifTrue:[^self ffiAtomicStructByReference: > oop Class: oopClass in: calloutState] > ifFalse:[^self ffiAtomicArgByReference: > oop Class: oopClass in: calloutState]. > "********* NOTE: The above uses 'oop' not > 'valueOop' (for ExternalData) ******" > ]. > > "Needs to be external structure here" > isStruct ifFalse:[^FFIErrorCoercionFailed]. > ^self ffiPushPointerContentsOf: valueOop in: calloutState]. > > (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[ > "argument is atomic value" > ^self ffiArgByValue: valueOop in: calloutState]. > "None of the above - bad spec" > ^FFIErrorWrongType! > > Item was changed: > ----- Method: ThreadedFFIPlugin>>ffiContentsOfHandle:errCode: (in > category 'callout support') ----- > ffiContentsOfHandle: oop errCode: errCode > "Make sure that the given oop is a valid external handle" > <inline: true> > + ((interpreterProxy isBytes: oop) > + and: [(interpreterProxy byteSizeOf: oop) = 4]) ifFalse: > + [^self ffiFail: errCode]. > - (interpreterProxy isIntegerObject: oop) > - ifTrue:[^self ffiFail: errCode]. > - (interpreterProxy isBytes: oop) > - ifFalse:[^self ffiFail: errCode]. > - ((interpreterProxy byteSizeOf: oop) == 4) > - ifFalse:[^self ffiFail: errCode]. > ^interpreterProxy fetchPointer: 0 ofObject: oop! > > Item was changed: > ----- Method: ThreadedFFIPlugin>>ffiIntegerValueOf: (in category > 'callout support') ----- > ffiIntegerValueOf: oop > "Support for generic callout. Return an integer value that is > coerced as C would do." > | oopClass | > <inline: true> > + (interpreterProxy isIntegerObject: oop) ifTrue: > + [^interpreterProxy integerValueOf: oop]. > + oop = interpreterProxy nilObject ifTrue: [^0]. "@@: should we > really allow this????" > + oop = interpreterProxy falseObject ifTrue: [^0]. > + oop = interpreterProxy trueObject ifTrue: [^1]. > - (interpreterProxy isIntegerObject: oop) ifTrue:[^interpreterProxy > integerValueOf: oop]. > - oop = interpreterProxy nilObject ifTrue:[^0]. "@@: should we > really allow this????" > - oop = interpreterProxy falseObject ifTrue:[^0]. > - oop = interpreterProxy trueObject ifTrue:[^1]. > oopClass := interpreterProxy fetchClassOf: oop. > + oopClass = interpreterProxy classFloat ifTrue: > + [^(interpreterProxy floatValueOf: oop) asInteger]. > + oopClass = interpreterProxy classCharacter ifTrue: > + [^interpreterProxy characterValueOf: oop]. > + oopClass = interpreterProxy classLargePositiveInteger ifTrue: > + [^interpreterProxy positive32BitValueOf: oop]. > + ^interpreterProxy signedMachineIntegerValueOf: oop "<- will fail > if not integer"! > - oopClass = interpreterProxy classFloat > - ifTrue:[^(interpreterProxy floatValueOf: oop) asInteger]. > - oopClass = interpreterProxy classCharacter > - ifTrue:[^interpreterProxy fetchInteger: 0 ofObject: oop]. > - oopClass = interpreterProxy classLargePositiveInteger > - ifTrue:[^interpreterProxy positive32BitValueOf: oop]. > - ^interpreterProxy signed32BitValueOf: oop "<- will fail if not > integer"! > > Item was changed: > ----- Method: ThreadedFFIPlugin>>ffiValidateExternalData:AtomicType: (in > category 'callout support') ----- > ffiValidateExternalData: oop AtomicType: atomicType > "Validate if the given oop (an instance of ExternalData) can be > passed as a pointer to the given atomic type." > | ptrType specOop spec specType | > <inline: true> > ptrType := interpreterProxy fetchPointer: 1 ofObject: oop. > + ((interpreterProxy isPointers: ptrType) > + and: [(interpreterProxy slotSizeOf: ptrType) >= 2]) ifFalse: > + [^FFIErrorWrongType]. > - (interpreterProxy isIntegerObject: ptrType) > - ifTrue:[^FFIErrorWrongType]. > - (interpreterProxy isPointers: ptrType) > - ifFalse:[^FFIErrorWrongType]. > - (interpreterProxy slotSizeOf: ptrType) < 2 > - ifTrue:[^FFIErrorWrongType]. > specOop := interpreterProxy fetchPointer: 0 ofObject: ptrType. > + ((interpreterProxy isWords: specOop) > + and: [(interpreterProxy slotSizeOf: specOop) > 0]) ifFalse: > + [^FFIErrorWrongType]. > - (interpreterProxy isIntegerObject: specOop) > - ifTrue:[^FFIErrorWrongType]. > - (interpreterProxy isWords: specOop) > - ifFalse:[^FFIErrorWrongType]. > - (interpreterProxy slotSizeOf: specOop) = 0 > - ifTrue:[^FFIErrorWrongType]. > spec := interpreterProxy fetchPointer: 0 ofObject: specOop. > + (self isAtomicType: spec) ifFalse: > + [^FFIErrorWrongType]. > - (self isAtomicType: spec) > - ifFalse:[^FFIErrorWrongType]. > specType := self atomicTypeOf: spec. > + specType ~= atomicType ifTrue: > + "Allow for signed/unsigned conversion but nothing else. > + See FFIConstants class>>#initializeTypeConstants" > + [(atomicType >= FFITypeUnsignedByte > + and: [atomicType <= FFITypeSignedChar > + and: [(atomicType >> 1) = (specType >> 1)]]) ifFalse: > + [^FFIErrorCoercionFailed]]. > - specType ~= atomicType ifTrue:[ > - "allow for signed/unsigned conversion but nothing else" > - (atomicType > FFITypeBool and:[atomicType < > FFITypeSingleFloat]) > - ifFalse:[^FFIErrorCoercionFailed]. > - ((atomicType >> 1) = (specType >> 1)) > - ifFalse:[^FFIErrorCoercionFailed]]. > ^0! > > Item was changed: > ----- Method: UnicodePlugin>>asCString: (in category 'utility') ----- > asCString: stringOop > "Return a C char * pointer into the given Squeak string object." > "Warning: A Squeak string is not necessarily null-terminated." > "Warning: the resulting pointer may become invalid after the next > garbage collection and should only be using during the current primitive > call." > > + <returnTypeC: #'char *'> > - <inline: false> > - <returnTypeC: 'char *'> > > + interpreterProxy success: (interpreterProxy isBytes: stringOop). > - ((interpreterProxy isIntegerObject: stringOop) or: > - [(interpreterProxy isBytes: stringOop) not]) ifTrue: [ > - interpreterProxy success: false. > - ^ 0]. > > + ^interpreterProxy failed > + ifTrue: [0] > + ifFalse: [self cCoerce: (interpreterProxy > firstIndexableField: stringOop) to: #'char *']! > - ^ self cCoerce: (interpreterProxy firstIndexableField: stringOop) > to: 'char *' > - ! > > Item was changed: > ----- Method: UnicodePlugin>>cWordsPtr:minSize: (in category 'utility') > ----- > cWordsPtr: oop minSize: minSize > "Return a C pointer to the first indexable field of oop, which > must be a words object of at least the given size." > "Warning: the resulting pointer may become invalid after the next > garbage collection and should only be using during the current primitive > call." > > + <returnTypeC: #'void *'> > - <inline: false> > - <returnTypeC: 'void *'> > > interpreterProxy success: > + ((interpreterProxy isWords: oop) > + and: [(interpreterProxy stSizeOf: oop) >= minSize]). > + ^interpreterProxy failed > + ifTrue: [0] > + ifFalse: [self cCoerce: (interpreterProxy > firstIndexableField: oop) to: #'void *']! > - ((interpreterProxy isIntegerObject: oop) not and: > - [(interpreterProxy isWords: oop) and: > - [(interpreterProxy stSizeOf: oop) >= minSize]]). > - interpreterProxy failed ifTrue: [^ 0]. > - ^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: > 'void *' > - ! > > Item was changed: > ----- Method: UnicodePlugin>>copyString:into:max: (in category > 'utility') ----- > copyString: stringOop into: stringPtr max: maxChars > "Copy the Squeak string into a temporary buffer and add a > terminating null byte. Fail if there is not sufficent space in the buffer." > > | srcPtr count | > <inline: false> > + <var: 'stringPtr' type: #'char *'> > + <var: 'srcPtr' type: #'char *'> > - <var: 'stringPtr' declareC: 'char *stringPtr'> > - <var: 'srcPtr' declareC: 'char *srcPtr'> > > + ((interpreterProxy isBytes: stringOop) > + and: [(count := interpreterProxy stSizeOf: stringOop) < maxChars]) > ifFalse: > + [interpreterProxy success: false. > - ((interpreterProxy isIntegerObject: stringOop) or: > - [(interpreterProxy isBytes: stringOop) not]) ifTrue: [ > - interpreterProxy success: false. > ^ 0]. > > + srcPtr := self cCoerce: (interpreterProxy firstIndexableField: > stringOop) to: #'char *'. > - count := interpreterProxy stSizeOf: stringOop. > - count < maxChars ifFalse: [ > - interpreterProxy success: false. > - ^ 0]. > - > - srcPtr := self cCoerce: (interpreterProxy firstIndexableField: > stringOop) to: 'char *'. > 1 to: count do: [:i | self cCode: '*stringPtr++ = *srcPtr++']. > self cCode: '*stringPtr = 0'. > + ^ 0! > - ^ 0 > - ! > > Item was changed: > ----- Method: UnicodePlugin>>primitiveClipboardGet (in category > 'primitives') ----- > primitiveClipboardGet > "Read the clipboard into the given UTF16 string.." > > | utf16Oop utf16 utf16Length count | > <export: true> > + <var: 'utf16' type: #'unsigned short *'> > - <var: 'utf16' declareC: 'unsigned short *utf16'> > > utf16Oop := interpreterProxy stackValue: 0. > > + interpreterProxy success: (interpreterProxy isWords: utf16Oop). > - ((interpreterProxy isIntegerObject: utf16Oop) or: > - [(interpreterProxy isWords: utf16Oop) not]) ifTrue: [ > - interpreterProxy success: false]. > > interpreterProxy failed ifTrue: [^ 0]. > > + utf16 := self cCoerce: (interpreterProxy firstIndexableField: > utf16Oop) to: #'unsigned short *'. > - utf16 := self cCoerce: (interpreterProxy firstIndexableField: > utf16Oop) to: 'unsigned short *'. > utf16Length := 2 * (interpreterProxy stSizeOf: utf16Oop). > > + count := self unicodeClipboard: utf16 Get: utf16Length. > - count := self cCode: 'unicodeClipboardGet(utf16, utf16Length)'. > > interpreterProxy pop: 2 > thenPush: (interpreterProxy integerObjectOf: count). > > + ^ 0! > - ^ 0 > - ! > > Item was changed: > ----- Method: UnicodePlugin>>primitiveClipboardPut (in category > 'primitives') ----- > primitiveClipboardPut > "Set the clipboard to a UTF16 string.." > > | strOop count utf16 utf16Length | > <export: true> > + <var: 'utf16' type: #'unsigned short *'> > - <var: 'utf16' declareC: 'unsigned short *utf16'> > > strOop := interpreterProxy stackValue: 1. > count := interpreterProxy stackIntegerValue: 0. > > + interpreterProxy success: (interpreterProxy isWords: strOop). > - ((interpreterProxy isIntegerObject: strOop) or: > - [(interpreterProxy isWords: strOop) not]) ifTrue: [ > - interpreterProxy success: false]. > > interpreterProxy failed ifTrue: [^ 0]. > > + utf16 := self cCoerce: (interpreterProxy firstIndexableField: > strOop) to: #'unsigned short *'. > - utf16 := self cCoerce: (interpreterProxy firstIndexableField: > strOop) to: 'unsigned short *'. > utf16Length := 2 * (interpreterProxy stSizeOf: strOop). > ((count >= 0) & (count < utf16Length)) ifTrue: [utf16Length := > count]. > > + self unicodeClipboard: utf16 Put: utf16Length. > - self cCode: 'unicodeClipboardPut(utf16, utf16Length)'. > > interpreterProxy pop: 2. "pop args, leave rcvr on stack" > + ^ 0! > - ^ 0 > - ! > > Item was changed: > ----- Method: WeDoPlugin>>primRead (in category 'translated prims') ----- > primRead > "Read data from the WeDo port into the given buffer (a ByteArray > or String). Answer the number of bytes read." > > | bufOop bufPtr bufSize byteCount | > <export: true> > <var: 'bufPtr' declareC: 'char *bufPtr'> > > bufOop := interpreterProxy stackValue: 0. > + (interpreterProxy isBytes: bufOop) ifFalse: [ > - ((interpreterProxy isIntegerObject: bufOop) or: > - [(interpreterProxy isBytes: bufOop) not]) ifTrue: [ > interpreterProxy success: false. > ^ 0]. > bufPtr := self cCoerce: (interpreterProxy firstIndexableField: > bufOop) to: 'char *'. > bufSize := interpreterProxy stSizeOf: bufOop. > interpreterProxy failed ifTrue: [^ 0]. > > byteCount := self cCode: 'WeDoRead(bufPtr, bufSize)'. > byteCount < 0 ifTrue: [ > interpreterProxy success: false. > ^ 0]. > > interpreterProxy pop: 2. > "pop args and rcvr" > interpreterProxy pushInteger: byteCount. "push result" > ^ 0 > ! > > Item was changed: > ----- Method: WeDoPlugin>>primWrite (in category 'translated prims') > ----- > primWrite > "Write data to the WeDo port from the given buffer (a ByteArray or > String). Answer the number of bytes written." > > | bufOop bufPtr bufSize byteCount | > <export: true> > <var: 'bufPtr' declareC: 'char *bufPtr'> > > bufOop := interpreterProxy stackValue: 0. > + (interpreterProxy isBytes: bufOop) ifFalse: [ > - ((interpreterProxy isIntegerObject: bufOop) or: > - [(interpreterProxy isBytes: bufOop) not]) ifTrue: [ > interpreterProxy success: false. > ^ 0]. > bufPtr := self cCoerce: (interpreterProxy firstIndexableField: > bufOop) to: 'char *'. > bufSize := interpreterProxy stSizeOf: bufOop. > interpreterProxy failed ifTrue: [^ 0]. > > byteCount := self cCode: 'WeDoWrite(bufPtr, bufSize)'. > byteCount < 0 ifTrue: [ > interpreterProxy success: false. > ^ 0]. > > interpreterProxy pop: 2. > "pop args and rcvr" > interpreterProxy pushInteger: byteCount. "push result" > ^ 0 > ! > > -- best, Eliot

2 1

VM Maker: VMMaker.oscog-eem.609.mcz
by commits＠source.squeak.org 05 Feb '14

05 Feb '14

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.609.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.609 Author: eem Time: 5 February 2014, 1:02:29.791 pm UUID: 2a0cbd3c-d667-47c5-8ec1-b8bcbe4680a1 Ancestors: VMMaker.oscog-eem.608 Fix the generic primitiveClone for immediates. =============== Diff against VMMaker.oscog-eem.608 =============== Item was changed: ----- Method: InterpreterPrimitives>>primitiveClone (in category 'object access primitives') ----- primitiveClone "Return a shallow copy of the receiver." + | rcvr newCopy | + rcvr := self stackTop. + (objectMemory isImmediate: rcvr) + ifTrue: + [newCopy := rcvr] + ifFalse: + [newCopy := objectMemory clone: rcvr. + newCopy = 0 ifTrue: "not enough memory most likely" + [^self primitiveFail]]. + self pop: 1 thenPush: newCopy! - | newCopy | - newCopy := objectMemory clone: (self stackTop). - newCopy = 0 - ifTrue:["not enough memory most likely" ^self primitiveFail]. - self pop: 1 thenPush: newCopy.!

1 0

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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev February 2014