!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: exeblock.gs,v 1.8.2.4 2008-03-04 19:03:19 dhenrich Exp $
!
! Superclass Hierarchy:
!   ExecutableBlock, BlockClosure, Object.
!
!=========================================================================

removeallmethods ExecutableBlock
removeallclassmethods ExecutableBlock

category: 'For Documentation Installation only'
classmethod: ExecutableBlock
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'ExecutableBlock is an abstract superclass for the various kinds of GemStone
 Smalltalk code blocks that can be executed within the object server.' .
doc documentClassWith: txt.

txt := (GsDocText new) details:
'A GsMethod that lexically contains this block.'.
doc documentInstVar: #method with: txt.

txt := (GsDocText new) details:
'A SmallInteger, zero-based offset from first executable instruction in 
 method to first instruction in block.' .
doc documentInstVar: #firstPC with: txt.

txt := (GsDocText new) details: 'Unused.' .
doc documentInstVar: #spare1 with: txt.

txt := (GsDocText new) details:
'A SmallInteger that represents the number of arguments to this block.'.
doc documentInstVar: #numberArgs with: txt.

txt := (GsDocText new) details:
'A SmallInteger that represents the number of temporaries in this block.'.
doc documentInstVar: #numberTemps with: txt.

txt := (GsDocText new) details:
'A SmallInteger that gives the 1-based offset into the method''s source string
 of the first Character of the block''s source (a left square brace).'.
doc documentInstVar: #firstSourceOffset with: txt.

txt := (GsDocText new) details:
'A SmallInteger that gives the 1-based offset into the method''s source string
 of the last Character of the block''s source (a right square brace).'.
doc documentInstVar: #lastSourceOffset with: txt.

txt := (GsDocText new) details:
'An InvariantArray that contains Symbols which are the block''s argument and
 temporary names, in the order they are allocated in this block''s context.
 For blocks that have no arguments or temporaries, this is nil.'.
doc documentInstVar: #argsAndTemps with: txt.

txt := (GsDocText new) details:
'A Boolean that indicates whether or not ''self'' is used within the block.'.
doc documentInstVar: #blockSelfUsed with: txt.

txt := (GsDocText new) details: 'Unused'.
doc documentInstVar: #spare2 with: txt.

self description: doc.
%

category: 'Accessing'
method: ExecutableBlock
argsAndTemps

"Return the value of the argsAndTemps instance variable."

^argsAndTemps
%

category: 'Accessing'
method: ExecutableBlock
firstPC

"Return the value of the firstPC instance variable."

^firstPC
%

category: 'Accessing'
method: ExecutableBlock
firstSourceOffset

"Return the value of the firstSourceOffset instance variable."

^firstSourceOffset
%

! lastPC deleted

category: 'Accessing'
method: ExecutableBlock
lastSourceOffset

"Return the value of the lastSourceOffset instance variable."

^lastSourceOffset
%

category: 'Accessing'
method: ExecutableBlock
method

"Return the value of the method instance variable."

^method
%

category: 'Accessing'
method: ExecutableBlock
numberArgs

"Return the value of the numberArgs instance variable."

^numberArgs
%

category: 'Accessing'
method: ExecutableBlock
numberTemps

"Return the value of the numberTemps instance variable."

^numberTemps
%

! block value methods moved to Complex and Simple block classes

category: 'Private'
method: ExecutableBlock
_gbsTraversalCallback

"Private.  When GemBuilder Smalltalk traverses an ExecutableBlock, this method
 is called to place the block's source string in the traversal buffer."

^self _sourceString
%

category: 'Private'
method: ExecutableBlock
_gsReturnNoResult

"Returns from the block with no result left on the GemStone Smalltalk stack."

"To be sent only by the method _valueOnUnwind.
 Any other use corrupts the virtual machine's stack.  This is a special 
 selector in Object and is optimized by the compiler."

"not a real primitive"
self _primitiveFailed: #_gsReturnNoResult .
self _uncontinuableError
%

category: 'Private'
method: ExecutableBlock
_valueOnUnwind

"This method should be invoked only from within the virtual machine. Other
 use from a Smalltalk program will corrupt the Smalltalk execution
 stack."

"Used to implement valueNowOrOnUnwind:"

self value .  "execute the block"
self _gsReturnNoResult "exit from this method with no result"
%

category: 'Backward Compatibility'
method: ExecutableBlock
valueNowOrOnUnwindDo: aBlock
"Obsolete in GemStone 5.1. Use ensure: instead."

  ^ self ensure: aBlock
%

category: 'Block Evaluation'
method: ExecutableBlock
ensure: aBlock
"Evaluate the receiver.  Evaluate aBlock after evaluating the receiver,
 or before any return from a block that would return to the sender."

| result |

aBlock _installAsUnwindBlock . "requires a VariableContext for this method"

"force generation of a complex block so that this method executes with
 a VariableContext"
[ result := self value ] value .  "execute the block"

aBlock value .       "normal execution of the unwind block"
^ result
%

category: 'Private'
method: ExecutableBlock
_installAsUnwindBlock

"Install the receiver as an unwind block."

"The sender must be executing with a VariableContext; if not, the 
 primitive will fail."

<primitive: 33>
self _primitiveFailed: #_installAsUnwindBlock .
self _uncontinuableError
%

category: 'Flow of Control'
method: ExecutableBlock
untilFalse

"(Reserved selector.)  Evaluates the receiver repeatedly until the evaluation's
 result is false.  Return nil.  Generates an error if the receiver is not a
 zero-argument block."

"The following is a control structure optimization, not a recursive send."

^ [self value] untilFalse
%

category: 'Flow of Control'
method: ExecutableBlock
untilTrue

