"

 COPYRIGHT (c) 1989 by Claus Gittinger

 COPYRIGHT (c) 2015 Jan Vrany

 COPYRIGHT (c) 2018 Jan Vrany

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic' }"

"{ NameSpace: Smalltalk }"

CompiledCode variableSubclass:#Block

	instanceVariableNames:'home nargs sourcePos initialPC'

	classVariableNames:'InvalidNewSignal'

	poolDictionaries:''

	category:'Kernel-Methods'

!

!Block class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

 COPYRIGHT (c) 2015 Jan Vrany

 COPYRIGHT (c) 2018 Jan Vrany

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    Blocks are pieces of executable code which can be evaluated by sending

    them a value-message (''value'', ''value:'', ''value:value:'' etc).

    In smalltalk, Blocks provide the basic (and heavily used) mechanism

    for looping, enumerating collection elements, visitors, exception

    handling, unwinding, delayed execution and processes.

    Blocks are never created explicitely; the only creation

    is done by the compilers, when some sourceCode is compiled to either

    machine or byteCode.

    In the code, blocks are written as:

        [

            expression1. 

            ...

            expressionN 

        ]

    It represents the computation inside the brackets,

    and can be passed around as argument, assigned to variables or returned from a block or method.

    Creation of a block does NOT evaluate its expressions. You have to give the block to someone,

    who asks it to evaluate itself. This is done by sending #value to the block.

    i.e.

        foo := [ Transcript showCR:'Hello World'].

        ...

        foo value

    Blocks are used in many many ways; one particular use is as callback:

        |b|

        b := Button label:'Press me'.

        b action:[ Transcript showCR:'Hello'].

        b open.

    Blocks with arguments need a message of type ''value:arg1 ... value:argn''

    for evaluation; the number of arguments passed when evaluating must match

    the number of arguments the block was declared with otherwise an error is

    raised. 

    Blocks without args need a ''value'' message for evaluation.

    another use of blocks is in the enumeration protocols:

        |coll|

        coll := #( 'one' 'two' 'three').

        coll do:[:eachElement | Transcript showCR:eachElement ].

    Blocks keep a reference to the context where it was declared -

    this allows blocks to access the methods arguments and/or variables.

    This is still true after the method has returned - since the

    block keeps this reference, the methods context will NOT die in this case.

    (for experts: Smalltalk blocks are technically lambdas/closures)

    A return (via ^-statement) out of a block will force a return from the

    block's method context (if it is still living).

    This is effectively a kind of long-jumps out of the method which declared the block

    and makes control structures and loops possible.

    If the method is not alive (i.e. has already returned), a return out of the

    block will trigger an error.

    Long-jump is done by defining a catchBlock as ''[^ self]''

    somewhere up in the calling-tree. Then, to do the long-jump from out of some

    deeply nested method, simply do: ''catchBlock value''.

    [Instance variables:]

      home        <Context>         the context where this block was created (i.e. defined)

                                    this may be a blockContext or a methodContext

      nargs       <SmallInteger>    the number of arguments the block expects

      sourcePos   <SmallInteger>    the character position of its source, in chars

                                    relative to methods source beginning

      initialPC   <SmallInteger>    the start position within the byteCode

                                    for compiled blocks, this is nil.

    [Class variables:]

      InvalidNewSignal              raised if a Block is tried to be created

                                    with new (which is not allowed).

                                    Only the VM is allowed to create Blocks.

    NOTICE: layout known by runtime system and compiler - do not change

    [author:]

        Claus Gittinger

    [see also:]

        Process Context

        Collection

        ( contexts. blocks & unwinding : programming/contexts.html)

"

!

examples

