- live browsing of Self object memory -

lobby traitsprocess

CopyDowns: vector

CreatorPath: traits process

Modules: process, errorHandling, stdin

parent* = traits clonable
schedulerCooperation* = mixins schedulerCalls

called by scheduler

basicSetPriority: = ( priority0: pri)The scheduler needs to reshuffle the readyQ when priorities change, so the actual setting of priorities is controlled by a call-back from the scheduler to this method.
fullyRemoveFromSemaphore =
( 
    removeFromSemaphore.
    onSemaphore: nullSemaphore.
    self)
Like 'removeFromSemaphore' but also cleas the 'onSemaphore' slot.
permitSuspensionWaiters = ( suspensionWaiters detain. self)
redoSemaphoreWait =
( 
    isOnSemaphore ifTrue: [|sema|
        sema: onSemaphore.
        onSemaphore: nullSemaphore.
        sema semaphoreWait.
    ].
    self)
Called by scheduler when a suspended process is being resumed. Puts the process back on the wait queue of any semaphore it was on at suspension time, or grants the semaphore to the process if it is now available.
removeFromSemaphore =
( 
    onSemaphore remove: self.
    self)
Called when a process is suspended. Will remove it from the semaphore it was trying to acquire, but leave the semaphore in the 'onSemaphore' slot so that the operation can be retried when the process is resumed.
setProcessStatus: = ( processStatus0: stat)This method should only be called during initialization or by the scheduler.
signalDeathWaiters =
( 
    signalSuspensionWaiters.
    deathWaiters release.
    self)
signalSuspensionWaiters =
( 
    suspensionWaiters release. 
    self)

queue operations

moveToQueue:NewStatus: =
( 
    removeFromQueue.
    setProcessStatus: stat.
    onQueue: q.
    q add: self.
    self)
Move this process from its present queue (if any) to the queue q and set the status to stat.
noQueue = traits process noQueueIndicates that a process object is currently not on any queue (e.g., this is the case for newborn processes).
removeFromQueue =
( 
    "If waiting with timeout, we get here when signalling the semaphore.
     Must be sure process is not on timerWaiters so it does not get
     timed-out later. -- dmu 8/04"
    scheduler timerWaiters remove: self IfAbsent: [].

    onQueue remove: self IfAbsent: [  "Be robust!"
        status != processStatus dead ifTrue: [
            "Never know with dead processes (killing them
             will remove them from queues), so don't be 
             to noisy in this case."
            'warning: should have found process ' print.
            objectID printLine.
        ].
    ].
    self)

creating

copySend: = ( copySend: msg CauseOfBirth: '')
copySend:CauseOfBirth: =
( 
    (_NewProcessSize: ( _Interpret ifTrue: defaultInterpretedProcessSize 
                                    False: defaultProcessSize )
            Receiver: msg receiver 
            Selector: msg selector
           Arguments: msg arguments)
      initialize: msg CauseOfBirth: cob)
defaultInitialPriority = 5Priority that is assigned to newly created processes.
defaultProcessSize = 524288doubled to file out benchmarks -- dmu 3/93 doubled again for profiling Klein -- ads 6/04
initializeStdioFiles =
( 
    stdin:   os_file stdin.
    stdout:  os_file stdout.
    stderr:  os_file stderr)
Used by stdin module to initialize slots for this OS. --0 dmu 6/99
resetCauseOfError = ( causeOfError: processErrors ok)
setPerProcessGlobalsFrom: =
( 
    stdin:       oldProcess stdin.
    stdout:      oldProcess stdout.
    stderr:      oldProcess stderr.
    birthEvent:  oldProcess birthEvent.
    prompt:      oldProcess prompt.
    history:     oldProcess history)
Copy over the 'per process' globals from the creating process.
defaultInterpretedProcessSize = ( defaultProcessSize * 10)
initialize:CauseOfBirth: =
( 
    setProcessStatus:         processStatus newborn.
    onQueue:                  noQueue.
    basicSetPriority:         defaultInitialPriority.
    wakeTime:                 times real.
    birthMessage:             msg statePrintString.
    causeOfBirth:             cob.
    deathWaiters:             barrier copy.
    suspensionWaiters:        barrier copy.
    (suspensionWaiters = nil) ifTrue: [halt. "Should never happen. If it does, find out why. This is an attempt to catch a strange GC bug. Ausch - 10/04"].
    stackShot:                list copyRemoveAll.
    filesToShow:              preferences filesToShow copy.
    setPerProcessGlobalsFrom: process this.
    resetTiming.
    suspend.
    self)

