[Vm-dev] VM Maker: VMMaker.oscog-eem.314.mcz

Esteban Lorenzano estebanlm at gmail.com
Tue Jul 30 04:28:45 UTC 2013


Thank you Eliot!
I was complete lost in this one... :)

Esteban

On Jul 30, 2013, at 12:22 AM, Igor Stasenko <siguctua at gmail.com> wrote:

> 
> On 30 July 2013 00:14,  <commits at source.squeak.org> wrote:
>> 
>> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
>> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.314.mcz
>> 
>> ==================== Summary ====================
>> 
>> Name: VMMaker.oscog-eem.314
>> Author: eem
>> Time: 29 July 2013, 3:13:51.976 pm
>> UUID: e8cba0d1-78b9-4058-820f-62d6e02e180b
>> Ancestors: VMMaker.oscog-eem.312
>> 
>> Fix bug in transferTo:(from:) when doing a code compaction when
>> ensuring there is a machine code method when switching to a
>> process whose context has a machine code pc.
>> 
> 
> That, i hope, was the reason of  smallinteger popping out of nowhere on stack :)
> 
> 
>> 
>> Add an assert to commenceCogCompiledCodeCompaction to catch
>> the actual bug (pushing the instructionPointer twice).
>> 
>> Improve inlining via inlineSend:directReturn:exitVar:in: by refactoring
>> argAssignmentsFor:args:in:'s innards.  Now global variables are
>> inlined if they are only read within the code being inlined.
>> 
>> Implement warningat in term of warning so one only has to remember
>> to set a breakpoint in warning, not both.
>> 
>> =============== Diff against VMMaker.oscog-eem.312 ===============
>> 
>> Item was changed:
>>  ----- Method: CoInterpreter>>commenceCogCompiledCodeCompaction (in category 'process primitive support') -----
>>  commenceCogCompiledCodeCompaction
>>        | startTime |
>>        <var: #startTime type: #usqLong>
>>        cogCompiledCodeCompactionCalledFor := false.
>>        cogit recordEventTrace ifTrue:
>>                [self recordTrace: TraceCodeCompaction thing: TraceCodeCompaction source: 0].
>>        cogit recordPrimTrace ifTrue:
>>                [self fastLogPrim: TraceCodeCompaction].
>>        startTime := self ioUTCMicrosecondsNow.
>> 
>>        "This can be called in a number of circumstances.  The instructionPointer
>>         may contain a native pc that must be relocated.  There may already be a
>>         pushed instructionPointer on stack.  Clients ensure that instructionPointer
>>         is 0 if it should not be pushed and/or relocated.  Pushing twice is a mistake
>>         because only the top one will be relocated."
>>        instructionPointer ~= 0 ifTrue:
>> +               ["better not have already been pushed"
>> +                self assert: self stackTop asUnsignedInteger ~= instructionPointer.
>> +                self push: instructionPointer.
>> -               [self push: instructionPointer.
>>                 self externalWriteBackHeadStackPointer].
>>        self assertValidStackedInstructionPointers: #'__LINE__'.
>>        cogit compactCogCompiledCode.
>>        instructionPointer ~= 0 ifTrue:
>>                [instructionPointer := self popStack.
>>                 self externalWriteBackHeadStackPointer].
>>        self assertValidStackedInstructionPointers: #'__LINE__'.
>> 
>>        statCodeCompactionCount := statCodeCompactionCount + 1.
>>        statCodeCompactionUsecs := statCodeCompactionUsecs + (self ioUTCMicrosecondsNow - startTime).
>> 
>>        objectMemory checkForLeaks ~= 0 ifTrue:
>>                [objectMemory clearLeakMapAndMapAccessibleObjects.
>>                 self assert: (self checkCodeIntegrity: false)]!
>> 
>> Item was changed:
>>  ----- Method: CoInterpreter>>transferTo:from: (in category 'process primitive support') -----
>>  transferTo: newProc from: sourceCode
>>        "Record a process to be awoken on the next interpreter cycle.
>> +        Reimplement to record the source of the switch for debugging,
>> +        and to cope with possible code compaction in makeBaseFrameFor:."
>> +       | activeContext sched oldProc |
>> -        Reimplement to record the source of the switch for debugging."
>>        <inline: false>
>>        self recordContextSwitchFrom: self activeProcess in: sourceCode.
>> +       statProcessSwitch := statProcessSwitch + 1.
>> +       self push: instructionPointer.
>> +       self externalWriteBackHeadFramePointers.
>> +       self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer.
>> +       "ensureMethodIsCogged: in makeBaseFrameFor: in
>> +        externalSetStackPageAndPointersForSuspendedContextOfProcess:
>> +        below may do a code compaction. Nil instructionPointer to avoid it getting pushed twice."
>> +       instructionPointer := 0.
>> +       sched := self schedulerPointer.
>> +       oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
>> +       activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
>> +       objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext.
>> +       objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc.
>> +       objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject.
>> +       self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc!
>> -       super transferTo: newProc!
>> 
>> Item was changed:
>>  ----- Method: StackInterpreter class>>preambleCCode (in category 'translation') -----
>>  preambleCCode
>>        ^
>>  '/* Disable Intel compiler inlining of warning which is used for breakpoints */
>>  #pragma auto_inline off
>>  void
>>  warning(char *s) { /* Print an error message but don''t exit. */
>>        printf("\n%s\n", s);
>>  }
>>  void
>>  warningat(char *s, int l) { /* ditto with line number. */
>> + #if 0
>> +       printf("\n%s %d\n", s, l);
>> + #else /* use alloca to call warning so one does not have to remember to set two breakpoints... */
>> +       char *sl = alloca(strlen(s) + 16);
>> +       sprintf(sl, "%s %d", s, l);
>> +       warning(sl);
>> + #endif
>> -       printf("\n%s %d\n", s,l);
>>  }
>>  #pragma auto_inline on
>> 
>>  void
>>  invalidCompactClassError(char *s) { /* Print a compact class index error message and exit. */
>>        printf("\nClass %s does not have the required compact class index\n", s);
>>        exit(-1);
>>  }
>> 
>>  /*
>>   * Define sigsetjmp and siglongjmp to be the most minimal setjmp/longjmp available on the platform.
>>   */
>>  #if WIN32
>>  # define sigsetjmp(jb,ssmf) setjmp(jb)
>>  # define siglongjmp(jb,v) longjmp(jb,v)
>>  #else
>>  # define sigsetjmp(jb,ssmf) _setjmp(jb)
>>  # define siglongjmp(jb,v) _longjmp(jb,v)
>>  #endif
>>  '!
>> 
>> Item was changed:
>>  ----- Method: TMethod>>argAssignmentsFor:args:in: (in category 'inlining') -----
>>  argAssignmentsFor: meth args: argList in: aCodeGen
>>        "Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method."
>>        "Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals."
>> 
>>        | stmtList substitutionDict |
>>        stmtList := OrderedCollection new: 100.
>>        substitutionDict := Dictionary new: 100.
>>        meth args with: argList do:
>>                [ :argName :exprNode |
>> +               (self isNode: exprNode substitutableFor: argName inMethod: meth in: aCodeGen)
>> -               (self isSubstitutableNode: exprNode intoMethod: meth in: aCodeGen)
>>                        ifTrue:
>>                                [substitutionDict at: argName put: exprNode.
>>                                 locals remove: argName]
>>                        ifFalse:
>>                                [stmtList add: (TAssignmentNode new
>>                                                                setVariable: (TVariableNode new setName: argName)
>>                                                                expression: exprNode copy)]].
>>        meth parseTree: (meth parseTree bindVariablesIn: substitutionDict).
>>        ^stmtList!
>> 
>> Item was added:
>> + ----- Method: TMethod>>isNode:substitutableFor:inMethod:in: (in category 'inlining') -----
>> + isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen
>> +       "Answer true if the given parameter node is either a constant, a local variable, or a formal parameter of the receiver. Such parameter nodes may be substituted directly into the body of the method during inlining. Note that global variables cannot be subsituted into methods with possible side effects (i.e., methods that may assign to global variables) because the inlined method might depend on having the value of the global variable captured when it is passed in as an argument."
>> +
>> +       | var |
>> +       aNode isConstant ifTrue: [^true].
>> +
>> +       aNode isVariable ifTrue:
>> +               [var := aNode name.
>> +               ((locals includes: var) or: [args includes: var]) ifTrue: [^true].
>> +               (#(self true false nil) includes: var) ifTrue: [^true].
>> +               "We can substitute any variable provided it is only read in the method being inlined."
>> +               (targetMeth isComplete
>> +                and: [targetMeth parseTree noneSatisfy:
>> +                               [:node|
>> +                               node isAssignment and: [node variable name = argName]]]) ifTrue:
>> +                       [^true].
>> +               (targetMeth maySubstituteGlobal: var in: aCodeGen) ifTrue: [^true]].
>> +
>> +       "For now allow literal blocks to be substituted.  They better be accessed only
>> +        with value[:value:*] messages though!!"
>> +       aNode isStmtList ifTrue: [^true].
>> +
>> +       "scan expression tree; must contain only constants, builtin ops, and inlineable vars"
>> +       aNode nodesDo: [ :node |
>> +               node isSend ifTrue: [
>> +                       node isBuiltinOperator ifFalse: [^false].
>> +               ].
>> +               node isVariable ifTrue: [
>> +                       var := node name.
>> +                       ((locals includes: var) or:
>> +                        [(args includes: var) or:
>> +                        [(#(self true false nil) includes: var) or:
>> +                        [targetMeth maySubstituteGlobal: var in: aCodeGen]]]) ifFalse: [^false].
>> +               ].
>> +               (node isConstant or: [node isVariable or: [node isSend]]) ifFalse: [^false].
>> +       ].
>> +
>> +       ^ true!
>> 
> 
> 
> 
> -- 
> Best regards,
> Igor Stasenko.



More information about the Vm-dev mailing list