"

    define a block and evaluate it:

									[exBegin]

	|b|

	b := [ Transcript showCR:'hello' ].

	Transcript showCR:'now evaluating the block ...'.

	b value.

									[exEnd]

    even here, blocks are involved:

    (although, the compiler optimizes things if possible)

									[exBegin]

	Transcript showCR:'now evaluating one of two blocks ...'.

	1 > 4 ifTrue:[

	    Transcript showCR:'foo'

	] ifFalse:[

	    Transcript showCR:'bar'

	]

									[exEnd]

    here things become obvious:

									[exBegin]

	|yesBlock noBlock|

	yesBlock := [ Transcript showCR:'foo' ].

	noBlock := [ Transcript showCR:'bar' ].

	Transcript showCR:'now evaluating one of two blocks ...'.

	1 > 4 ifTrue:yesBlock

	      ifFalse:noBlock

									[exEnd]

    simple loops:

      not very objectOriented:

									[exBegin]

	|i|

	i := 1.

	[i < 10] whileTrue:[

	    Transcript showCR:i.

	    i := i + 1

	]

									[exEnd]

      using integer protocol:

									[exBegin]

	1 to:10 do:[:i |

	    Transcript showCR:i.

	]

									[exEnd]

      interval protocol:

									[exBegin]

	(1 to:10) do:[:i |

	    Transcript showCR:i.

	]

									[exEnd]

    looping over collections:

      bad code:

      (only works with numeric-indexable collections)

									[exBegin]

	|i coll|

	coll := #(9 8 7 6 5).

	i := 1.

	[i <= coll size] whileTrue:[

	    Transcript showCR:(coll at:i).

	    i := i + 1.

	]

									[exEnd]

      just as bad (well, marginally better ;-):

      (only works with numeric-indexable collections)

									[exBegin]

	|coll|

	coll := #(9 8 7 6 5).

	1 to:coll size do:[:i |

	    Transcript showCR:(coll at:i).

	]

									[exEnd]

      the smalltalk way:

      (works with any collection)

									[exBegin]

	|coll|

	coll := #(9 8 7 6 5).

	coll do:[:element |

	    Transcript showCR:element.

	]

									[exEnd]

    Rule: use enumeration protocol of the collection instead of

	  manually indexing it. [with few exceptions]

    processes:

      forking a lightweight process (thread):

									[exBegin]

	[

	    Transcript showCR:'waiting ...'.

	    Delay waitForSeconds:2.

	    Transcript showCR:'here I am'.

	] fork

									[exEnd]

      some with low prio:

									[exBegin]

	[

	    Transcript showCR:'computing ...'.

	    10000 factorial.

	    Transcript showCR:'here I am'.

	] forkAt:(Processor userBackgroundPriority)

									[exEnd]

    handling exceptions:

									[exBegin]

	Error handle:[:ex |

	    Transcript showCR:'exception handler forces return'.

	    ex return

	] do:[

	    Transcript showCR:'now, doing something bad ...'.

	    1 / 0.

	    Transcript showCR:'not reached'

	]

									[exEnd]

    performing cleanup actions:

									[exBegin]

	Error handle:[:ex |

	    Transcript showCR:'exception handler forces return'.

	    ex return

	] do:[

	    [

		Transcript showCR:'doing something bad ...'.

		1 / 0.

		Transcript showCR:'not reached'

	    ] ifCurtailed:[

		Transcript showCR:'cleanup'

	    ]

	]

									[exEnd]

    delayed execution (visitor pattern):

    (looking carefully into the example,

     C/C++ programmers may raise their eyes ;-)

									[exBegin]

	|showBlock countBlock

	 howMany

	 top panel b1 b2|

	howMany := 0.

	showBlock := [ Transcript showCR:howMany ].

	countBlock := [ howMany := howMany + 1 ].

	top := StandardSystemView extent:200@200.

	panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.

	b1 := Button label:'count up' in:panel.

	b1 action:countBlock.

	b2 := Button label:'show value' in:panel.

	b2 action:showBlock.

	top open.

	Transcript showCR:'new process started;'.

	Transcript showCR:'notice: the blocks can still access the'.

	Transcript showCR:'        howMany local variable.'.

									[exEnd]

"

! !

!Block class methodsFor:'initialization'!