"(Reserved selector.)  Evaluates the receiver repeatedly until the evaluation's
 result is true.  Return nil.  Generates an error if the receiver is not a
 zero-argument block."

"The following is a control structure optimization, not a recursive send."

^ [self value] untilTrue
%

category: 'Flow of Control'
method: ExecutableBlock
whileFalse: aBlock

"(Reserved selector.)  Evaluates the zero-argument block aBlock repeatedly
 while the receiver evaluates to false.  Return nil.  Generates an error if the
 receiver is not a zero-argument block."

"The following is a control structure optimization, not a recursive send."

^ [self value] whileFalse: [aBlock value]
%

category: 'Flow of Control'
method: ExecutableBlock
whileTrue: aBlock

"(Reserved selector.)  Evaluates the zero-argument block aBlock repeatedly
 while the receiver evaluates to true.  Return nil.  Generates an error if the
 receiver is not a zero-argument block."

"The following is a control structure optimization, not a recursive send."

^ [self value] whileTrue: [aBlock value]
%

category: 'Accessing'
method: ExecutableBlock
_sourceString

"(Subclass responsibility.)"

^ ExecutableBlock subclassResponsibility: #_sourceString
%

category: 'Decompiling without Sources'
method: ExecutableBlock
_asSource

"return a stripped source representation of the block."

| result |
result := String new.
result addAll: self class name ;
  addAll: ' _with: #( ' ;
      "method will be supplied at regeneration time, so we skip it."
  addAll: firstPC asString ; add: $  ;
  addAll: numberArgs asString ; add: $  ;
  addAll: numberTemps asString ; add: $  ;
    "firstSourceOffset regenerated as 1"
    "lastSourceOffset regenerated as 1"
    "argsAndTemps regenerated as nil "
  addAll: ' ) ' .

^ result
%

category: 'Reloading Decompiled Methods'
method: ExecutableBlock
_method: aGsMethod 

"For use only when recreating blocks from decompiled methods.  Other
 use may cause incorrect execution of the GemStone Smalltalk virtual machine."

method := aGsMethod 
%

category: 'Reloading Decompiled Methods'
method: ExecutableBlock
_initialize: anArray

"For use only when recreating blocks from decompiled methods.  Other
 use may cause incorrect execution of the GemStone Smalltalk virtual machine."

firstPC := anArray at: 1 .
numberArgs := anArray at: 2 .
numberTemps := anArray at: 3 .
firstSourceOffset := 1 .
lastSourceOffset := 1 .
argsAndTemps := nil .
%

category: 'Reloading Decompiled Methods'
classmethod: ExecutableBlock
_with: anArray

"For use only when recreating blocks from decompiled methods.  Other
 use may cause incorrect execution of the GemStone Smalltalk virtual machine."

| result |
result := self _new .
result _initialize: anArray .
^ result
%

category: 'Storing and Loading'
classmethod: ExecutableBlock
loadFrom: passiveObj

"Reads from passiveObj the passive form of an object.  Converts the object to
 its active form by loading the information into a new instance of the receiver.
 Returns the new instance."

| src result marker meth o symbolList |

"Returns a new instance of the receiver read from the given PassiveObject"

marker := passiveObj objectPositionMarker.
src := passiveObj readObject.
symbolList := System myUserProfile symbolList .
meth := src _compileInContext: (o := Object new) symbolList: symbolList.
result := meth _executeInContext: o.
(result == nil _or: [(result isKindOf: ExecutableBlock) not]) ifTrue: [
  "error in compiling"
  self _halt: 'Error in recreating a ' + name.
  ^nil
  ]
ifFalse: [
  passiveObj hasRead: result marker: marker.
  ^result
  ]
%

category: 'Storing and Loading'
method: ExecutableBlock
writeTo: aPassiveObject

"Converts the receiver to its passive form and writes that information on
 aPassiveObject.

 SimpleBlocks can usually be passivated and then reactivated.  ComplexBlocks
 can be passivated but may have to be massaged to be reactivated.  References
 to 'self' in complex blocks will resolve to an instance of Object when the
 block is activated, and any arguments or temporaries from enclosing scopes
 will be nil."

aPassiveObject writeClass: self class.
aPassiveObject writeObject: self _sourceString; cr
%

category: 'Modification Tracking'
method: ExecutableBlock
_setModificationTrackingTo: tracker

"Private.

 No modification tracking is required for blocks,
 even if they are not invariant."

^self
%

!
! Thread Support
!

category: 'Processes - Blue Book'
method: ExecutableBlock
fork
  "forks the receiver as a new process at the current scheduling priority"
  
  ^self newProcess resume
%

category: 'Processes - Blue Book'
method: ExecutableBlock
forkAt: priority
  "forks the receiver as a new process at the given priority"
  
  | proc |
  proc := self newProcess.
  proc priority: priority.
  ^proc resume
%

category: 'Processes'
method: ExecutableBlock
forkWith: blockArgs
  "forks the receiver as a new process at the current scheduling priority"
  
  ^(self newProcessWith: blockArgs) resume
%

category: 'Processes'
method: ExecutableBlock
forkAt: priority with: blockArgs
  "forks the receiver as a new process at the given priority"
  
  | proc |
  proc := self newProcessWith: blockArgs.
  proc priority: priority.
  ^proc resume
%

category: 'Processes - Blue Book'
method: ExecutableBlock
newProcess
  "creates a new process holding the receiver"

  ^GsProcess _forBlock: self.
%

category: 'Processes - Blue Book'
method: ExecutableBlock
newProcessWith: argArray
  "creates a new process holding the receiver to be evaluated with the
   given arguments"

  ^GsProcess _forBlock: self with: argArray.
%

! deleted _fixKnownConversionErrors: result source: src symbolList: symbolList oldNamesDict: oldNamesDict oldLitVarsArray: oldLitVars

