Vm-dev April 2013

vm-dev@lists.squeakfoundation.org

36 participants
107 discussions

[commit][2712] try to resume after stream suspension; remove uninitialised parameter from hw setup; use more realistic buffer thresholds
by commits＠squeakvm.org 04 Apr '13

04 Apr '13

Revision: 2712 Author: piumarta Date: 2013-04-03 22:05:14 -0700 (Wed, 03 Apr 2013) Log Message: ----------- try to resume after stream suspension; remove uninitialised parameter from hw setup; use more realistic buffer thresholds Modified Paths: -------------- trunk/platforms/unix/vm-sound-ALSA/sqUnixSoundALSA.c Modified: trunk/platforms/unix/vm-sound-ALSA/sqUnixSoundALSA.c =================================================================== --- trunk/platforms/unix/vm-sound-ALSA/sqUnixSoundALSA.c 2013-03-26 01:49:32 UTC (rev 2711) +++ trunk/platforms/unix/vm-sound-ALSA/sqUnixSoundALSA.c 2013-04-04 05:05:14 UTC (rev 2712) @@ -2,7 +2,7 @@ * * Author: Ian.Piumarta(a)squeakland.org * - * Last edited: 2010-04-01 13:48:37 by piumarta on emilia-2.local + * Last edited: 2013-04-04 13:59:35 by piumarta on linux32 * * Copyright (C) 2006 by Ian Piumarta * All rights reserved. @@ -65,8 +65,10 @@ /* output */ +#if 0 #define SQ_SND_PLAY_START_THRESHOLD 7/8 #define SQ_SND_PLAY_AVAIL_MIN 4/8 +#endif static snd_pcm_t *output_handle= 0; static snd_async_handler_t *output_handler= 0; @@ -99,8 +101,8 @@ int err; snd_pcm_hw_params_t *hwparams; snd_pcm_sw_params_t *swparams; + snd_pcm_uframes_t period_size; unsigned int uval; - int dir; if (output_handle) sound_Stop(); @@ -114,18 +116,25 @@ snd_pcm_hw_params_set_format(output_handle, hwparams, SND_PCM_FORMAT_S16_LE); snd_pcm_hw_params_set_channels(output_handle, hwparams, output_channels); uval= samplesPerSec; - snd_pcm_hw_params_set_rate_near(output_handle, hwparams, &uval, &dir); + snd_pcm_hw_params_set_rate_near(output_handle, hwparams, &uval, 0); output_buffer_period_size= frameCount; - snd_pcm_hw_params_set_period_size_near(output_handle, hwparams, &output_buffer_period_size, &dir); + snd_pcm_hw_params_set_period_size_near(output_handle, hwparams, &output_buffer_period_size, 0); snd(pcm_hw_params(output_handle, hwparams), "sound_Start: snd_pcm_hw_params"); snd_pcm_sw_params_alloca(&swparams); snd(pcm_sw_params_current(output_handle, swparams), "sound_Start: snd_pcm_sw_params_current"); +#if 0 snd(pcm_sw_params_set_start_threshold(output_handle, swparams, frameCount * SQ_SND_PLAY_START_THRESHOLD), "sound_Start: snd_pcm_sw_params_set_start_threshold"); snd(pcm_sw_params_set_avail_min(output_handle, swparams, frameCount * SQ_SND_PLAY_AVAIL_MIN), "sound_Start: snd_pcm_sw_parama_set_avail_min"); +#endif snd(pcm_sw_params_set_xfer_align(output_handle, swparams, 1), "sound_Start: snd_pcm_sw_params_set_xfer_align"); snd(pcm_sw_params(output_handle, swparams), "sound_Start: snd_pcm_sw_params"); + + snd(pcm_hw_params_get_period_size(hwparams, &period_size, 0), "sound_Start: pcm_hw_params_get_period_size"); snd(pcm_hw_params_get_buffer_size(hwparams, &output_buffer_size), "sound_Start: pcm_hw_params_get_buffer_size"); + snd(pcm_sw_params_set_avail_min(output_handle, swparams, period_size), "sound_Start: snd_pcm_sw_parama_set_avail_min"); + snd(pcm_sw_params_set_start_threshold(output_handle, swparams, output_buffer_size), "sound_Start: snd_pcm_sw_params_set_start_threshold"); + output_buffer_frames_available= 1; max_delay_frames= output_buffer_period_size * 2; /* set initial delay frames */ @@ -200,6 +209,7 @@ static sqInt sound_PlaySamplesFromAtLength(sqInt frameCount, void *srcBufPtr, sqInt startIndex) { +#if 0 if (output_handle) { void *samples= srcBufPtr + startIndex * output_channels * 2; @@ -222,6 +232,41 @@ return count; } success(false); +#else + if (!output_handle) + success(false); + else { + void *samples= srcBufPtr + startIndex * output_channels * 2; + int count= snd_pcm_writei(output_handle, samples, frameCount); + + if (count < frameCount / 2) + output_buffer_frames_available= 0; + + if (count >= 0) + return count; + + switch (count) { + case -EPIPE: { /* under-run */ + int err= snd_pcm_prepare(output_handle); + if (err < 0) fprintf(stderr, "sound_PlaySamples: can't recover from underrun, snd_pcm_prepare failed: %s", snd_strerror(err)); + break; + } + case -ESTRPIPE: { /* stream suspended */ + int err; + int timeout= 5; /* half a second */ + while (-EAGAIN == (err= snd_pcm_resume(output_handle)) && timeout--) + usleep(100000); /* wait 1/10 of a second for suspend flag to be released */ + if (-EAGAIN == err) break; /* return to interpreter and try to recover next time around */ + if (err < 0) err= snd_pcm_prepare(output_handle); + if (err < 0) fprintf(stderr, "sound_PlaySamples: can't recover from suspend, snd_pcm_prepare failed: %s", snd_strerror(err)); + break; + } + default: + fprintf(stderr, "snd_pcm_writei returned %i\n", count); + break; + } + } +#endif return 0; } @@ -231,8 +276,10 @@ /* input */ +#if 0 #define SQ_SND_REC_START_THRESHOLD 4/8 #define SQ_SND_REC_AVAIL_MIN 4/8 +#endif static snd_pcm_t *input_handle= 0; static snd_async_handler_t *input_handler= 0; @@ -262,7 +309,8 @@ snd_pcm_hw_params_t *hwparams; snd_pcm_sw_params_t *swparams; snd_pcm_uframes_t frames; - int dir; + snd_pcm_uframes_t period_size; + snd_pcm_uframes_t buffer_size; if (input_handle) sound_StopRecording(); @@ -276,15 +324,23 @@ snd_pcm_hw_params_set_format(input_handle, hwparams, SND_PCM_FORMAT_S16_LE); snd_pcm_hw_params_set_channels(input_handle, hwparams, input_channels); input_rate= desiredSamplesPerSec; - snd_pcm_hw_params_set_rate_near(input_handle, hwparams, &input_rate, &dir); + snd_pcm_hw_params_set_rate_near(input_handle, hwparams, &input_rate, 0); frames= 4096; - snd_pcm_hw_params_set_period_size_near(input_handle, hwparams, &frames, &dir); + snd_pcm_hw_params_set_period_size_near(input_handle, hwparams, &frames, 0); snd(pcm_hw_params(input_handle, hwparams), "sound_StartRecording: snd_pcm_hw_params"); + snd(pcm_hw_params_get_period_size(hwparams, &period_size, 0), "sound_Start: pcm_hw_params_get_period_size"); + snd(pcm_hw_params_get_buffer_size(hwparams, &buffer_size), "sound_Start: pcm_hw_params_get_buffer_size"); + snd_pcm_sw_params_alloca(&swparams); snd(pcm_sw_params_current(input_handle, swparams), "sound_StartRecording: snd_pcm_sw_params_current"); +#if 0 snd(pcm_sw_params_set_start_threshold(input_handle, swparams, frames * SQ_SND_REC_START_THRESHOLD), "sound_StartRecording: snd_pcm_sw_params_set_start_threshold"); snd(pcm_sw_params_set_avail_min(input_handle, swparams, frames * SQ_SND_REC_AVAIL_MIN), "sound_StartRecording: snd_pcm_sw_parama_set_avail_min"); +#else + snd(pcm_sw_params_set_start_threshold(input_handle, swparams, buffer_size), "sound_StartRecording: snd_pcm_sw_params_set_start_threshold"); + snd(pcm_sw_params_set_avail_min(input_handle, swparams, period_size), "sound_StartRecording: snd_pcm_sw_parama_set_avail_min"); +#endif snd(pcm_sw_params_set_xfer_align(input_handle, swparams, 1), "sound_StartRecording: snd_pcm_sw_params_set_xfer_align"); snd(pcm_sw_params(input_handle, swparams), "sound_StartRecording: snd_pcm_sw_params");

1 0

VM Maker: VMMaker.oscog-eem.282.mcz
by commits＠source.squeak.org 04 Apr '13