error handling

ambiguousSelector:Receiver:Type:Delegatee:MethodHolder:Arguments: =
( 
    forwardSend: 'ambiguous' Selector: sel Receiver: rec Type: msgType
      Delegatee: del MethodHolder: mh Arguments: args 
      IfSucceed: [|:res| ^res ].
    suspendAndTrace: 
        ((((((processErrors ambiguousSelector copy
            receiver:     rec)
            selector:     sel)
            type:         msgType)
            delegatee:    del)
            methodHolder: mh)
            arguments:    args)
            conflictingSlots: ((reflect: rec) lookupKey: sel).
    errorContinueValue)
mismatchedArgumentCountSelector:Receiver:Type:Delegatee:MethodHolder:Arguments: =
( 
    forwardSend: 'mismatchedArgumentCount' Selector: sel Receiver: rec
      Type: msgType Delegatee: del MethodHolder: mh Arguments: args 
      IfSucceed: [|:res| ^res ].
    suspendAndTrace: 
        (((((processErrors mismatchedArgumentCountSelector copy
            receiver:     rec)
            selector:     sel)
            type:         msgType)
            delegatee:    del)
            methodHolder: mh)
            arguments:    args.
    errorContinueValue)
missingParentSelector:Receiver:Type:Delegatee:MethodHolder:Arguments: =
( 
    forwardSend: 'missingParent' Selector: sel Receiver: rec
      Type: msgType Delegatee: del MethodHolder: mh Arguments: args 
      IfSucceed: [|:res| ^res ].
    suspendAndTrace: 
        (((((processErrors missingDelegatee copy
            receiver:     rec)
            selector:     sel)
            type:         msgType)
            delegatee:    del)
            methodHolder: mh)
            arguments:    args.
    errorContinueValue)
performTypeErrorSelector:Receiver:Type:Delegatee:MethodHolder:Arguments: =
( 
    forwardSend: 'performTypeError' Selector: sel Receiver: rec 
      Type: msgType Delegatee: del MethodHolder: mh Arguments: args 
      IfSucceed: [|:res| ^res ].
    suspendAndTrace: 
        (((((processErrors performTypeErrorSelector copy
            receiver:     rec)
            selector:     sel)
            type:         msgType)
            delegatee:    del)
            methodHolder: mh)
            arguments:    args.
    errorContinueValue)
undefinedSelector:Receiver:Type:Delegatee:MethodHolder:Arguments: =
( 
    forwardSend: 'undefined' Selector: sel Receiver: rec Type: msgType
      Delegatee: del MethodHolder: mh Arguments: args 
      IfSucceed: [|:res| ^res ].
    suspendAndTrace: 
        (((((processErrors undefinedSelector copy
            receiver:     rec)
            selector:     sel)
            type:         msgType)
            delegatee:    del)
            methodHolder: mh)
            arguments:    args.
    errorContinueValue)
forwardSend:Selector:Receiver:Type:Delegatee:MethodHolder:Arguments:IfSucceed: =
( | postfix = 'Selector:Type:Delegatee:MethodHolder:Arguments:'. 
      selector <- '' |
    selector: (prefix, postfix) canonicalize.
    ((reflect: rec) lookupKey: selector) isEmpty ifFalse: [
        | performDecl = (|
            canFail = false.
            acceptSelector: s = (
                "This is for the type inferencer."
                'Selector:Type:Delegatee:MethodHolder:Arguments:' 
                isSuffixOf: s.
              ).
          |). |
        blk value: 
            rec _Perform: selector
                With: sel With: msgType With: del With: mh With: args
    ])
Give the receiving object a chance to catch the error.

inspecting

at: = ( at: i IfAbsent: raiseError)
at:IfAbsent: =
( 
    "The activation mirror returned by _ActivationAt: is
     a clone of mirrors methodActivation with a DI parent.
     init will assign mirrors traits methodActivation to the parent."
    (_ActivationAt: i IfFail: [|:e| ^ failBlock value: e]) initNumber: i Process: self)
