!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: complexblock.gs,v 1.8 2008-01-09 22:50:09 stever Exp $
!
! Superclass Hierarchy:
!   ComplexBlock, ExecutableBlock, BlockClosure, Object.
!
!=========================================================================

removeallmethods ComplexBlock
removeallclassmethods ComplexBlock

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

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

txt := (GsDocText new) details:
'A ComplexBlock references a variable context to access variables in enclosing
 scopes.

 The GemStone virtual machine creates all complex blocks.  When a complex block
 becomes active, it does not require the creation of a variable context
 because it has no nested blocks that refer to its arguments or temporaries.
 The virtual machine allocates the block''s arguments and temporaries on the
 execution stack.' .
doc documentClassWith: txt.

txt := (GsDocText new) details:
'A VariableContext that contains the values of the enclosing scope variables
 that this block may access.  This variable can never be nil.  If it were,
 this block would be a SimpleBlock.'.
doc documentInstVar: #staticLink with: txt.

txt := (GsDocText new) details:
'If nil, this block is not active, otherwise it holds the oop of the block
 originally activated.'.
doc documentInstVar: #originalInstance with: txt.

txt := (GsDocText new) details:
'The value of self for the block; that is, the object that received the message
 that created this block.'.
doc documentInstVar: #selfValue with: txt.

self description: doc.
%

category: 'Accessing'
method: ComplexBlock
staticLink

"Returns the value of the instance variable staticLink."

^ staticLink
%

category: 'Accessing'
method: ComplexBlock
selfValue

"Returns the value of the instance variable selfValue."

^ selfValue
%

category: 'Accessing'
method: ComplexBlock
_sourceString

"Returns a String that will create a block similar to the receiver when
 the string is compiled.  References to variables in other contexts or
 to the pseudovariable 'self' will not recompile properly if the source
 string is used to create a new block similar to the receiver."

| result tempsArr lnk atemps |
result := String new.
result addAll: '"This is source for a ComplexBlock.  If there are
references to ''self'', or if non-block temporaries are used that
are not initialized in the block, it may not recreate a useful
block"
 | '.
"fold the arguments and temporaries of surrounding scopes together - the scopes
 won't be there if the source is used to create a new block, so duplicates
 must be eliminated"
tempsArr := Array new.
atemps := method argsAndTemps .
atemps ~~ nil ifTrue: [
  tempsArr addAll: atemps
  ].
lnk := staticLink.
[ lnk ~~ nil ] whileTrue: [
  lnk := lnk at: 1.
  (lnk isKindOf: ComplexVCBlock) ifTrue: [
    atemps := lnk argsAndTemps .
    atemps ~~ nil ifTrue: [
      atemps do: [:a | (tempsArr includesValue: a) ifFalse: [ tempsArr add: a ] ].
      ].
    lnk := lnk staticLink.
    ]
  ifFalse: [
    lnk := nil
    ].
  ].
tempsArr do: [:e |
  result addAll: e; add: $ .
  ].
result addAll: '|
^' .

method _sourceString
  copyFrom: firstSourceOffset
  to: lastSourceOffset
  into: result
  startingAt: result size + 1.
^result
%
category: 'Accessing'
classmethod: ComplexBlock
_sourceStringForConversion: aComplexBlock

"Returns a String that will create a block similar to the receiver when
 the string is compiled.  References to variables in other contexts or
 to the pseudovariable 'self' will not recompile properly if the source
 string is used to create a new block similar to the receiver."

| selectBlock src result ant methAnt lnk |
result := String new.
result addAll: '"This is source for a ComplexBlock.  If there are
references to ''self'', or if non-block temporaries are used that
are not initialized in the block, it may not recreate a useful
block"
 | '.
"fold the arguments and temporaries of surrounding scopes together - the scopes
 won't be there if the source is used to create a new block, so duplicates
 must be eliminated"
ant := IdentitySet new.
methAnt := aComplexBlock method _argsAndTemps.
methAnt ~~ nil
  ifTrue: [
    methAnt do: [ :x | ant add: (x asSymbol) ].
    ].

lnk := aComplexBlock staticLink.
[ lnk size > 1 ] whileTrue: [
  lnk := lnk at: 1.
  (lnk isKindOf: ComplexVCBlock) ifTrue: [
    lnk argsAndTemps ~~ nil ifTrue: [
      lnk argsAndTemps do: [:a | ant add: (a asSymbol)].
      ].
    lnk := lnk staticLink.
    ]
  ifFalse: [
    lnk := nil
    ].
  ].

ant do: [:e |
  result addAll: e; add: $ .
  ].

result addAll: '|
^' .