initialize

    "create signals raised by various errors"

    InvalidNewSignal isNil ifTrue:[

	InvalidNewSignal := Error newSignalMayProceed:false.

	InvalidNewSignal nameClass:self message:#invalidNewSignal.

	InvalidNewSignal notifierString:'blocks are only created by the system'.

    ]

    "Modified: 22.4.1996 / 16:34:20 / cg"

! !

!Block class methodsFor:'instance creation'!

byteCode:bCode numArgs:numArgs numStack:nStack sourcePosition:sourcePos initialPC:initialPC literals:literals

    "create a new cheap (homeless) block.

     Not for public use - this is a special hook for the compiler."

    ^ self

	byteCode:bCode numArgs:numArgs numVars:0 numStack:nStack sourcePosition:sourcePos initialPC:initialPC literals:literals

!

byteCode:bCode numArgs:numArgs numVars:numVars numStack:nStack sourcePosition:sourcePos initialPC:initialPC literals:literals

    "create a new cheap (homeless) block.

     Not for public use - this is a special hook for the compiler."

    |newBlock|

    newBlock := (super basicNew:(literals size))

			   byteCode:bCode

			   numArgs:numArgs

			   numVars:numVars

			   numStack:nStack

		     sourcePosition:sourcePos

			  initialPC:initialPC

			   literals:literals.

    ^ newBlock

    "Modified: 24.6.1996 / 12:36:48 / stefan"

    "Created: 13.4.1997 / 00:04:09 / cg"

!

new

    "catch creation of blocks - only the system creates blocks.

     If you really need a block (assuming, you are some compiler),

     use basicNew and setup the instance carefully"

    ^ InvalidNewSignal raise.

!

new:size

    "catch creation of blocks - only the system creates blocks"

    ^ InvalidNewSignal raise.

! !

!Block class methodsFor:'queries'!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Here, true is returned for myself, false for subclasses."

    ^ self == Block

    "Modified: 23.4.1996 / 15:55:58 / cg"

! !

!Block methodsFor:'Compatibility-ANSI'!

argumentCount

    "VisualAge/ANSI compatibility: alias for #numArgs.

     return the number of arguments I expect for evaluation"

    ^ nargs

    "Created: 15.11.1996 / 11:22:02 / cg"

!

ensure:aBlock

    "VisualAge/ANSI compatibility:

     evaluate the receiver and return its result.

     After evaluation, also evaluate aBlock but ignore its result.

     aBlock is also evaluated in case of abnormal termination.

     (the same as #valueNowOrOnUnwindDo:)"

    <exception: #unwind>

    |v|

    v := self value.       "the real logic is in Context>>unwind"

    thisContext unmarkForUnwind.

    aBlock value.

    ^ v

    "/ the above is the same as in #valueNowOrOnUnwindDo:

    "/ (actually, the previous implementation was:

    "/ ^ self valueNowOrOnUnwindDo:aBlock

    "

     [

	[

	    Transcript showCR:'one'.

	    Processor activeProcess terminate.

	    Transcript showCR:'two'.

	] ensure:[

	    Transcript showCR:'three'.

	].

     ] fork.

    "

    "

     [

	[

	    Transcript showCR:'one'.

	    Transcript showCR:'two'.

	] ensure:[

	    Transcript showCR:'three'.

	].

     ] fork.

    "

!

ifCurtailed:aBlock

    "VisualAge/ANSI compatibility:

     evaluate the receiver - when some method sent within unwinds (i.e. does

     a long return), evaluate the argument, aBlock.

     This is used to make certain that cleanup actions (for example closing files etc.) are

     executed regardless of error actions.

     This is the same as #valueOnUnwindDo:"

    <exception: #unwind>

    |v|

    "/ thisContext markForUnwind. -- same as above pragma

    v := self value.       "the real logic is in Context>>unwind"

    thisContext unmarkForUnwind.

    ^ v

    "

     |s|

     s := 'Makefile' asFilename readStream.

     [

	^ self

     ] ifCurtailed:[