currentActivation =
( 
    stackDepth > 0 ifTrue: [ at: 0 ]
                    False: [ mirrors deadActivation ])
filteredStackTrace = ( stackTraceFilteredBy: [|:f| isFrameShown: f])
isFrameShown: =
( 
        filesToShow isEmpty 
    || [filesToShow includes: f file])
lowLevelStackTrace =
( 
    _PrintProcessStackIfFail: ['\n<dead process>\n' print].
    self)
newestActivationNamed: =
( 
    stack findFirst: [|:a| a selector = sel]
      IfPresent: [|:a| a]
       IfAbsent: [error: 'none'])
printError =
( 
    causeOfError errorString isEmpty
       ifTrue: [ log error: 'This process has no cause of error!'] 
       False:  [ causeOfError reportError: self ForceStackTrace: true ])
stack = ( stackWithLimit: maxSmallInt)
stackDepth = ( stackDepthIfFail: 0)
stackDepthIfFail: = ( _StackDepthIfFail: failBlock)
stackTrace = ( stackTraceFilteredBy: true)
stackTraceFilteredBy: =
( 
    ('## Stack trace for process ', objectID) printLine.
    (trimmedStackFilteredBy: filterBlock) printTrace.
    self)
stackWithLimit: = ( processStack copyForProcess: self Limit: max)
trimmedStack = ( trimmedStackFilteredBy: true)
trimmedStackFilteredBy: =
( | cnt <- 0. n. r. s |
    status = processStatus newborn ifTrue: [^ stack].
    s: stack.
    s: s copySize: s topmostInterestingActivation succ.
    n: causeOfError firstInterestingFrameOf: s.
    n: 0 max: n. 
    r: s copySize: s size - n.
    r size do: [|:i. a|
        a: s at: i + n.
        "always show first interesting frame"
        (0 = i) || [filterBlock value: a]  ifTrue: [
            r at: cnt Put: a.
            cnt: cnt succ.
        ].
    ].
    r copySize: cnt)

messages

hackForFileOut = schedulerrefer to scheduler so fileOut ensure a dummy exists for the storeStrings of the messages to refer to. The problem is that storeString does not call back into fileOut to refer to other objects. But that would crud up storeString--dmu

primitives

activationStack =
( 
    activationStackIfFail: [|:e|
        'outOfMemoryError' == e ifTrue: [
            memory allocationFailed.
            ^ activationStackIfFail: raiseError
        ].
        error: e
    ])
activationStackIfFail: =
( 
    "Receiver must be a process and can fail with: 
     'outOfMemoryError' or 'noProcessError'"
    _ActivationStackIfFail: failBlk)
activationStackLimit: = ( activationStackLimit: maxActivations IfFail: raiseError)
activationStackLimit:IfFail: =
( | s |
    s: activationStackIfFail: [|:e| ^ failBlk value: e].
    s size <= maxActivations ifTrue: [s] False: [s copySize: maxActivations])
currentHash: =
( 
    "Set the (VM-level) counter used when this process forces allocation
     of identity hash values to objects. Useful when debugging since it
     allows reproducible hash values."
    _CurrentHash: val)
primitiveAbortProcess = ( primitiveAbortProcessIfFail: raiseError)Only scheduler should call this method.
primitiveAbortProcessIfFail: = ( _AbortProcessIfFail: errBlk)Only scheduler should call this method.
primitiveAbortProcessIfNoProcessError: =
( 
    primitiveAbortProcessIfFail: [|:error. :name|
        ('noProcessError' isPrefixOf: error) ifTrue: [^ noPrErrBlk value].
        primitiveFailedError: error Name: name.
    ].
    self)
Only scheduler should call this method.
this = ( _ThisProcess)

printing

printString =
( 
    status asString, ' ',
    'process: ', birthLabel,
    (causeOfError errorString isEmpty ifTrue: '' False: [
       ' >>> ', causeOfError errorString]))
storeStringIfFail: = ( 'process')
storeStringNeeds = process
birthLabel =
( 
    '' = causeOfBirth ifTrue: [birthMessage]
                       False: [causeOfBirth])

priorities