src := String new.
aComplexBlock method _sourceString
  copyFrom: aComplexBlock firstSourceOffset
  to: aComplexBlock lastSourceOffset
  into: src
  startingAt: 1.

((src at: 1) == ${)
  ifTrue: [ selectBlock := true. ]
  ifFalse: [
    selectBlock := false.
    ((src at: 1) == $[)
      ifFalse: [ result add: $[ ].
    ].

result addAll: src.

^self _fixConversionResult: result selectBlock: selectBlock
%
category: 'Private Conversion'
classmethod: ComplexBlock
_fixConversionResult: aString selectBlock: aBoolean

    | nSquiggleLeft nSquiggleRight nSquareLeft nSquareRight newString
      nSquiggleLeftConstants nSquiggleRightConstants nSquareLeftConstants nSquareRightConstants |

    nSquiggleLeftConstants := aString occurrencesOfDistinctEqualSubCollection: '${'.
    nSquiggleRightConstants := aString occurrencesOfDistinctEqualSubCollection: '$}'.
    nSquareLeftConstants := aString occurrencesOfDistinctEqualSubCollection: '$['.
    nSquareRightConstants := aString occurrencesOfDistinctEqualSubCollection: '$]'.

    nSquiggleLeft := aString occurrencesOf: ${.
    nSquiggleRight := aString occurrencesOf: $}.
    nSquareLeft := aString occurrencesOf: $[.
    nSquareRight := aString occurrencesOf: $].
    
    newString := aString copy.

    "The only known problems are missing ending braces..."

    aBoolean ifTrue:
        [((nSquiggleLeft - nSquiggleLeftConstants) - (nSquiggleRight - nSquiggleRightConstants)) timesRepeat:
             [newString add: $}]].

    ((nSquareLeft - nSquareLeftConstants) - (nSquareRight - nSquareRightConstants)) timesRepeat:
        [newString add: $]].

    ^newString
%
category: 'Block Evaluation'
method: ComplexBlock
value

"Return the value of the receiver evaluated with no arguments.
 If the block expects any arguments, an error is generated."

<primitive: 902>  "special bytecode"
^ self _primitiveFailed: #value
%

category: 'Block Evaluation'
method: ComplexBlock
value: anObject

"Return the value of the receiver evaluated with anObject as its argument.  If
 the block expects a different number of arguments, an error is generated."

<primitive: 902>  "special bytecode"
^ self _primitiveFailed: #value:
%

category: 'Block Evaluation'
method: ComplexBlock
value: firstObject value: secondObject

"Return the value of the receiver evaluated with the two objects as its
 arguments.  If the block expects a different number of arguments, an error is
 generated."

<primitive: 902>  "special bytecode"
^ self _primitiveFailed: #value:value:
%

category: 'Block Evaluation'
method: ComplexBlock
value: firstObject value: secondObject value: thirdObject

"Return the value of the receiver evaluated with the three objects as its
 arguments.  If the block expects a different number of arguments, an error is
 generated."

<primitive: 902>  "special bytecode"
^ self _primitiveFailed: #value:value:value:
%

category: 'Block Evaluation'
method: ComplexBlock
value: first value: second value: third value: fourth

"Return the value of the receiver evaluated with the four objects as
 its arguments.  If the block expects a different number of arguments,
 an error is generated."

<primitive: 902>  "special bytecode"
^ self _primitiveFailed: #value:value:value:value:
%

category: 'Block Evaluation'
method: ComplexBlock
value: first value: second value: third value: fourth value: fifth

"Return the value of the receiver evaluated with the five objects as
 its arguments.  If the block expects a different number of arguments,
 an error is generated."

<primitive: 902>  "special bytecode"
^ self _primitiveFailed: #value:value:value:value:value:
%

category: 'Block Evaluation'
method: ComplexBlock
valueWithArguments: argList

"Return the value of the receiver evaluated with the elements of the Array
 argList as arguments.  If the block expects a different number of arguments,
 an error is generated."

<primitive: 903>  "special bytecode"
^ self _primitiveFailed: #valueWithArguments: 
%

! deleted convertTo5With: symbolList oldNamesDict: oldNamesDict

category: 'Disassembly'
classmethod: ComplexBlock
_cost

^ 2

%

category: 'Updating'
method: ComplexBlock
changeToSegment: segment

"Assign the receiver to the given segment.  For complex blocks, also
change the segment for variable contexts."

| vc |

super changeToSegment: segment.

vc := staticLink.
[ vc ~~ nil ] whileTrue: [
  vc changeToSegment: segment.
  vc := vc at: 1.
  (vc isKindOf: VariableContext) ifFalse: [vc := nil].
].