04 Apr '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.282.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.282 Author: eem Time: 3 April 2013, 4:14:26.273 pm UUID: 6c2f2048-555b-4d37-a9eb-4d9252acf3b9 Ancestors: VMMaker.oscog-eem.281 Slang: Fix SmartSyntaxPlugin support method affected by the fixes for generating to:by:do: loops in VMMaker.oscog-eem.279. =============== Diff against VMMaker.oscog-eem.281 =============== Item was changed: ----- Method: TMethod>>preparePrimitivePrologue (in category 'primitive compilation') ----- preparePrimitivePrologue "Add a prolog and postlog to a primitive method. The prolog copies any instance variables referenced by this primitive method into local variables. The postlog copies values of assigned-to variables back into the instance. The names of the new locals are added to the local variables list. The declarations dictionary defines the types of any non-integer variables (locals, arguments, or instance variables). In particular, it may specify the types: int * -- an array of 32-bit values (e.g., a BitMap) short * -- an array of 16-bit values (e.g., a SoundBuffer) char * -- an array of unsigned bytes (e.g., a String) double -- a double precision floating point number (e.g., 3.14159) Undeclared variables are taken to be integers and will be converted from Smalltalk to C ints." "Current restrictions: o method must not contain message sends o method must not allocate objects o method must not manipulate raw oops o method cannot access class variables o method can only return an integer" | prolog postlog instVarsUsed varsAssignedTo instVarList primArgCount varName endsWithReturn aClass | + self assert: selector ~~ #setInterpreter:. - selector == #setInterpreter: ifTrue:[self halt]. aClass := definingClass. prolog := OrderedCollection new. postlog := OrderedCollection new. instVarsUsed := self freeVariableReferences asSet. varsAssignedTo := self variablesAssignedTo asSet. instVarList := aClass allInstVarNames. primArgCount := args size. "add receiver fetch and arg conversions to prolog" prolog addAll: self fetchRcvrExpr. 1 to: args size do: [:argIndex | varName := args at: argIndex. prolog addAll: (self argConversionExprFor: varName stackIndex: args size - argIndex)]. "add success check to postlog" postlog addAll: self checkSuccessExpr. "add instance variable fetches to prolog and instance variable stores to postlog" 1 to: instVarList size do: [:varIndex | varName := instVarList at: varIndex. (instVarsUsed includes: varName) ifTrue: [ locals add: varName. prolog addAll: (self instVarGetExprFor: varName offset: varIndex - 1). (varsAssignedTo includes: varName) ifTrue: [ postlog addAll: (self instVarPutExprFor: varName offset: varIndex - 1)]]]. prolog addAll: self checkSuccessExpr. + ((locals includes: 'rcvr') or: [(locals intersection: args) notEmpty]) ifTrue: + [self error: 'local name conflicts with instance variable name']. + locals add: 'rcvr'; addAll: args. - locals addAllFirst: args. - locals addFirst: 'rcvr'. args := args class new. - locals asSet size = locals size - ifFalse: [self error: 'local name conflicts with instance variable name']. endsWithReturn := self endsWithReturn. self fixUpReturns: primArgCount postlog: postlog. endsWithReturn ifTrue: [parseTree setStatements: prolog, parseTree statements] ifFalse: [ postlog addAll: (self popArgsExpr: primArgCount). parseTree setStatements: prolog, parseTree statements, postlog]. !

1 0

VM Maker: VMMaker.oscog-eem.281.mcz
by commits＠source.squeak.org 04 Apr '13

04 Apr '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.281.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.281 Author: eem Time: 3 April 2013, 3:27:02.058 pm UUID: 64be55df-6421-4087-a712-5c07419806c7 Ancestors: VMMaker.oscog-eem.280 Cogit: Fix *HORRIBLE* yet ancient bug with the CogObjectRep. Both CogObjectRepresentationForSqueakV3>>couldBeObject: & CogObjectRepresentationForSqueakV3>>shouldAnnotateObjectReference: used signed comparisons for oops and so once the heap size pushes oops into the upper half of the address space constant oops in machine code were no longer being updated by the GC. StackInterpreter: reqrite the login for printing methods so that printing the frame of a bad receiver won't seg fault. =============== Diff against VMMaker.oscog-eem.280 =============== Item was changed: ----- Method: CogObjectRepresentationForSqueakV3>>couldBeObject: (in category 'garbage collection') ----- couldBeObject: oop ^(objectMemory isNonIntegerObject: oop) + and: [self oop: oop isGreaterThanOrEqualTo: objectMemory nilObject]! - and: [oop asUnsignedInteger >= objectMemory nilObject]! Item was changed: ----- Method: CogObjectRepresentationForSqueakV3>>shouldAnnotateObjectReference: (in category 'garbage collection') ----- shouldAnnotateObjectReference: anOop "self assert: ((objectMemory isIntegerObject: anOop) or: [objectMemory addressCouldBeObj: anOop])." ^(objectMemory isNonIntegerObject: anOop) + and: [self oop: anOop isGreaterThan: objectMemory trueObject]! - and: [anOop > objectMemory trueObject]! Item was changed: ----- Method: StackInterpreter class>>requiredMethodNames (in category 'translation') ----- requiredMethodNames "return the list of method names that should be retained for export or other support reasons" | requiredList | requiredList := self exportAPISelectors. requiredList addAll: NewObjectMemory requiredMethodNames. "A number of methods required by VM support code, jitter, specific platforms etc" requiredList addAll: #( assertValidExecutionPointe:r:s: characterForAscii: checkedLongAt: delayExpired + findClassOfMethod:forReceiver: findSelectorOfMethod: - findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: forceInterruptCheck forceInterruptCheckFromHeartbeat fullDisplayUpdate getCurrentBytecode getFullScreenFlag getInterruptKeycode getInterruptPending getSavedWindowSize getThisSessionID highBit: interpret loadInitialContext oopFromChunk: primitiveFail primitiveFailFor: primitiveFlushExternalPrimitives printAllStacks printCallStack printContext: printExternalHeadFrame printFramesInPage: printFrame: printHeadFrame printMemory printOop: printStackPages printStackPageList printStackPagesInUse printStackPageListInUse readableFormat: readImageFromFile:HeapSize:StartingAt: setFullScreenFlag: setInterruptKeycode: setInterruptPending: setInterruptCheckChain: setSavedWindowSize: success: validInstructionPointer:inMethod:framePointer:). "Nice to actually have all the primitives available" requiredList addAll: (self primitiveTable select: [:each| each isSymbol]). "InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those" InterpreterProxy organization categories do: [:cat | ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]]. ^requiredList! Item was added: + ----- Method: StackInterpreter>>addressCouldBeClassObj: (in category 'debug support') ----- + addressCouldBeClassObj: maybeClassObj + "Answer if maybeClassObj looks like a class object" + <inline: false> + ^(objectMemory addressCouldBeObj: maybeClassObj) + and: [((objectMemory isPointersNonInt: maybeClassObj) and: [(objectMemory lengthOf: maybeClassObj) >= 3]) + and: [(objectMemory isPointersNonInt: (objectMemory fetchPointer: SuperclassIndex ofObject: maybeClassObj)) + and: [(objectMemory isPointersNonInt: (objectMemory fetchPointer: MethodDictionaryIndex ofObject: maybeClassObj)) + and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: maybeClassObj))]]]]! Item was added: + ----- Method: StackInterpreter>>findClassContainingMethod:startingAt: (in category 'debug support') ----- + findClassContainingMethod: meth startingAt: classObj + | currClass classDict classDictSize methodArray i | + currClass := classObj. + [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. + classDictSize := objectMemory fetchWordLengthOf: classDict. + methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. + i := 0. + [i < (classDictSize - SelectorStart)] whileTrue: + [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: + [^currClass]. + i := i + 1]. + currClass := self superclassOf: currClass. + currClass = objectMemory nilObject] whileFalse. + ^currClass "method not found in superclass chain"! Item was changed: ----- Method: StackInterpreter>>findClassOfMethod:forReceiver: (in category 'debug support') ----- findClassOfMethod: meth forReceiver: rcvr + | rclass | + (objectMemory addressCouldBeOop: rcvr) ifTrue: + [rclass := objectMemory fetchClassOf: rcvr. + (self addressCouldBeClassObj: rclass) ifTrue: + [rclass := self findClassContainingMethod: meth startingAt: rclass. + rclass ~= objectMemory nilObject ifTrue: + [^rclass]]]. - - | rclass currClass classDict classDictSize methodArray i | (objectMemory addressCouldBeObj: meth) ifFalse: [^objectMemory nilObject]. + ^self findClassContainingMethod: meth startingAt: (self methodClassOf: meth)! - (objectMemory addressCouldBeOop: rcvr) - ifTrue: [rclass := objectMemory fetchClassOf: rcvr] - ifFalse: [rclass := self methodClassOf: meth]. - currClass := rclass. - [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. - classDictSize := objectMemory fetchWordLengthOf: classDict. - methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. - i := 0. - [i < (classDictSize - SelectorStart)] whileTrue: - [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: - [^currClass]. - i := i + 1]. - currClass := self superclassOf: currClass. - currClass = objectMemory nilObject] whileFalse. - ^rclass "method not found in superclass chain"! Item was added: + ----- Method: StackInterpreter>>findSelectorOfMethod: (in category 'debug support') ----- + findSelectorOfMethod: meth + | classObj classDict classDictSize methodArray i | + (objectMemory addressCouldBeObj: meth) ifFalse: + [^objectMemory nilObject]. + classObj := self methodClassOf: meth. + (self addressCouldBeClassObj: classObj) ifTrue: + [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: classObj. + classDictSize := objectMemory fetchWordLengthOf: classDict. + methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. + i := 0. + [i <= (classDictSize - SelectorStart)] whileTrue: + [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: + [^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)]. + i := i + 1]]. + ^objectMemory nilObject! Item was removed: - ----- Method: StackInterpreter>>findSelectorOfMethod:forReceiver: (in category 'debug support') ----- - findSelectorOfMethod: meth forReceiver: rcvr - - | currClass classDict classDictSize methodArray i | - (objectMemory addressCouldBeObj: meth) ifFalse: - [^objectMemory nilObject]. - (objectMemory addressCouldBeOop: rcvr) - ifTrue: [currClass := objectMemory fetchClassOf: rcvr] - ifFalse: [currClass := self methodClassOf: meth]. - [classDict := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currClass. - classDictSize := objectMemory fetchWordLengthOf: classDict. - methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: classDict. - i := 0. - [i <= (classDictSize - SelectorStart)] whileTrue: - [meth = (objectMemory fetchPointer: i ofObject: methodArray) ifTrue: - [^(objectMemory fetchPointer: i + SelectorStart ofObject: classDict)]. - i := i + 1]. - currClass := self superclassOf: currClass. - currClass = objectMemory nilObject] whileFalse. - ^currClass "method not found in superclass chain"! Item was changed: ----- Method: StackInterpreter>>printActivationNameFor:receiver:isBlock:firstTemporary: (in category 'debug printing') ----- printActivationNameFor: aMethod receiver: anObject isBlock: isBlock firstTemporary: maybeMessage + | methClass methodSel classObj | - | methClass methodSel | <inline: false> isBlock ifTrue: [self print: '[] in ']. methClass := self findClassOfMethod: aMethod forReceiver: anObject. + methodSel := self findSelectorOfMethod: aMethod. + ((objectMemory addressCouldBeOop: anObject) + and: [self addressCouldBeClassObj: (classObj := objectMemory fetchClassOf: anObject)]) - methodSel := self findSelectorOfMethod: aMethod forReceiver: anObject. - (objectMemory addressCouldBeOop: anObject) ifTrue: + [classObj = methClass - [(objectMemory fetchClassOf: anObject) = methClass ifTrue: [self printNameOfClass: methClass count: 5] ifFalse: + [self printNameOfClass: classObj count: 5. - [self printNameOfClass: (objectMemory fetchClassOf: anObject) count: 5. self print: '('. self printNameOfClass: methClass count: 5. self print: ')']] ifFalse: [self print: 'INVALID RECEIVER']. self print: '>'. (objectMemory addressCouldBeOop: methodSel) ifTrue: [methodSel = objectMemory nilObject ifTrue: [self print: '?'] ifFalse: [self printStringOf: methodSel]] ifFalse: [self print: 'INVALID SELECTOR']. (methodSel = (objectMemory splObj: SelectorDoesNotUnderstand) and: [(objectMemory addressCouldBeObj: maybeMessage) and: [(objectMemory fetchClassOf: maybeMessage) = (objectMemory splObj: ClassMessage)]]) ifTrue: ["print arg message selector" methodSel := objectMemory fetchPointer: MessageSelectorIndex ofObject: maybeMessage. self print: ' '. self printStringOf: methodSel]! Item was changed: ----- Method: StackInterpreter>>selectorOfContext: (in category 'debug printing') ----- selectorOfContext: aContext (objectMemory isContext: aContext) ifFalse: [^nil]. + ^self findSelectorOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: aContext)! - ^self - findSelectorOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: aContext) - forReceiver: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext)!