priority = ( priority0)Return this process' priority.
priority: =
( 
    (reflect: pri) isReflecteeInteger ifFalse: [
        error: 'priority must be integer, else scheduler may crash'.
    ].
    pri != priority ifTrue: [|act|
        act: changePriorityAction copy.
        act newPriority: pri.
        "The following garble will do a call-back from the scheduler
         to 'basicSetPriority:'."
        performInScheduler: act IfInside: [
            scheduler changePriority: pri OfProcess: self.
        ].
    ].
    self)
Set priority of this process.

querying

hasError = ( causeOfError != processErrors ok)
isActive = ( status isActive)
isAlive =
( 
    stackDepthIfFail: [^ false].
    true)
isDebugged =
( 
    birthEvent ifNil: [
      "test if shell debugger is attached"
      = shell cp
    ] IfNotNil: [
      "is there a debugger in the world?"
      birthEvent sourceHand world reifiedObjects includesKey: (reflect: self)
    ])
Are any debuggers debugging me? -- Mario, 4/4/95
isOnSemaphore = ( onSemaphore != nullSemaphore)Return truee iff this process is currently *waiting* on a semaphore.
returnValue =
( 
    causeOfDeath = 'terminated' ifTrue: [ 
        ^_ProcessReturnValueIfFail: raiseError])
status = ( processStatus0)

scheduler cooperation

scheduling

isScheduled = ( process != process this)the scheduler process is the prototypical (and initial) process so if the current process isn't the initial process, we must be running the scheduler
killActivationsUpTo: =
( 
    killActivationsUpTo: actNum 
                 IfFail: [|:e|  e = 'noProcessError' ifFalse: [ error: e ]])
killActivationsUpTo:IfFail: = ( _KillActivationsUpTo: actNum IfFail: failBlock)
ifNotScheduler: =
( 
    = scheduler schedulerProcess
       ifFalse: blk True: [error: 'cannot single-step scheduler process'])

aborting

abort = ( abort: 'aborted')
abort: =
( 
    causeOfDeath: reason.
    performInScheduler: abortAction IfInside: [scheduler abort: self])
abortIfLive = ( abortIfLive: 'aborted')
abortIfLive: =
( 
    causeOfDeath: reason.
    performInScheduler: abortIfLiveAction IfInside: [
        scheduler abortIfLive: self ])
basicAbort =
( 
    performInScheduler: basicAbortAction
              IfInside: [ scheduler basicAbort: self ].
    self)
basicAbort completely removes the process from all scheduler queues. It should not be called from user processes.

resuming

continue = ( singleStep: false. resume)
resume =
( 
    performInScheduler: resumeAction
              IfInside: [scheduler resume:  self].
    self)

stepping

finish = ( finish: currentActivation)
finish: =
( 
    thisActivation isReflecteeActivation ifFalse: [
        ^error: 'argument to finish must be an activation' ].
    ifNotScheduler: [
        singleStep: false.
        stopActivation: thisActivation.
        resume.
        waitForSuspension.
        stopActivation: nil])
step =
( 
    ifNotScheduler: [singleStep: true. resume. waitForSuspension].
    self)
stepAndSkipSimpleBytecodes = ( step stepOverSimpleBytecodes)
stepInto =
( | myHome. thisAct |
    thisAct: currentActivation.
    myHome: thisAct outermostLexicalScope.
    [| act |
     step.
     act: currentActivation.
     act ifDead: [^self].
     (act != thisAct) && [myHome = act outermostLexicalScope]  ifTrue: [^self].
    ] loop)
Step into any activation that shares the same home context -- Mario, 5/18/95
stepIntoAndSkipSimpleBytecodes = ( stepInto stepOverSimpleBytecodes)
stepOverSimpleBytecodes =
( | act |
    act: at: 0 IfAbsent: [^ self "dead process"].
    [ act isSimpleBytecodeAt: act position ] whileTrue: [ |oldp|
      "hack cause sometimes step doesn't -- dmu 5/02"
      oldp: act position.
      step.
      act position = oldp  ifTrue: [^ self].
    ].
    self)

suspending

sleep: =
( 
    isScheduled ifTrue: [
        sleepTime: ms.
        performInScheduler: sleepAction
                  IfInside: [scheduler sleep: self For: ms].
    ] False: [   "busy wait"
        ms = scheduler timeoutInfinity ifTrue: [
            [] loop.
        ] False: [|when|
            when: times real + ms.
            [when > times real] whileTrue.
        ].
    ].
    self)
