1 "

     2  COPYRIGHT (c) 1989-93 by Claus Gittinger

     3               All Rights Reserved

     4 

     5  This software is furnished under a license and may be used

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

     7  inclusion of the above copyright notice.   This software may not

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

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

    10  hereby transferred.

    11 "

    12 

    13 Object subclass:#Block

    14        instanceVariableNames:'code flags byteCode home nargs

    15                               sourcePos initialPC literals

    16                               selfValue'

    17        classVariableNames:'InvalidNewSignal'

    18        poolDictionaries:''

    19        category:'Kernel-Methods'

    20 !

    21 

    22 Block comment:'

    23 

    24 COPYRIGHT (c) 1989-93 by Claus Gittinger

    25               All Rights Reserved

    26 

    27 %W% %E%

    28 

    29 written spring 89 by claus

    30 '!

    31 

    32 !Block class methodsFor:'documentation'!

    33 

    34 documentation

    35 "

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

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

    38 

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

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

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

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

    43 

    44 Blocks keep a reference to the method context where the block was declared -

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

    46 This is also true when the method has already returned - since the

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

    48 

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

    50 blocks method context (if it is still living) - this make the implementation

    51 of long-jumps and control structures possible.

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

    53 is ignored and a simple return from the block is performed).

    54 

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

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

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

    58 

    59 Instance variables:

    60 

    61 code        <not_an_object>   the function pointer if its a compiled block

    62 flags       <SmallInteger>    special flag bits coded in a number

    63 byteCode    <ByteArray>       bytecode of home method if its an interpreted block

    64 home        <Context>         the context where this block lives

    65 nargs       <SmallInteger>    the number of arguments the block expects

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

    67                               relative to methods source beginning

    68 initialPC   <SmallInteger>    the start position within the byteCode

    69 literals    <Array>           the blocks literal array

    70 selfValue   <Object>          value to use for self if its a copying block

    71 

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

    73 "

    74 ! !

    75 

    76 !Block class methodsFor:'initialization' !

    77 

    78 initialize

    79     "setup the signals"

    80 

    81     InvalidNewSignal := (Signal new).

    82     InvalidNewSignal mayProceed:false.

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

    84 ! !

    85 

    86 !Block class methodsFor:'instance creation'!

    87 

    88 code:codeAddress byteCode:bCode nargs:numArgs sourcePosition:sourcePos initialPC:initialPC literals:literals

    89     "create a new cheap (homeless) block.

    90      Not for public use - special hook for the compiler."

    91 

    92     |newBlock|

    93 

    94     newBlock := super basicNew.

    95     newBlock code:codeAddress.

    96     newBlock byteCode:bCode.

    97     newBlock nargs:numArgs.

    98     newBlock sourcePosition:sourcePos. 

    99     newBlock initialPC:initialPC. 

   100     newBlock literals:literals.

   101     ^ newBlock

   102 !

   103 

   104 basicNew

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

   106 

   107     InvalidNewSignal raise.

   108     ^ nil

   109 !

   110 

   111 basicNew:size

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

   113 

   114     InvalidNewSignal raise.

   115     ^ nil

   116 ! !

   117 

   118 !Block methodsFor:'testing'!

   119 

   120 isBlock

   121     ^ true

   122 ! !

   123 

   124 !Block methodsFor:'accessing'!

   125 

   126 instVarAt:index

   127     "have to catch instVar access to code - since its no object"

   128 

   129     (index == 1) ifTrue:[^ self code].

   130     ^ super instVarAt:index

   131 !

   132 

   133 instVarAt:index put:value

   134     "have to catch instVar access to code - since its no object"

   135 

   136     (index == 1) ifTrue:[^ self code:value].

   137     ^ super instVarAt:index put:value

   138 !

   139 

   140 code

   141     "return the code field. This is not an object but the address of the machine instructions. 

   142      Therefore an integer representing the code-address is returned"

   143 

   144 %{  /* NOCONTEXT */

   145 

   146     if (_INST(code) != nil) {

   147         RETURN ( _MKSMALLINT((int)(_INST(code))) )

   148     }

   149 %}

   150 .

   151     ^ nil

   152 !

   153 

   154 byteCode

   155     "return the bytecode (a ByteArray) of the block"

   156 

   157     ^ byteCode

   158 !

   159 

   160 nargs

   161     "return the number of arguments I expect for evaluation"

   162 

   163     ^ nargs

   164 !

   165 

   166 selfValue

   167     "return the copied self"

   168 

   169     ^ selfValue

   170 ! !

   171 

   172 !Block methodsFor:'private accessing'!

   173 

   174 code:anAddress

   175     "set the code field - danger alert. 

   176      This is not an object but the address of the blocks machine instructions.

   177      Therefore the argument must be an integer representing for this address.

   178      You can crash Smalltalk very badly when playing around here ..."

   179 

   180 %{  /* NOCONTEXT */

   181     if (_isSmallInteger(anAddress))

   182         _INST(code) = (OBJ)(_intVal(anAddress));

   183 %}

   184 !

   185 

   186 byteCode:aByteArray

   187     "set the bytecode field - danger alert"

   188 

   189     byteCode := aByteArray

   190 !

   191 

   192 nargs:numArgs

   193     "set the number of arguments I expect for evaluation - danger alert"

   194 

   195     nargs := numArgs

   196 !

   197 

   198 sourcePosition:position 

   199     "set the position of the source within my method"

   200 

   201     sourcePos := position

   202 !

   203 

   204 initialPC:initial 

   205     "set the initial pc for evaluation - danger alert"

   206 

   207     initialPC := initial

   208 !

   209 

   210 literals:aLiteralArray 

   211     "set the literal array for evaluation - danger alert"

   212 

   213     literals := aLiteralArray

   214 ! !

   215 

   216 !Block methodsFor:'error handling'!

   217 

   218 argumentCountError:numberGiven

   219     "report that the number of arguments given does not match the number expected"

   220 

   221     self error:('Block got ' , numberGiven printString ,

   222                 ' args while ' , nargs printString , ' where expected')

   223 !

   224 

   225 invalidMethod

   226     "this is sent by the bytecode interpreter when the blocks definition is bad.

   227      Can only happen when playing around with the blocks instvars

   228      or the Compiler/runtime system is buggy"

   229 

   230     self error:'invalid block - not executable'

   231 !

   232 

   233 invalidByteCode

   234     "this is sent by the bytecode interpreter when trying to execute

   235      an invalid bytecode.

   236      Can only happen when playing around with the blocks instvars

   237       or the Compiler/runtime system is buggy"

   238 

   239     self error:'invalid byteCode in block - not executable'

   240 !

   241 

   242 receiverNotBoolean

   243     "this error is triggered when the bytecode-interpreter tries to

   244      execute ifTrue:/ifFalse or whileTrue: type of expressions where the

   245      receiver is neither true nor false."

   246 

   247     self error:'if/while on non-boolean receiver'

   248 ! !

   249 

   250 !Block methodsFor:'evaluation'!

   251 

   252 value

   253     "evaluate the receiver with no block args. The receiver must be a block without arguments."

   254 

   255 %{  /* NOCONTEXT */

   256 

   257     REGISTER OBJFUNC thecode;

   258     OBJ home;

   259     extern OBJ interpret();

   260 

   261     if (_INST(nargs) == _MKSMALLINT(0)) {

   262 #if defined(THIS_CONTEXT)

   263         if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)

   264             _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;

   265 #endif

   266         home = _BlockInstPtr(self)->b_home;

   267         thecode = _BlockInstPtr(self)->b_code;

   268         if (thecode != (OBJFUNC)nil) {

   269             /* compiled machine code */

   270             RETURN ( (*thecode)(home COMMA_SND) );

   271         }

   272         /* interpreted code */

   273         RETURN ( interpret(self, 0, nil, home COMMA_SND, nil) );

   274     }

   275 %}

   276 .

   277     ^ self argumentCountError:0

   278 !

   279 

   280 value:arg

   281     "evaluate the receiver with one argument. The receiver must be a 1-arg block."

   282 

   283 %{  /* NOCONTEXT */

   284 

   285     REGISTER OBJFUNC thecode;

   286     OBJ home;

   287     extern OBJ interpret();

   288 

   289     if (_INST(nargs) == _MKSMALLINT(1)) {

   290 #if defined(THIS_CONTEXT)

   291         if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)

   292             _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;

   293 #endif

   294         home = _BlockInstPtr(self)->b_home;

   295         thecode = _BlockInstPtr(self)->b_code;

   296         if (thecode != (OBJFUNC)nil) {

   297 #ifdef PASS_ARG_REF

   298             RETURN ( (*thecode)(home COMMA_SND, &arg) );

   299 #else

   300             RETURN ( (*thecode)(home COMMA_SND, arg) );

   301 #endif

   302         }

   303         /* interpreted code */

   304 #ifdef PASS_ARG_REF

   305         RETURN ( interpret(self, 1, nil, home COMMA_SND, nil, &arg) );

   306 #else

   307         RETURN ( interpret(self, 1, nil, home COMMA_SND, nil, arg) );

   308 #endif

   309     }

   310 %}

   311 .

   312     ^ self argumentCountError:1

   313 !

   314 

   315 value:arg1 value:arg2

   316     "evaluate the receiver with two arguments. The receiver must be a 2-arg block."

   317 

   318 %{  /* NOCONTEXT */

   319 

   320     REGISTER OBJFUNC thecode;

   321     OBJ home;

   322     extern OBJ interpret();

   323 

   324     if (_INST(nargs) == _MKSMALLINT(2)) {

   325 #if defined(THIS_CONTEXT)

   326         if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)

   327             _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;

   328 #endif

   329         home = _BlockInstPtr(self)->b_home;

   330         thecode = _BlockInstPtr(self)->b_code;

   331         if (thecode != (OBJFUNC)nil) {

   332 #ifdef PASS_ARG_REF

   333             RETURN ( (*thecode)(home COMMA_SND, &arg1) );

   334 #else

   335             RETURN ( (*thecode)(home COMMA_SND, arg1, arg2) );

   336 #endif

   337         }

   338 #ifdef PASS_ARG_REF

   339         RETURN ( interpret(self, 2, nil, home COMMA_SND, nil, &arg1) );

   340 #else

   341         RETURN ( interpret(self, 2, nil, home COMMA_SND, nil, arg1, arg2) );

   342 #endif

   343     }

   344 %}

   345 .

   346     ^ self argumentCountError:2

   347 !

   348 

   349 value:arg1 value:arg2 value:arg3

   350     "evaluate the receiver with three arguments. The receiver must be a 3-arg block."

   351 

   352 %{  /* NOCONTEXT */

   353 

   354     REGISTER OBJFUNC thecode;

   355     OBJ home;

   356     extern OBJ interpret();

   357 

   358     if (_INST(nargs) == _MKSMALLINT(3)) {

   359 #if defined(THIS_CONTEXT)

   360         if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)

   361             _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;

   362 #endif

   363         home = _BlockInstPtr(self)->b_home;

   364         thecode = _BlockInstPtr(self)->b_code;

   365         if (thecode != (OBJFUNC)nil) {

   366 #ifdef PASS_ARG_REF

   367             RETURN ( (*thecode)(home COMMA_SND, &arg1) );

   368 #else

   369             RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3) );

   370 #endif

   371         }

   372 #ifdef PASS_ARG_REF

   373         RETURN ( interpret(self, 3, nil, home COMMA_SND, nil, &arg1) );

   374 #else

   375         RETURN ( interpret(self, 3, nil, home COMMA_SND, nil, arg1, arg2, arg3) );

   376 #endif

   377     }

   378 %}

   379 .

   380     ^ self argumentCountError:3

   381 !

   382 

   383 value:arg1 value:arg2 value:arg3 value:arg4

   384     "evaluate the receiver with four arguments. The receiver must be a 4-arg block."

   385 

   386 %{  /* NOCONTEXT */

   387 

   388     REGISTER OBJFUNC thecode;

   389     OBJ home;

   390     extern OBJ interpret();

   391 

   392     if (_INST(nargs) == _MKSMALLINT(4)) {

   393 #if defined(THIS_CONTEXT)

   394         if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)

   395             _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;

   396 #endif

   397         home = _BlockInstPtr(self)->b_home;

   398         thecode = _BlockInstPtr(self)->b_code;

   399         if (thecode != (OBJFUNC)nil) {

   400 #ifdef PASS_ARG_REF

   401             RETURN ( (*thecode)(home COMMA_SND, &arg1) );

   402 #else

   403             RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4) );

   404 #endif

   405         }

   406 #ifdef PASS_ARG_REF

   407         RETURN ( interpret(self, 4, nil, home COMMA_SND, nil, &arg1) );

   408 #else

   409         RETURN ( interpret(self, 4, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4) );

   410 #endif

   411     }

   412 %}

   413 .

   414     ^ self argumentCountError:4

   415 !

   416 

   417 value:arg1 value:arg2 value:arg3 value:arg4 value:arg5

   418     "evaluate the receiver with four arguments. The receiver must be a 5-arg block."

   419 

   420 %{  /* NOCONTEXT */

   421 

   422     REGISTER OBJFUNC thecode;

   423     OBJ home;

   424     extern OBJ interpret();

   425 

   426     if (_INST(nargs) == _MKSMALLINT(5)) {

   427 #if defined(THIS_CONTEXT)

   428         if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)

   429             _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;

   430 #endif

   431         home = _BlockInstPtr(self)->b_home;

   432         thecode = _BlockInstPtr(self)->b_code;

   433         if (thecode != (OBJFUNC)nil) {

   434 #ifdef PASS_ARG_REF

   435             RETURN ( (*thecode)(home COMMA_SND, &arg1) );

   436 #else

   437             RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5) );

   438 #endif

   439         }

   440 #ifdef PASS_ARG_REF

   441         RETURN ( interpret(self, 5, nil, home COMMA_SND, nil, &arg1) );

   442 #else

   443         RETURN ( interpret(self, 5, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5) );

   444 #endif

   445     }

   446 %}

   447 .

   448     ^ self argumentCountError:5

   449 !

   450 

   451 value:arg1 value:arg2 value:arg3 value:arg4 value:arg5 value:arg6

   452     "evaluate the receiver with four arguments. The receiver must be a 6-arg block."

   453 

   454 %{  /* NOCONTEXT */

   455 

   456     REGISTER OBJFUNC thecode;

   457     OBJ home;

   458     extern OBJ interpret();

   459 

   460     if (_INST(nargs) == _MKSMALLINT(6)) {

   461 #if defined(THIS_CONTEXT)

   462         if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)

   463             _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;

   464 #endif

   465         home = _BlockInstPtr(self)->b_home;

   466         thecode = _BlockInstPtr(self)->b_code;

   467         if (thecode != (OBJFUNC)nil) {

   468 #ifdef PASS_ARG_REF

   469             RETURN ( (*thecode)(home COMMA_SND, &arg1) );

   470 #else

   471             RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5, arg6) );

   472 #endif

   473         }

   474 #ifdef PASS_ARG_REF

   475         RETURN ( interpret(self, 6, nil, home COMMA_SND, nil, &arg1) );

   476 #else

   477         RETURN ( interpret(self, 6, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5, arg6) );

   478 #endif

   479     }

   480 %}

   481 .

   482     ^ self argumentCountError:6

   483 !

   484 

   485 valueWithArguments:argArray

   486     "evaluate the receiver with arguments taken from argArray.

   487      The size of the argArray must match the number of arguments the receiver expects."

   488 

   489     |a1 a2 a3 a4 a5 a6 a7|

   490 

   491     (argArray class == Array) ifFalse:[

   492         ^ self error:'argument must be an array'

   493     ].

   494     (argArray size == nargs) ifFalse:[

   495         ^ self argumentCountError:(argArray size)

   496     ].

   497 %{

   498 

   499     REGISTER OBJFUNC thecode;

   500     OBJ home;

   501     extern OBJ interpret();

   502 

   503 #if defined(THIS_CONTEXT)

   504     if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */)

   505         _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;

   506 #endif

   507     switch (_intVal(_INST(nargs))) {

   508         case 7:

   509             a7 = _ArrayInstPtr(argArray)->a_element[6];

   510         case 6:

   511             a6 = _ArrayInstPtr(argArray)->a_element[5];

   512         case 5:

   513             a5 = _ArrayInstPtr(argArray)->a_element[4];

   514         case 4:

   515             a4 = _ArrayInstPtr(argArray)->a_element[3];

   516         case 3:

   517             a3 = _ArrayInstPtr(argArray)->a_element[2];

   518         case 2:

   519             a2 = _ArrayInstPtr(argArray)->a_element[1];

   520         case 1:

   521             a1 = _ArrayInstPtr(argArray)->a_element[0];

   522         case 0:

   523             break;

   524     }

   525     home = _BlockInstPtr(self)->b_home;

   526     thecode = _BlockInstPtr(self)->b_code;

   527     if (thecode != (OBJFUNC)nil) {

   528 #ifdef PASS_ARG_REF

   529         RETURN ( (*thecode)(home COMMA_SND, &a1) );

   530 #else

   531         RETURN ( (*thecode)(home COMMA_SND, a1, a2, a3, a4, a5, a6, a7) );

   532 #endif

   533     }

   534 #ifdef PASS_ARG_REF

   535     RETURN ( interpret(self, _intVal(_INST(nargs)), nil,

   536                                     home COMMA_SND, nil, &a1) );

   537 #else

   538     RETURN ( interpret(self, _intVal(_INST(nargs)), nil,

   539                                     home COMMA_SND, nil, a1, a2, a3, a4, a5, a6, a7) );

   540 #endif

   541 %}

   542 !

   543 

   544 valueNowOrOnUnwindDo:aBlock

   545     "evaluate the receiver - after that, or when some method sent within unwinds (i.e. does

   546      a long return), evaluate the argument, aBlock.

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

   548      executed regardless of error actions"

   549 

   550     |v|

   551 

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

   553     aBlock value.

   554     ^ v

   555 !

   556 

   557 valueOnUnwindDo:aBlock

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

   559      a long return), evaluate the argument, aBlock.

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

   561      executed regardless of error actions"

   562 

   563     ^ self value        "the real logic is in Context"

   564 ! !

   565 

   566 !Block methodsFor:'looping'!

   567 

   568 whileTrue:aBlock

   569     "evaluate the argument, aBlock while the receiver evaluates to true.

   570      - open coded by compiler but needed here for #perform and expression evaluation."

   571 %{

   572     extern OBJ _value;

   573     static struct inlineCache bval = _ILC0;

   574     static struct inlineCache selfVal = _ILC0;

   575 

   576     while ((*bval.ilc_func)(self, _value, CON_COMMA nil, &bval) == true) {

   577         if (InterruptPending != nil) interrupt(CONARG);

   578         (*selfVal.ilc_func)(aBlock, _value, CON_COMMA nil, &selfVal);

   579     }

   580 %}

   581 .

   582     ^ nil

   583 !

   584 

   585 whileTrue

   586     "evaluate the receiver until it evaluates to false (ST80 compatibility)"

   587 

   588     ^ self whileTrue:[]

   589 !

   590 

   591 whileFalse:aBlock

   592     "evaluate the argument while the receiver evaluates to false.

   593      - open coded by compiler but needed here for #perform and expression evaluation."

   594 %{

   595     extern OBJ _value;

   596     static struct inlineCache bval = _ILC0;

   597     static struct inlineCache selfVal = _ILC0;

   598 

   599     while ((*bval.ilc_func)(self, _value, CON_COMMA nil, &bval) == false) {

   600         if (InterruptPending != nil) interrupt(CONARG);

   601         (*selfVal.ilc_func)(aBlock, _value, CON_COMMA nil, &selfVal);

   602     }

   603 %}

   604 .

   605     ^ nil

   606 !

   607 

   608 whileFalse

   609     "evaluate the receiver until it evaluates to true (ST80 compatibility)"

   610 

   611     ^ self whileFalse:[]

   612 !

   613 

   614 doWhile:aBlock

   615     "repeat the receiver block until aBlock evaluates to false.

   616      The receiver is evaluated at least once."

   617 

   618     self value.

   619     [aBlock value] whileTrue:[

   620         self value

   621     ]

   622 !

   623 

   624 doUntil:aBlock

   625     "repeat the receiver block until aBlock evaluates to true.

   626      The receiver is evaluated at least once."

   627 

   628     self value.

   629     [aBlock value] whileFalse:[

   630         self value

   631     ]

   632 !

   633 

   634 loop

   635     "repeat the receiver forever (should contain a return somewhere).

   636      Inspired by a corresponding Self method."

   637 

   638     [true] whileTrue:[self value]

   639 

   640     "[Transcript showCr:'hello'] loop"  "must be stopped with interrupt"

   641 !

   642 

   643 valueWithExit

   644     "the receiver must be a block of one argument.  It is evaluated, and is passed a block,

   645      which, if sent a value:-message, will exit the receiver block, returning the parameter of the 

   646      value:-message. Used for premature returns to the caller.

   647      Taken from a manchester goody (also appears in Self)."

   648 

   649     ^ self value: [:exitValue | ^exitValue]

   650 

   651     "[:exit |

   652         1 to:10 do:[:i |

   653             i == 5 ifTrue:[exit value:'thats it']

   654         ].

   655         'regular block-value; never returned'

   656      ] valueWithExit"

   657 !

   658 

   659 loopWithExit

   660     "the receiver must be a block of one argument.  It is evaluated in a loop forever, and is passed a 

   661      block, which, if sent a value:-message, will exit the receiver block, returning the parameter of 

   662      the value:-message. Used for loops with exit in the middle.

   663      Inspired by a corresponding Self method."

   664 

   665     |exitBlock|

   666 

   667     exitBlock := [:exitValue | ^ exitValue].

   668     [true] whileTrue:[self value:exitBlock]

   669 

   670     "|i|

   671      i := 1.

   672      [:exit |

   673         i == 5 ifTrue:[exit value:'thats it'].

   674         i := i + 1

   675      ] loopWithExit"

   676 ! !

   677 

   678 !Block methodsFor:'process creation'!

   679 

   680 newProcess

   681     "create a new (unscheduled) process executing the receiver"

   682 

   683     |p pBlock startUp|

   684 

   685     startUp := self.

   686     pBlock := [ startUp value. Processor terminate:p ].

   687     p := Processor newProcessFor:pBlock.

   688     ^ p

   689 !

   690 

   691 fork

   692     "create a new process executing the receiver"

   693 

   694     ^ self newProcess resume

   695 !

   696 

   697 forkWith:argumentArray

   698     |b|

   699 

   700     b := [self valueWithArguments:argumentArray].

   701     b fork

   702 !

   703 

   704 forkAt:priority

   705     "create a new process executing the receiver"

   706 

   707     ^ (self newProcess priority:priority) resume

   708 ! !

   709 

   710 !Block methodsFor:'printing'!

   711 

   712 printString

   713     |homeClass|

   714 

   715     home notNil ifTrue:[

   716         ^ '[] in ', home printString

   717     ].

   718     ^ '[] in ???'

   719 !

   720 

   721 printOn:aStream

   722     |homeClass|

   723 

   724     aStream nextPutAll:'[] in '.

   725     homeClass := home containingClass.

   726     homeClass notNil ifTrue:[

   727         homeClass name printOn:aStream.

   728         aStream space.

   729         (homeClass selectorForMethod:home) printOn:aStream

   730     ] ifFalse:[

   731         aStream nextPutAll:' ???'

   732     ]

   733 ! !