1 0

VM Maker: VMMaker.oscog-eem.280.mcz
by commits＠source.squeak.org 04 Apr '13

04 Apr '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.280.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.280 Author: eem Time: 3 April 2013, 3:19:05.275 pm UUID: 8caedff8-7423-4f1d-a007-19ea906a098b Ancestors: VMMaker.oscog-eem.279 Add primitivePathToUsing which mimics the PointerFinder and can hence be used to debug it. Remove unnecessary forceInterruptCheck in NewObjectMemory>>become:with:twoWay:copyHash:. (heartbeat does this for us). Fix bug in assert in NewCoObjectMemory>>restoreHeaderOf:to:. Slang: Move SmartSyntaxPluginTMethod>>oopVariable: to TMethod. =============== Diff against VMMaker.oscog-eem.279 =============== Item was changed: StackInterpreterPrimitives subclass: #CoInterpreter instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod lastBackwardJumpMethod backwardJumpCount reenterInterpreter deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod processHasThreadId flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile noThreadingOfGUIThread' + classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield CogitClass HasBeenReturnedFromMCPC MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn' - classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield CogitClass HasBeenReturnedFromMCPC MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn' poolDictionaries: 'CogMethodConstants VMStackFrameOffsets' category: 'VMMaker-JIT'! !CoInterpreter commentStamp: '<historical>' prior: 0! I am a variant of the StackInterpreter that can co-exist with the Cog JIT. I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT. See CogMethod class's comment for method interoperability.! Item was changed: ----- Method: CoInterpreter class>>initializeFrameIndices (in category 'initialization') ----- initializeFrameIndices "Format of a stack frame. Word-sized indices relative to the frame pointer. Terminology Frames are either single (have no context) or married (have a context). Contexts are either single (exist on the heap), married (have a context) or widowed (had a frame that has exited). Stacks grow down: receiver for method activations/closure for block activations arg0 ... argN caller's saved ip/this stackPage (for a base frame) fp-> saved fp method context (initialized to nil) frame flags (interpreter only) saved method ip (initialized to 0; interpreter only) receiver first temp ... sp-> Nth temp In an interpreter frame frame flags holds the number of arguments (since argument temporaries are above the frame) the flag for a block activation and the flag indicating if the context field is valid (whether the frame is married). saved method ip holds the saved method ip when the callee frame is a machine code frame. This is because the saved method ip is actually the ceReturnToInterpreterTrampoline address. In a machine code frame the flag indicating if the context is valid is the least significant bit of the method pointer the flag for a block activation is the next most significant bit of the method pointer Interpreter frames are distinguished from method frames by the method field which will be a pointer into the heap for an interpreter frame and a pointer into the method zone for a machine code frame. The first frame in a stack page is the baseFrame and is marked as such by a saved fp being its stackPage, in which case the first word on the stack is the caller context (possibly hybrid) beneath the base frame." | fxCallerSavedIP fxSavedFP fxMethod fxIFrameFlags fxThisContext fxIFReceiver fxMFReceiver fxIFSavedIP | fxCallerSavedIP := 1. fxSavedFP := 0. fxMethod := -1. fxThisContext := -2. fxIFrameFlags := -3. "Can find numArgs, needed for fast temp access. args are above fxCallerSavedIP. Can find ``is block'' bit Can find ``has context'' bit" fxIFSavedIP := -4. fxIFReceiver := -5. fxMFReceiver := -3. "For debugging nil out values that differ in the StackInterpreter." FrameSlots := #undeclared. IFrameSlots := fxCallerSavedIP - fxIFReceiver + 1. MFrameSlots := fxCallerSavedIP - fxMFReceiver + 1. FoxCallerSavedIP := fxCallerSavedIP * BytesPerWord. "In Cog a base frame's caller context is stored on the first word of the stack page." FoxCallerContext := #undeclared. FoxSavedFP := fxSavedFP * BytesPerWord. FoxMethod := fxMethod * BytesPerWord. FoxThisContext := fxThisContext * BytesPerWord. FoxFrameFlags := #undeclared. FoxIFrameFlags := fxIFrameFlags * BytesPerWord. FoxIFSavedIP := fxIFSavedIP * BytesPerWord. FoxReceiver := #undeclared. FoxIFReceiver := fxIFReceiver * BytesPerWord. FoxMFReceiver := fxMFReceiver * BytesPerWord. "N.B. There is room for one more flag given the current 8 byte alignment of methods (which is at least needed to distinguish the checked and uncecked entry points by their alignment." MFMethodFlagHasContextFlag := 1. MFMethodFlagIsBlockFlag := 2. + MFMethodFlagFrameIsMarkedFlag := 4. "for pathTo:using:followWeak:" + MFMethodFlagsMask := MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag + MFMethodFlagFrameIsMarkedFlag. - MFMethodFlagsMask := MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag. MFMethodMask := (MFMethodFlagsMask + 1) negated! Item was added: + ----- Method: CoInterpreterPrimitives>>frameIsMarked: (in category 'object access primitives') ----- + frameIsMarked: theFPInt + | methodField | + methodField := stackPages longAt: theFPInt + FoxMethod. + ^methodField asUnsignedInteger < objectMemory startOfMemory + ifTrue: [(methodField bitAnd: 4) ~= 0] + ifFalse: [((stackPages longAt: theFPInt + FoxIFrameFlags) bitAnd: 2) ~= 0]! Item was added: + ----- Method: CoInterpreterPrimitives>>markFrame: (in category 'object access primitives') ----- + markFrame: theFPInt + | methodField | + methodField := stackPages longAt: theFPInt + FoxMethod. + methodField asUnsignedInteger < objectMemory startOfMemory + ifTrue: + [stackPages + longAt: theFPInt + FoxMethod + put: (methodField bitOr: 4)] + ifFalse: + [stackPages + longAt: theFPInt + FoxIFrameFlags + put: ((stackPages longAt: theFPInt + FoxIFrameFlags) bitOr: 2)]! Item was added: + ----- Method: CoInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') ----- + pathTo: goal using: stack followWeak: followWeak + "Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found. + If found, unmark, leaving path in stack, and answer 0. Otherwise answer an error: + PrimErrBadArgument if stack is not an Array + PrimErrBadIndex if search overflows stack + PrimErrNotFound if goal cannot be found" + | current hdr index next stackSize stackp freeStartAtStart | + (objectMemory isArray: stack) ifFalse: + [^PrimErrBadArgument]. + freeStartAtStart := objectMemory freeStart. "check no allocations during search" + objectMemory beRootIfOld: stack. "so no store checks are necessary on stack" + stackSize := objectMemory lengthOf: stack. + objectMemory mark: stack. + "no need. the current context is not reachable from the active process (suspendedContext is nil)" + "objectMemory mark: self activeProcess." + current := objectMemory specialObjectsOop. + objectMemory mark: current. + index := objectMemory lengthOf: current. + stackp := 0. + [[(index := index - 1) >= -1] whileTrue: + [next := (stackPages couldBeFramePointer: current) + ifTrue: + [index >= 0 + ifTrue: [self field: index ofFrame: current] + ifFalse: [objectMemory nilObject]] + ifFalse: + [index >= 0 + ifTrue: + [hdr := objectMemory baseHeader: current. + (objectMemory isContextHeader: hdr) + ifTrue: [self fieldOrSenderFP: index ofContext: current] + ifFalse: [objectMemory fetchPointer: index ofObject: current]] + ifFalse: + [objectMemory fetchClassOfNonInt: current]]. + (stackPages couldBeFramePointer: next) + ifTrue: [self assert: (self isFrame: next onPage: (stackPages stackPageFor: next))] + ifFalse: + [next >= heapBase ifTrue: + [self assert: (self checkOkayOop: next)]]. + next = goal ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory storePointer: stackp ofObject: stack withValue: current. + self pruneStack: stack stackp: stackp. + ^0]. + ((objectMemory isNonIntegerObject: next) + and: [(stackPages couldBeFramePointer: next) + ifTrue: [(self frameIsMarked: next) not] + ifFalse: + [next >= heapBase "exclude Cog methods" + and: [(objectMemory isMarked: next) not + and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next]) + and: [followWeak or: [(objectMemory isWeakNonInt: next) not]]]]]]) + ifTrue: + [stackp + 2 > stackSize ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory nilFieldsOf: stack. + ^PrimErrBadIndex]. "PrimErrNoMemory ?" + objectMemory + storePointerUnchecked: stackp ofObject: stack withValue: current; + storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index). + stackp := stackp + 2. + (stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *')) + ifTrue: + [self markFrame: next. + index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')] + ifFalse: + [hdr := objectMemory baseHeader: next. + objectMemory baseHeader: next put: (hdr bitOr: MarkBit). + (objectMemory isCompiledMethodHeader: hdr) + ifTrue: [index := self literalCountOf: next] + ifFalse: [index := objectMemory lengthOf: next]]. + current := next]]. + current = objectMemory specialObjectsOop ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory nilFieldsOf: stack. + ^PrimErrNotFound]. + index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack). + current := objectMemory fetchPointer: stackp - 2 ofObject: stack. + stackp := stackp - 2] repeat! Item was added: + ----- Method: CoInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') ----- + unmarkAllFrames + | thePage theFP methodField flags | + <var: #thePage type: #'StackPage *'> + <var: #theFP type: #'char *'> + <inline: false> + 0 to: numStackPages - 1 do: + [:i| + thePage := stackPages stackPageAt: i. + (stackPages isFree: thePage) ifFalse: + [theFP := thePage headFP. + [methodField := self longAt: theFP + FoxMethod. + methodField asUnsignedInteger < objectMemory startOfMemory + ifTrue: + [(methodField bitAnd: 4) ~= 0 ifTrue: + [self longAt: theFP + FoxMethod put: methodField - 4]] + ifFalse: + [flags := self longAt: theFP + FoxIFrameFlags. + (flags bitAnd: 2) ~= 0 ifTrue: + [self longAt: theFP + FoxIFrameFlags put: flags - 2]]. + (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]! Item was added: + ----- Method: InterpreterPrimitives>>primitivePathToUsing (in category 'other primitives') ----- + primitivePathToUsing + "primitivePathTo: anObject using: stack <Array> followWeak: boolean + Answer a path to anObject from the root that does not pass through + the current context" + | err path | + <export: true> + self externalWriteBackHeadFramePointers. + err := self pathTo: (self stackValue: 2) using: (self stackValue: 1) followWeak: self stackTop = objectMemory trueObject. + err ~= 0 ifTrue: + [^self primitiveFailFor: err]. + path := self self stackValue: 1. + self pop: argumentCount + 1 thenPush: path! Item was changed: ----- Method: NewCoObjectMemory>>restoreHeaderOf:to: (in category 'become') ----- restoreHeaderOf: obj to: objHeader super restoreHeaderOf: obj to: objHeader. (self isCompiledMethodHeader: objHeader) ifTrue: [(self asserta: ((coInterpreter methodHasCogMethod: obj) not + or: [obj = (coInterpreter cogMethodOf: obj) methodObject])) ifFalse: - or: [obj = (coInterpreter cogMethodOf: obj)])) ifFalse: [self error: 'attempt to become cogged method']]! Item was added: + ----- Method: NewObjectMemory>>allObjectsDo: (in category 'debug support') ----- + allObjectsDo: aBlock + <doNotGenerate> + | oop | + oop := self firstObject. + [oop < freeStart] whileTrue: + [(self isFreeObject: oop) ifFalse: + [aBlock value: oop]. + oop := self objectAfterWhileForwarding: oop]! Item was changed: ----- Method: NewObjectMemory>>become:with:twoWay:copyHash: (in category 'become') ----- 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. Returns PrimNoErr if the primitive succeeds." "Implementation: Uses forwarding blocks to update references as done in compaction." | start | self leakCheckBecome ifTrue: [self runLeakCheckerForFullGC: true]. (self isArray: array1) ifFalse: [^PrimErrBadReceiver]. ((self isArray: array2) and: [(self lastPointerOf: array1) = (self lastPointerOf: array2)]) ifFalse: [^PrimErrBadArgument]. (twoWayFlag or: [copyHashFlag]) ifTrue: [(self containOnlyOops: array1 and: array2) ifFalse: [^PrimErrInappropriate]] ifFalse: [(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate]]. (self prepareForwardingTableForBecoming: array1 with: array2 twoWay: twoWayFlag) ifFalse: [^PrimErrNoMemory]. "fail; not enough space for forwarding table" (self allYoung: array1 and: array2) ifTrue: [start := youngStart"sweep only the young objects plus the roots"] ifFalse: [start := self startOfMemory"sweep all objects"]. coInterpreter preBecomeAction. self mapPointersInObjectsFrom: start to: freeStart. twoWayFlag ifTrue: [self restoreHeadersAfterBecoming: array1 with: array2] ifFalse: [self restoreHeadersAfterForwardBecome: copyHashFlag]. coInterpreter postBecomeAction. self initializeMemoryFirstFree: freeStart. "re-initialize memory used for forwarding table" self leakCheckBecome ifTrue: [self runLeakCheckerForFullGC: true]. - self forceInterruptCheck. "pretty much guaranteed to take a long time, so check for timers etc ASAP" ^PrimNoErr "success"! Item was added: + ----- Method: NewObjectMemory>>mark: (in category 'primitive support') ----- + mark: obj + <inline: true> + self baseHeader: obj put: ((self baseHeader: obj) bitOr: MarkBit)! Item was added: + ----- Method: NewObjectMemory>>nilFieldsOf: (in category 'primitive support') ----- + nilFieldsOf: arrayObj + 0 to: (self lengthOf: arrayObj) - 1 do: + [:i| + self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]! Item was added: + ----- Method: NewObjectMemory>>unmarkAllObjects (in category 'primitive support') ----- + unmarkAllObjects + | oop hdr | + oop := self firstObject. + [oop < freeStart] whileTrue: + [(self isFreeObject: oop) ifFalse: + [hdr := self baseHeader: oop. + (hdr bitAnd: MarkBit) ~= 0 ifTrue: + [self baseHeader: oop put: (hdr bitAnd: AllButMarkBit)]]. + oop := self objectAfter: oop]! Item was removed: - ----- Method: SmartSyntaxPluginTMethod>>oopVariable: (in category 'private') ----- - oopVariable: aString - - (locals includes: aString) ifFalse: - [locals add: aString. - self declarationAt: aString put: 'sqInt ', aString]. - ^TVariableNode new setName: aString! Item was added: + ----- Method: StackInterpreterPrimitives>>field:ofFrame: (in category 'object access primitives') ----- + field: index ofFrame: theFP + "Arrange to answer naked frame pointers for unmarried + senders to avoid reifying contexts in the search." + <var: #theFP type: #'char *'> + <inline: false> + | callerFP | + <var: #callerFP type: #'char *'> + ^index caseOf: + {[SenderIndex] -> [callerFP := self frameCallerFP: theFP. + callerFP = 0 + ifTrue: [self frameCallerContext: theFP] + ifFalse: [(self frameHasContext: callerFP) + ifTrue: [self assert: (self checkIsStillMarriedContext: (self frameContext: callerFP) currentFP: nil). + self frameContext: callerFP] + ifFalse: [callerFP]]]. + [StackPointerIndex] -> [ConstZero]. + [InstructionPointerIndex] -> [ConstZero]. + [MethodIndex] -> [self frameMethodObject: theFP]. + [ClosureIndex] -> [(self frameIsBlockActivation: theFP) + ifTrue: [self frameStackedReceiver: theFP + numArgs: (self frameNumArgs: theFP)] + ifFalse: [objectMemory nilObject]]. + [ReceiverIndex] -> [self frameReceiver: theFP] } + otherwise: + [self assert: (index - CtxtTempFrameStart between: 0 and: (self stackPointerIndexForFrame: theFP)). + self temporary: index - CtxtTempFrameStart in: theFP]! Item was added: + ----- Method: StackInterpreterPrimitives>>fieldOrSenderFP:ofContext: (in category 'object access primitives') ----- + fieldOrSenderFP: index ofContext: contextObj + "Arrange to answer naked frame pointers for unmarried + senders to avoid reifying contexts in the search." + <inline: false> + | tempIndex spouseFP | + <var: #spouseFP type: #'char *'> + tempIndex := index - CtxtTempFrameStart. + (self isStillMarriedContext: contextObj) ifFalse: + [^tempIndex >= (self fetchStackPointerOf: contextObj) + ifTrue: [objectMemory nilObject] + ifFalse: [self fetchPointer: index ofObject: contextObj]]. + spouseFP := self frameOfMarriedContext: contextObj. + tempIndex >= (self stackPointerIndexForFrame: spouseFP) ifTrue: + [^objectMemory nilObject]. + ^self field: index ofFrame: spouseFP! Item was added: + ----- Method: StackInterpreterPrimitives>>fieldsInFrame: (in category 'object access primitives') ----- + fieldsInFrame: theFP + <var: #theFP type: #'char *'> + ^CtxtTempFrameStart + (self stackPointerIndexForFrame: theFP)! Item was added: + ----- Method: StackInterpreterPrimitives>>frameIsMarked: (in category 'object access primitives') ----- + frameIsMarked: theFPInt + ^((stackPages longAt: theFPInt + FoxFrameFlags) bitAnd: 2) ~= 0! Item was added: + ----- Method: StackInterpreterPrimitives>>isFrame:onPage: (in category 'object access primitives') ----- + isFrame: aFrame onPage: aPage + <var: #aFrame type: #'char *'> + <var: #aPage type: #'StackPage *'> + | theFP | + <var: #theFP type: #'char *'> + theFP := aPage headFP. + [theFP = aFrame ifTrue: [^true]. + theFP ~= aPage baseFP + and: [(stackPages stackPageFor: theFP) = aPage]] whileTrue: + [theFP := self frameCallerFP: theFP]. + ^false! Item was added: + ----- Method: StackInterpreterPrimitives>>markFrame: (in category 'object access primitives') ----- + markFrame: theFPInt + stackPages + longAt: theFPInt + FoxFrameFlags + put: ((stackPages longAt: theFPInt + FoxFrameFlags) bitOr: 2)! Item was added: + ----- Method: StackInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') ----- + pathTo: goal using: stack followWeak: followWeak + "Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found. + If found, unmark, leaving path in stack, and answer 0. Otherwise answer an error: + PrimErrBadArgument if stack is not an Array + PrimErrBadIndex if search overflows stack + PrimErrNotFound if goal cannot be found" + | current hdr index next stackSize stackp freeStartAtStart | + (objectMemory isArray: stack) ifFalse: + [^PrimErrBadArgument]. + freeStartAtStart := objectMemory freeStart. "check no allocations during search" + objectMemory beRootIfOld: stack. "so no store checks are necessary on stack" + stackSize := objectMemory lengthOf: stack. + objectMemory mark: stack. + "no need. the current context is not reachable from the active process (suspendedContext is nil)" + "objectMemory mark: self activeProcess." + current := objectMemory specialObjectsOop. + objectMemory mark: current. + index := objectMemory lengthOf: current. + stackp := 0. + [[(index := index - 1) >= -1] whileTrue: + [next := (stackPages couldBeFramePointer: current) + ifTrue: + [index >= 0 + ifTrue: [self field: index ofFrame: current] + ifFalse: [objectMemory nilObject]] + ifFalse: + [index >= 0 + ifTrue: + [hdr := objectMemory baseHeader: current. + (objectMemory isContextHeader: hdr) + ifTrue: [self fieldOrSenderFP: index ofContext: current] + ifFalse: [objectMemory fetchPointer: index ofObject: current]] + ifFalse: + [objectMemory fetchClassOfNonInt: current]]. + (stackPages couldBeFramePointer: next) + ifTrue: [self assert: (self isFrame: next onPage: (stackPages stackPageFor: next))] + ifFalse: [self assert: (self checkOkayOop: next)]. + next = goal ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory storePointer: stackp ofObject: stack withValue: current. + self pruneStack: stack stackp: stackp. + ^0]. + ((objectMemory isNonIntegerObject: next) + and: [(stackPages couldBeFramePointer: next) + ifTrue: [(self frameIsMarked: next) not] + ifFalse: + [(objectMemory isMarked: next) not + and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next]) + and: [followWeak or: [(objectMemory isWeakNonInt: next) not]]]]]) + ifTrue: + [stackp + 2 > stackSize ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory nilFieldsOf: stack. + ^PrimErrBadIndex]. "PrimErrNoMemory ?" + objectMemory + storePointerUnchecked: stackp ofObject: stack withValue: current; + storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index). + stackp := stackp + 2. + (stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *')) + ifTrue: + [self markFrame: next. + index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')] + ifFalse: + [hdr := objectMemory baseHeader: next. + objectMemory baseHeader: next put: (hdr bitOr: MarkBit). + (objectMemory isCompiledMethodHeader: hdr) + ifTrue: [index := self literalCountOf: next] + ifFalse: [index := objectMemory lengthOf: next]]. + current := next]]. + current = objectMemory specialObjectsOop ifTrue: + [self assert: freeStartAtStart = objectMemory freeStart. + self unmarkAfterPathTo. + objectMemory nilFieldsOf: stack. + ^PrimErrNotFound]. + index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack). + current := objectMemory fetchPointer: stackp - 2 ofObject: stack. + stackp := stackp - 2] repeat! Item was added: + ----- Method: StackInterpreterPrimitives>>pruneStack:stackp: (in category 'object access primitives') ----- + pruneStack: stack stackp: stackp + "Prune the stack to contain only the path, removing stacked indices + and mapping frame pointers to contexts The issue here is that a + GC can occur during ensureFrameIsMarried:SP:, but frame pointers + are not valid objects. So first prune back to objects and framePointers + as integers, and then replace frame pointers as integers by contexts." + + <inline: false> + | objOrFP theStack finger | + <var: #theFP type: #'char *'> + <var: #thePage type: #'StackPage *'> + <var: #theFPAbove type: #'char *'> + finger := 1. + 2 to: stackp - 1 by: 2 do: + [:i| + objOrFP := objectMemory fetchPointer: i ofObject: stack. + (stackPages couldBeFramePointer: (self cCoerceSimple: objOrFP to: #'char *')) ifTrue: + [objOrFP := self withSmallIntegerTags: objOrFP]. + objectMemory + storePointerUnchecked: finger + ofObject: stack + withValue: objOrFP. + finger := finger + 1]. + finger to: (objectMemory lengthOf: stack) - 1 do: + [:i| + objectMemory + storePointerUnchecked: i + ofObject: stack + withValue: objectMemory nilObject]. + objectMemory pushRemappableOop: (theStack := stack). + 1 to: finger - 1 do: + [:i| | thePage theFP theFPAbove | + objOrFP := objectMemory fetchPointer: i ofObject: theStack. + (self isIntegerObject: objOrFP) ifTrue: + [theFP := self withoutSmallIntegerTags: objOrFP. + thePage := stackPages stackPageFor: theFP. + theFPAbove := self findFrameAbove: theFP inPage: thePage. + objOrFP := self ensureFrameIsMarried: theFP SP: (self frameCallerSP: theFPAbove). + theStack := objectMemory topRemappableOop. + objectMemory "after a GC stack may no longer be a root." + storePointer: finger + ofObject: theStack + withValue: objOrFP]]. + objectMemory popRemappableOop! Item was added: + ----- Method: StackInterpreterPrimitives>>unmarkAfterPathTo (in category 'object access primitives') ----- + unmarkAfterPathTo + <inline: false> + self unmarkAllFrames. + objectMemory unmarkAllObjects! Item was added: + ----- Method: StackInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') ----- + unmarkAllFrames + | thePage theFP flags | + <var: #thePage type: #'StackPage *'> + <var: #theFP type: #'char *'> + <inline: false> + 0 to: numStackPages - 1 do: + [:i| + thePage := stackPages stackPageAt: i. + (stackPages isFree: thePage) ifFalse: + [theFP := thePage headFP. + [flags := self longAt: theFP + FoxFrameFlags. + (flags bitAnd: 2) ~= 0 ifTrue: + [self longAt: theFP + FoxFrameFlags put: flags - 2]. + (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]! Item was added: + ----- Method: TMethod>>oopVariable: (in category 'private') ----- + oopVariable: aString + + (locals includes: aString) ifFalse: + [locals add: aString. + self declarationAt: aString put: 'sqInt ', aString]. + ^TVariableNode new setName: aString!