stop = ( isScheduled ifTrue: [suspend] False: [abort])
suspend =
( 
    performInScheduler: suspendAction
              IfInside: [scheduler suspend: self].
    self)
suspendAndTrace: =
( 
    causeOfError: error.
    performInScheduler: suspendAndTraceAction
              IfInside: [scheduler suspendAndTrace: self].
    self)
suspendWithError: =
( 
    causeOfError: error.
    performInScheduler: suspendAction
              IfInside: [scheduler suspend: self].
    self)
yield =
( 
    performInScheduler: yieldAction
              IfInside: [error: 'cannot yield in scheduler'])

waiting

waitForDeath =
( 
    deathWaiters wait.
    self)
waitForSuspension =
( 
    suspensionWaiters wait.
    self)

statistics and timing

cpuUse =
( | currentTime <- 0. processTime <- 0. totalTime <- 0 |
    timing ifFalse: [error: 'timing not active for this process'].
    currentTime: times cpu.
    totalTime: currentTime - startTime.
    0 = totalTime ifTrue: [^ 0].
    processTime: elapsedTime.
    = process this ifTrue: [processTime: processTime + (currentTime - swapInTime)]
    processTime asFloat / totalTime)
resetTiming =
( 
    elapsedTime: 0.
    startTime: times cpu.
    self)
startTiming =
( 
    = process this ifTrue: [swapInTime: times cpu].
    timing: true)
stopTiming =
( 
    = process this ifTrue: [
        elapsedTime: elapsedTime + (times cpu - swapInTime)
    ].
    timing: false)
swapInNotify =
( 
    timing ifTrue: [swapInTime: times cpu].
    self)
Called by scheduler each time a process starts running.
swapOutNotify =
( 
    timing ifTrue: [
        elapsedTime: elapsedTime + (times cpu - swapInTime).
    ].
    self)
Called by scheduler each time a process stops running.
totalTime = ( times cpu - startTime)

user interface

displayStack = ( displayStack: maxSmallInt)
displayStack: =
( | act. i <- 0. new. threshold |
    act: currentActivation.
    stackShot removeAll.
    [ | :exit |
        stackShot addFirst: act.
        act hasSender ifFalse: [ exit value ].
        act: act sender.
    ] loopExit.
    threshold: stackShot size - n.
    stackShot do: [ | :a |
        i: i succ.
        i > threshold ifTrue: [
            a hasSender && [i > threshold succ]
                ifTrue: [ ui addMirror: a Sprout: '<sender>' ]
                 False: [ ui add: a ].
        ].
    ].
    self)
displayStackDelta =
( | act. new. tos |
    "remove all dead activations from the top"
    [ | :exit |
        stackShot isEmpty || [stackShot first isLive]
          ifTrue: [ exit value ].
        ui remove: stackShot removeFirst.
    ] loopExit.

    act: currentActivation.
    tos: stackShot isEmpty ifTrue: [ mirrors deadActivation ]
                            False: [ stackShot first ].
    new: list copyRemoveAll.

    "make a list of the new activations"
    [ | :exit |
        act = tos ifTrue: [ exit value ]
                   False: [ new addFirst: act ].
        act hasSender ifFalse: [ exit value ].
        act: act sender.
    ] loopExit.

    "add the new activations to the stack and the ui"
    new do: [ | :a |
        stackShot addFirst: a.
        a hasSender && [ui exists: a sender]
            ifTrue: [ ui addMirror: a Sprout: '<sender>' ]
             False: [ ui addMirror: a ].
    ].

    "update current activation"
    ui update: currentActivation.
    ui update. "interruptably update them all"
    self)
displayTopOfStack = ( ui add: currentActivation)
finishCurrent = ( finish. displayStackDelta)
finishSelected =
( | act |
    "may want to put this in uiWorld"
    ui findFirst: [ | :b | b objMirror isReflecteeActivation ]
       IfPresent: [ | :b | act: b objMirror ]
        IfAbsent: [ act: currentActivation ].
    finish: act.
    displayStackDelta)
hand = ( birthEvent ifNotNil: [ birthEvent sourceHand ])
step_ui = ( step. displayStackDelta)