1 0

[PATCH 1/3] ALSA: correctly handle -ESTRPIPE
by Daniel Drake 01 Apr '13

01 Apr '13

When ALSA produces -ESTRPIPE, it means that the sound subsystem is suspended, and the client should resume it if it wants playback to continue. See http://www.alsa-project.org/alsa-doc/alsa-lib/pcm.html#pcm_errors and sample code: http://www.alsa-project.org/alsa-doc/alsa-lib/_2test_2pcm_8c-example.html Fixes a sound failure (and huge log spam) after suspend/resume with sound playback enabled. Index: Squeak-4.10.2.2614-src-no-mp3/unix/vm-sound-ALSA/sqUnixSoundALSA.c =================================================================== --- Squeak-4.10.2.2614-src-no-mp3.orig/unix/vm-sound-ALSA/sqUnixSoundALSA.c +++ Squeak-4.10.2.2614-src-no-mp3/unix/vm-sound-ALSA/sqUnixSoundALSA.c @@ -200,28 +200,44 @@ static sqInt sound_InsertSamplesFromLea static sqInt sound_PlaySamplesFromAtLength(sqInt frameCount, void *srcBufPtr, sqInt startIndex) { - if (output_handle) - { - void *samples= srcBufPtr + startIndex * output_channels * 2; - int count= snd_pcm_writei(output_handle, samples, frameCount); - if (count < frameCount / 2) - { - output_buffer_frames_available= 0; - } - if (count < 0) - { - if (count == -EPIPE) /* underrun */ - { - int err; - snd(pcm_prepare(output_handle), "sound_PlaySamples: snd_pcm_prepare"); - return 0; - } - fprintf(stderr, "snd_pcm_writei returned %i\n", count); - return 0; - } - return count; + if (!output_handle) + { + success(false); + return 0; + } + + void *samples= srcBufPtr + startIndex * output_channels * 2; + int count= snd_pcm_writei(output_handle, samples, frameCount); + if (count < frameCount / 2) + output_buffer_frames_available= 0; + + if (count >= 0) + return count; + + if (count != -EPIPE & count != -ESTRPIPE) + { + fprintf(stderr, "snd_pcm_writei returned %i\n", count); + return 0; + } + + int err; + if (count == -EPIPE) { /* under-run */ + err = snd_pcm_prepare (output_handle); + if (err < 0) + printf("Can't recover from underrun, prepare failed: %s", snd_strerror (err)); + return 0; + } else if (count == -ESTRPIPE) { + while ((err = snd_pcm_resume (output_handle)) == -EAGAIN) + sleep(1); /* wait until the suspend flag is released */ + + if (err < 0) { + err = snd_pcm_prepare (output_handle); + if (err < 0) + printf("Can't recover from suspend, prepare failed: %s", snd_strerror (err)); } - success(false); + return 0; + } + return 0; } @@ -307,13 +323,28 @@ static sqInt sound_RecordSamplesIntoAtLe int frameCount= ((bufferSizeInBytes / 2) - startSliceIndex) / input_channels; int count= snd_pcm_readi(input_handle, samples, frameCount); if (count < 0) - { - if (count == -EPIPE) - snd_pcm_prepare(input_handle); - else if (count != -EAGAIN) - fprintf(stderr, "snd_pcm_readi returned %i\n", count); - return 0; - } + { + int err; + if (count == -EPIPE) { /* under-run */ + err = snd_pcm_prepare (input_handle); + if (err < 0) + printf("Can't recover from underrun, prepare failed: %s", snd_strerror (err)); + return 0; + } else if (count == -ESTRPIPE) { + while ((err = snd_pcm_resume (input_handle)) == -EAGAIN) + sleep(1); /* wait until the suspend flag is released */ + + if (err < 0) { + err = snd_pcm_prepare (input_handle); + if (err < 0) + printf("Can't recover from suspend, prepare failed: %s", snd_strerror (err)); + } + return 0; + } + + return 0; + } + return count * input_channels; } success(false);

2 2

Re: [Vm-dev] VM Maker: VMMaker.oscog-eem.279.mcz
by David T. Lewis 01 Apr '13

01 Apr '13

On Mon, Apr 01, 2013 at 12:12:59AM +0000, 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.279.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-eem.279 > Author: eem > Time: 31 March 2013, 5:12:29.172 pm > UUID: 300e6a42-3856-465e-bd25-d3026399ab6c > Ancestors: VMMaker.oscog-eem.278 > > Slang: > Fix translation of to:by:do: loops so that the limit is not re-evaluated > on each iteration if it may have side-effects. Nice. I had to look twice to see what was "obviously wrong" about the original, so I'm sure it could have produced bugs that would be very hard to track down. Dave

2 1

VM Maker: VMMaker.oscog-eem.279.mcz
by commits＠source.squeak.org 01 Apr '13

01 Apr '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.279.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.279 Author: eem Time: 31 March 2013, 5:12:29.172 pm UUID: 300e6a42-3856-465e-bd25-d3026399ab6c Ancestors: VMMaker.oscog-eem.278 Slang: Fix translation of to:by:do: loops so that the limit is not re-evaluated on each iteration if it may have side-effects. As part of this change make TMethod locals a Set, and sort only when emitting locals. Alas this causes a number of methods to change. =============== Diff against VMMaker.oscog-eem.278 =============== Item was changed: + SmartSyntaxInterpreterPlugin subclass: #BitBltSimulation - InterpreterPlugin subclass: #BitBltSimulation instanceVariableNames: 'destForm sourceForm halftoneForm combinationRule destX destY width height sourceX sourceY clipX clipY clipWidth clipHeight sourceWidth sourceHeight sourceDepth sourcePitch sourceBits sourcePPW sourceMSB destWidth destHeight destDepth destPitch destBits destPPW destMSB bitCount skew mask1 mask2 preload nWords destMask hDir vDir sourceIndex sourceDelta destIndex destDelta sx sy dx dy bbW bbH halftoneHeight noSource noHalftone halftoneBase sourceAlpha srcBitShift dstBitShift bitBltOop affectedL affectedR affectedT affectedB opTable maskTable ditherMatrix4x4 ditherThresholds16 ditherValues16 hasSurfaceLock warpSrcShift warpSrcMask warpAlignShift warpAlignMask warpBitShiftTable querySurfaceFn lockSurfaceFn unlockSurfaceFn isWarping cmFlags cmMask cmShiftTable cmMaskTable cmLookupTable cmBitsPerColor dither8Lookup componentAlphaModeColor componentAlphaModeAlpha ungammaLookupTable gammaLookupTable' classVariableNames: 'AllOnes AlphaIndex BBClipHeightIndex BBClipWidthIndex BBClipXIndex BBClipYIndex BBColorMapIndex BBDestFormIndex BBDestXIndex BBDestYIndex BBHalftoneFormIndex BBHeightIndex BBLastIndex BBRuleIndex BBSourceFormIndex BBSourceXIndex BBSourceYIndex BBWarpBase BBWidthIndex BBXTableIndex BinaryPoint BlueIndex ColorMapFixedPart ColorMapIndexedPart ColorMapNewStyle ColorMapPresent CrossedX EndOfRun FixedPt1 FormBitsIndex FormDepthIndex FormHeightIndex FormWidthIndex GreenIndex JitBltHookSize OpTable OpTableSize RedIndex' poolDictionaries: '' category: 'VMMaker-Interpreter'! + !BitBltSimulation commentStamp: 'tpr 3/25/2013 16:50' prior: 0! - !BitBltSimulation commentStamp: '<historical>' prior: 0! This class implements BitBlt, much as specified in the Blue Book spec. Performance has been enhanced through the use of pointer variables such as sourceIndex and destIndex, and by separating several special cases of the inner loop. Operation has been extended to color, with support for 1, 2, 4, 8, 16, and 32-bit pixel sizes. Conversion between different pixel sizes is facilitated by accepting an optional color map. In addition to the original 16 combination rules, this BitBlt supports 16 fail (for old paint mode) 17 fail (for old mask mode) 18 sourceWord + destinationWord 19 sourceWord - destinationWord 20 rgbAdd: sourceWord with: destinationWord 21 rgbSub: sourceWord with: destinationWord 22 OLDrgbDiff: sourceWord with: destinationWord 23 OLDtallyIntoMap: destinationWord -- old vers doesn't clip to bit boundary 24 alphaBlend: sourceWord with: destinationWord 25 pixPaint: sourceWord with: destinationWord 26 pixMask: sourceWord with: destinationWord 27 rgbMax: sourceWord with: destinationWord 28 rgbMin: sourceWord with: destinationWord 29 rgbMin: sourceWord bitInvert32 with: destinationWord 30 alphaBlendConst: sourceWord with: destinationWord -- alpha passed as an arg 31 alphaPaintConst: sourceWord with: destinationWord -- alpha passed as an arg 32 rgbDiff: sourceWord with: destinationWord 33 tallyIntoMap: destinationWord 34 alphaBlendScaled: sourceWord with: destinationWord + 35 alphaBlendScaled: sourceWord with: "unused here - only used by FXBlt" + 36 alphaBlendScaled: sourceWord with: "unused here - only used by FXBlt" + 37 rgbMul: sourceWord with: destinationWord + 38 pixSwap: sourceWord with: destinationWord + 39 pixClear: sourceWord with: destinationWord + 40 fixAlpha: sourceWord with: destinationWord + 41 rgbComponentAlpha: sourceWord with: destinationWord This implementation has also been fitted with an experimental "warp drive" that allows abritrary scaling and rotation (and even limited affine deformations) with all BitBlt storage modes supported. To add a new rule to BitBlt... 1. add the new rule method or methods in the category 'combination rules' of BBSim 2. describe it in the class comment of BBSim and in the class comment for BitBlt 3. add refs to initializeRuleTable in proper positions 4. add refs to initBBOpTable, following the pattern ! Item was added: + ----- Method: BitBltSimulation>>primitivePixelValueAtX:y: (in category 'primitives') ----- + primitivePixelValueAtX: xVal y: yVal + "returns the single pixel at x@y. + It does not handle LSB bitmaps right now. + If x or y are < 0, return 0 to indicate transparent (cf BitBlt>bitPeekerFromForm: usage). + Likewise if x>width or y>depth. + Fail if the rcvr doesn't seem to be a Form, or x|y seem wrong" + | rcvr bitmap depth ppW stride word mask shift pixel | + rcvr := self primitive: 'primitivePixelValueAt' parameters: #(SmallInteger SmallInteger) receiver: #Oop. + + "possible quick exit if x or y is -ve" + (xVal < 0 or: [ yVal < 0 ] ) ifTrue:[^interpreterProxy integerObjectOf: 0]. + "check that rcvr is plausibly a Form or subclass" + rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount. + ((interpreterProxy isPointers: rcvr) and: [(interpreterProxy slotSizeOf: rcvr) >= 4]) + ifFalse: [^interpreterProxy primitiveFail]. + + "get the bits oop and width/height/depth" + bitmap := interpreterProxy fetchPointer: FormBitsIndex ofObject: rcvr. + width := interpreterProxy fetchInteger: FormWidthIndex ofObject: rcvr. + height := interpreterProxy fetchInteger: FormHeightIndex ofObject: rcvr. + depth := interpreterProxy fetchInteger: FormDepthIndex ofObject: rcvr. + "if width/height/depth are not integer, fail" + interpreterProxy failed ifTrue:[^nil]. + + "possible quick exit if x or y is >= extent of form. This also catches cases where the width/height are < 0" + (xVal >= width or: [ yVal >= height ] ) ifTrue:[^interpreterProxy integerObjectOf: 0]. + + "we don't handle LSB Forms yet" + depth < 0 ifTrue:[^interpreterProxy primitiveFail]. + + "OK so now we know we have a plausible Form, the width/height/depth/x/y are all reasonable and it's time to plunder the bitmap" + ppW := 32//depth. "pixels in each word" + stride := (width + (ppW -1)) // ppW. "how many words per rox of pixels" + word := interpreterProxy fetchLong32:(yVal * stride) + (xVal//ppW) ofObject: bitmap. "load the word that contains our target" + mask := 16rFFFFFFFF >> (32 - depth). "make a mask to isolate the pixel within that word" + shift := 32 - (((xVal bitAnd: ppW-1) + 1) * depth). "this is the tricky MSB part - we mask the xVal to find how far into the word we need, then add 1 for the pixel we're looking for, then * depth to get the bit shift" + pixel := (word >> shift) bitAnd: mask. "shift, mask and dim the lights" + ^ pixel asPositiveIntegerObj "pop the incoming and push our answer" + ! Item was changed: ----- Method: CCodeGenerator>>generateToByDo:on:indent: (in category 'C translation') ----- generateToByDo: msgNode on: aStream indent: level "Generate the C code for this message onto the given stream." + "N.B. MessageNode>>asTranslatorNodeIn: adds the limit var as a hidden fourth argument." + | blockExpr iterationVar limitExpr mayHaveSideEffects limitVar step negative | + blockExpr := msgNode args third. + blockExpr args size = 1 ifFalse: + [self error: 'wrong number of block arguments']. + iterationVar := blockExpr args first. + limitExpr := msgNode args first. - - | iterationVar step negative | - (msgNode args last args size = 1) ifFalse: [ - self error: 'wrong number of block arguments'. - ]. - iterationVar := msgNode args last args first. aStream nextPutAll: 'for (', iterationVar, ' = '. self emitCExpression: msgNode receiver on: aStream. + mayHaveSideEffects := msgNode args size = 4. "See TMethod>>prepareMethodIn:" + mayHaveSideEffects ifTrue: + [limitVar := msgNode args last. + aStream nextPutAll: ', ', limitVar name, ' = '. + self emitCExpression: limitExpr on: aStream. + limitExpr := limitVar]. aStream nextPutAll: '; ', iterationVar. negative := ((step := msgNode args at: 2) isConstant and: [step value < 0]) or: [step isSend and: [step selector == #negated and: [step receiver isConstant and: [step receiver value >= 0]]]]. aStream nextPutAll: (negative ifTrue: [' >= '] ifFalse: [' <= ']). + self emitCExpression: limitExpr on: aStream. - self emitCExpression: msgNode args first on: aStream. aStream nextPutAll: '; ', iterationVar, ' += '. self emitCExpression: step on: aStream. aStream nextPutAll: ') {'; cr. + blockExpr emitCCodeOn: aStream level: level + 1 generator: self. + aStream tab: level. + aStream nextPut: $}! - msgNode args last emitCCodeOn: aStream level: level + 1 generator: self. - level timesRepeat: [ aStream tab ]. - aStream nextPutAll: '}'.! Item was changed: ----- Method: CCodeGenerator>>removeMethodForSelector: (in category 'utilities') ----- removeMethodForSelector: aSelector "Remove the given method from the code base" + (breakSrcInlineSelector == aSelector + or: [breakDestInlineSelector == aSelector]) ifTrue: + [self halt]. methods removeKey: aSelector ifAbsent: []! Item was changed: ----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') ----- asTranslatorNodeIn: aTMethod "make a CCodeGenerator equivalent of me" "selector is sometimes a Symbol, sometimes a SelectorNode!! On top of this, numArgs is needed due to the (truly grody) use of arguments as a place to store the extra expressions needed to generate code for in-line to:by:do:, etc. see below, where it is used." | rcvrOrNil sel args | rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod]. (rcvrOrNil notNil and: [rcvrOrNil isVariable and: [rcvrOrNil name = 'super']]) ifTrue: [^aTMethod superExpansionNodeFor: selector key args: arguments]. sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key]. ((sel = #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block." + or: [sel = #cCode:]) + and: [arguments first isBlockNode]) ifTrue: - or: [sel = #cCode:]) - and: [arguments first isBlockNode]) ifTrue: [| block | ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1 ifTrue: [block statements first] ifFalse: [block]]. args := (1 to: sel numArgs) collect: [:i | (arguments at: i) asTranslatorNodeIn: aTMethod]. + (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue: + ["Restore limit expr that got moved by transformToDo:" + args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod. + args second. + args third. "add the limit var as a hidden extra argument; we may need it later" + TVariableNode new setName: arguments first key}]. + ((sel = #ifFalse: or: [sel = #or:]) + and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue: + ["Restore argument block that got moved by transformOr: or transformIfFalse:" + args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. - (sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) - ifTrue: ["Restore limit expr that got moved by transformToDo:" - args at: 1 put: ((arguments at: 7) value asTranslatorNodeIn: aTMethod)]. - (sel = #or: and: [arguments size = 2 and: [(arguments at: 2) notNil]]) - ifTrue: ["Restore argument block that got moved by transformOr:" - args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. - (sel = #ifFalse: and: [arguments size = 2 and: [(arguments at: 2) notNil]]) - ifTrue: ["Restore argument block that got moved by transformIfFalse:" - args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)]. ^TSendNode new setSelector: sel receiver: rcvrOrNil arguments: args! Item was changed: ----- Method: SmartSyntaxPluginTMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initializing') ----- setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment "Initialize this method using the given information." selector := sel. definingClass := class. returnType := #sqInt. "assume return type is sqInt for now" args := argList asOrderedCollection collect: [:arg | arg key]. + locals := (localList collect: [:arg | arg key]) asSet. - locals := localList asOrderedCollection collect: [:arg | arg key]. declarations := Dictionary new. primitive := aNumber. properties := methodProperties. comment := aComment. parseTree := aBlockNode asTranslatorNodeIn: self. labels := OrderedCollection new. complete := false. "set to true when all possible inlining has been done" export := self extractExportDirective. static := self extractStaticDirective. canAsmLabel := self extractLabelDirective. self extractSharedCase. isPrimitive := false. "set to true only if you find a primtive direction." suppressingFailureGuards := self extractSuppressFailureGuardDirective. self recordDeclarations. self extractPrimitiveDirectives. ! Item was changed: ----- Method: TMethod>>addVarsDeclarationsAndLabelsOf:except: (in category 'inlining support') ----- addVarsDeclarationsAndLabelsOf: methodToBeInlined except: doNotRename "Prepare to inline the body of the given method into the receiver by making the args and locals of the argument to the receiver be locals of the receiver. Record any type declarations for these variables. Record labels. Assumes that the variables have already be renamed to avoid name clashes." + locals + addAll: (methodToBeInlined args reject: [ :v | doNotRename includes: v]); + addAll: (methodToBeInlined locals reject: [ :v | doNotRename includes: v]). - methodToBeInlined args, methodToBeInlined locals do: - [ :v | - ((doNotRename includes: v) - or: [locals includes: v]) ifFalse: - [locals addLast: v]]. - methodToBeInlined declarations keysAndValuesDo: [ :v :decl | (doNotRename includes: v) ifFalse: [self declarationAt: v put: decl]]. + labels addAll: methodToBeInlined labels! - methodToBeInlined labels do: - [ :label | - labels add: label]! Item was changed: ----- Method: TMethod>>computePossibleSideEffectsInto:visited:in: (in category 'inlining support') ----- computePossibleSideEffectsInto: writtenToVars visited: visitedSelectors in: aCodeGen + "Add all variables written to by this method and its callees to writtenToVars. - "Add all variables written to by this mathod and its callees to writtenToVars. Avoid circularity via visitedSelectors" (visitedSelectors includes: selector) ifTrue: [^self]. visitedSelectors add: selector. writtenToGlobalVarsCache ifNotNil: [writtenToVars addAll: writtenToGlobalVarsCache. ^self]. parseTree nodesDo: [ :node | (node isAssignment and: [(locals includes: node variable name) not]) ifTrue: [writtenToVars add: node variable name]. (node isSend + and: [node isBuiltinOperator not + and: [(node isStructSend: aCodeGen) not]]) ifTrue: - and: [node isBuiltinOperator not]) ifTrue: [(aCodeGen methodNamed: node selector) ifNotNil: [:method| method computePossibleSideEffectsInto: writtenToVars visited: visitedSelectors in: aCodeGen]]]. writtenToGlobalVarsCache := writtenToVars copy! Item was changed: ----- Method: TMethod>>emitInlineOn:level:generator: (in category 'C code generation') ----- emitInlineOn: aStream level: level generator: aCodeGen "Emit C code for this method onto the given stream. All calls to inlined methods should already have been expanded." self removeUnusedTemps. sharedLabel ifNotNil: [aStream crtab: level-1; nextPutAll: sharedLabel; nextPut: $:. aStream crtab: level. aStream nextPutAll: '/* '; nextPutAll: selector; nextPutAll: ' */'. aStream crtab: level]. aStream nextPut: ${. locals isEmpty ifFalse: + [(aCodeGen sortStrings: locals) do: - [locals do: [:var| aStream crtab: level+1; nextPutAll: (self declarationAt: var); nextPut: $;]. aStream cr]. aStream crtab: level+1. aCodeGen outputAsmLabel: selector on: aStream. aStream crtab: level+1. aCodeGen pushScope: declarations while: [parseTree emitCCodeOn: aStream level: level+1 generator: aCodeGen]. aStream tab: level; nextPut: $}! Item was changed: ----- Method: TMethod>>inlineCaseStatementBranchesIn:localizingVars: (in category 'inlining') ----- inlineCaseStatementBranchesIn: aCodeGen localizingVars: varsList | maxTemp usedVars v exitLabel | maxTemp := 0. parseTree nodesDo: [:n | n isCaseStmt ifTrue: [n cases do: [:stmtNode | | newStatements stmt meth | (stmt := stmtNode statements first) isSend ifTrue: [(meth := (aCodeGen methodNamed: stmt selector)) isNil ifFalse: [(meth hasUnrenamableCCode or: [meth args notEmpty]) ifFalse: [meth := meth copy. meth hasReturn ifTrue: [exitLabel := meth unusedLabelForInliningInto: self. meth exitVar: nil label: exitLabel. labels add: exitLabel] ifFalse: [exitLabel := nil]. meth renameLabelsForInliningInto: self. labels addAll: meth labels. newStatements := stmtNode statements asOrderedCollection allButFirst. exitLabel ifNotNil: [newStatements addFirst: (TLabeledCommentNode new setLabel: exitLabel comment: 'end case')]. newStatements addFirst: meth asInlineNode; addFirst: (TLabeledCommentNode new setComment: meth selector). stmtNode setStatements: newStatements]]]]]]. usedVars := (locals , args) asSet. 1 to: maxTemp do: [:i | v := 't' , i printString. (usedVars includes: v) ifTrue: [self error: 'temp variable name conflicts with an existing local or arg']. locals addLast: v]. "make local versions of the given globals" + locals addAll: (varsList reject: [:var | usedVars includes: var])! - varsList do: - [:var | - (usedVars includes: var) ifFalse: - [locals addFirst: var asString]]! Item was removed: - ----- Method: TMethod>>isLocal: (in category 'testing') ----- - isLocal: aVariableName - ^locals includes: aVariableName! Item was changed: ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') ----- prepareMethodIn: aCodeGen "Record sends of builtin operators, map sends of the special selector dispatchOn:in: with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements. Note: Only replaces top-level sends of dispatchOn:in: et al and caseOf:[otherwise:]. These must be top-level statements; they cannot appear in expressions. As a hack also update the types of variables introduced to implement cascades correctly. This has to be done at teh same time as this is done, so why not piggy back here?" | replacements |. cascadeVariableNumber ifNotNil: [declarations keysAndValuesDo: [:varName :decl| decl isBlock ifTrue: [self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]). locals add: varName. self declarationAt: varName put: (decl value: self value: aCodeGen), ' ', varName]]]. replacements := IdentityDictionary new. + aCodeGen + pushScope: declarations + while: + [parseTree nodesDo: + [:node| + node isSend ifTrue: + [(aCodeGen builtin: node selector) + ifTrue: + [node isBuiltinOperator: true. + "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args" + (node selector = #to:by:do: + and: [node args size = 4]) ifTrue: + [| limitExpr | + limitExpr := node args first. + (limitExpr anySatisfy: + [:subNode| + subNode isSend + and: [(aCodeGen builtin: subNode selector) not + and: [(subNode isStructSend: aCodeGen) not]]]) + ifTrue: [locals add: node args last name] + ifFalse: + [node arguments: node args allButLast]]] + ifFalse: + [(CaseStatements includes: node selector) ifTrue: + [replacements at: node put: (self buildCaseStmt: node)]. + (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue: + [replacements at: node put: (self buildSwitchStmt: node)]]]. + ((node isAssignment or: [node isReturn]) + and: [node expression isSwitch]) ifTrue: + [replacements at: node put: (self transformSwitchExpression: node)]]]. - parseTree nodesDo: - [:node| - node isSend ifTrue: - [(aCodeGen builtin: node selector) - ifTrue: - [node isBuiltinOperator: true] - ifFalse: - [(CaseStatements includes: node selector) ifTrue: - [replacements at: node put: (self buildCaseStmt: node)]. - (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue: - [replacements at: node put: (self buildSwitchStmt: node)]]]. - ((node isAssignment or: [node isReturn]) - and: [node expression isSwitch]) ifTrue: - [replacements at: node put: (self transformSwitchExpression: node)]]. replacements isEmpty ifFalse: [parseTree := parseTree replaceNodesIn: replacements]! Item was changed: ----- Method: TMethod>>renameVarsForInliningInto:except:in: (in category 'inlining support') ----- renameVarsForInliningInto: destMethod except: doNotRename in: aCodeGen "Rename any variables that would clash with those of the destination method." | destVars usedVars varMap newVarName | destVars := aCodeGen globalsAsSet copy. destVars addAll: destMethod locals. destVars addAll: destMethod args. usedVars := destVars copy. "keeps track of names in use" usedVars addAll: args; addAll: locals. varMap := Dictionary new: 100. + locals, args do: + [ :v | - args, locals do: [ :v | ((doNotRename includes: v) not + and: [destVars includes: v]) ifTrue: + [newVarName := self unusedNamePrefixedBy: v avoiding: usedVars. + varMap at: v put: newVarName]]. + self renameVariablesUsing: varMap! - and: [destVars includes: v]) ifTrue: [ - newVarName := self unusedNamePrefixedBy: v avoiding: usedVars. - varMap at: v put: newVarName. - ]. - ]. - self renameVariablesUsing: varMap.! Item was changed: ----- Method: TMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initialization') ----- setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment "Initialize this method using the given information." selector := sel. definingClass := class. returnType := #sqInt. "assume return type is long for now" args := argList asOrderedCollection collect: [:arg | arg key]. + locals := (localList collect: [:arg | arg key]) asSet. - locals := (localList asSortedCollection: [:a :b| a key < b key]) collect: [:arg | arg key]. declarations := Dictionary new. self addTypeForSelf. primitive := aNumber. properties := methodProperties. comment := aComment. parseTree := aBlockNode. "hack; allows nodes to find their parent, etc" parseTree := aBlockNode asTranslatorNodeIn: self. labels := OrderedCollection new. complete := false. "set to true when all possible inlining has been done" export := self extractExportDirective. static := self extractStaticDirective. canAsmLabel := self extractLabelDirective. self extractSharedCase. self removeFinalSelfReturn. "must preceed recordDeclarations because this may set returnType" self recordDeclarations. globalStructureBuildMethodHasFoo := 0! Item was changed: ----- Method: TMethod>>superExpansionNodeFor:args: (in category 'inlining') ----- superExpansionNodeFor: aSelector args: argumentNodes "Answer the expansion of a super send. Merge the super expansion's locals, properties and comment into this method's properties." (definingClass superclass lookupSelector: aSelector) ifNil: [self error: 'superclass does not define super method'] ifNotNil: [:superMethod| | superTMethod commonVars varMap | superTMethod := superMethod methodNode asTranslationMethodOfClass: self class. ((argumentNodes allSatisfy: [:parseNode| parseNode isVariableNode]) and: [(argumentNodes asOrderedCollection collect: [:parseNode| parseNode key]) = superTMethod args]) ifFalse: [self error: definingClass name, '>>',selector, ' args ~= ', superTMethod definingClass name, '>>', aSelector, (String with: $. with: Character cr), 'For super expansions to be translated correctly each argument must be a variable with the same name as the corresponding argument in the super method.']. self mergePropertiesOfSuperMethod: superTMethod. (commonVars := superTMethod locals intersection: self locals) notEmpty ifTrue: [varMap := Dictionary new. commonVars do: [:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)]. superTMethod renameVariablesUsing: varMap]. self assert: (superTMethod locals allSatisfy: [:var| (self locals includes: var) not]). + locals addAll: superTMethod locals. - locals addAllFirst: superTMethod locals. superTMethod declarations keysAndValuesDo: [:var :decl| self declarationAt: var put: decl]. superTMethod comment ifNotNil: [:superComment| comment := comment ifNil: [superComment] ifNotNil: [superComment, comment]]. superTMethod cascadeVariableNumber ifNotNil: [:scvn| cascadeVariableNumber := cascadeVariableNumber ifNil: [scvn] ifNotNil: [:cvn| cvn + scvn]]. superTMethod elideAnyFinalReturn. ^superTMethod parseTree]! Item was added: + ----- Method: TParseNode>>anySatisfy: (in category 'enumerating') ----- + anySatisfy: aBlock + self nodesDo: [:n| (aBlock value: n) ifTrue: [^true]]. + ^false! Item was added: + ----- Method: TParseNode>>noneSatisfy: (in category 'enumerating') ----- + noneSatisfy: aBlock + self nodesDo: [:n| (aBlock value: n) ifTrue: [^false]]. + ^true! Item was changed: ----- Method: TSendNode>>printOn:level: (in category 'printing') ----- printOn: aStream level: level | possiblyParenthesize | possiblyParenthesize := [:node :newLevel| (node isSend and: [node selector precedence >= 3]) ifTrue: [aStream nextPut: $(]. node printOn: aStream level: newLevel. (node isSend and: [node selector precedence >= 3]) ifTrue: [aStream nextPut: $)]]. possiblyParenthesize value: receiver value: level. arguments size = 0 ifTrue: [aStream space; nextPutAll: selector. ^self]. + selector keywords with: (arguments first: selector numArgs) do: - selector keywords with: arguments do: [:keyword :arg | aStream space; nextPutAll: keyword; space. possiblyParenthesize value: arg value: level + 1]!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev April 2013