hg/stx-libbasic: comparison Block.st

equal deleted inserted replaced

-:786812ab9bb3
+:3db82d6e6146
 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: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
+			   byteCode:bCode
-numArgs:numArgs
+			   numArgs:numArgs
-numVars:numVars
+			   numVars:numVars
-numStack:nStack
+			   numStack:nStack
-sourcePosition:sourcePos
+		     sourcePosition:sourcePos
-initialPC:initialPC
+			  initialPC:initialPC
-literals:literals.
+			   literals:literals.
 ^ newBlock
 "Modified: 24.6.1996 / 12:36:48 / stefan"
 "Created: 13.4.1997 / 00:04:09 / cg"
 !
 "/ (actually, the previous implementation was:
 "/ ^ self valueNowOrOnUnwindDo:aBlock
 "
 [
-[
+	[
-Transcript showCR:'one'.
+	    Transcript showCR:'one'.
-Processor activeProcess terminate.
+	    Processor activeProcess terminate.
-Transcript showCR:'two'.
+	    Transcript showCR:'two'.
-] ensure:[
+	] ensure:[
-Transcript showCR:'three'.
+	    Transcript showCR:'three'.
-].
+	].
 ] fork.
 "
 "
 [
-[
+	[
-Transcript showCR:'one'.
+	    Transcript showCR:'one'.
-Transcript showCR:'two'.
+	    Transcript showCR:'two'.
-] ensure:[
+	] ensure:[
-Transcript showCR:'three'.
+	    Transcript showCR:'three'.
-].
+	].
 ] fork.
 "
 !
 ifCurtailed:aBlock
 "
 |s|
 s := 'Makefile' asFilename readStream.
 [
-^ self
+	^ self
 ] ifCurtailed:[
-Transcript showCR:'closing the stream - even though a return occurred'.
+	Transcript showCR:'closing the stream - even though a return occurred'.
-s close
+	s close
 ]
 "
 "
 [
-|s|
+	 |s|
-s := 'Makefile' asFilename readStream.
+	 s := 'Makefile' asFilename readStream.
-[
+	 [
-Processor activeProcess terminate
+	    Processor activeProcess terminate
-] ifCurtailed:[
+	 ] ifCurtailed:[
-Transcript showCR:'closing the stream - even though process was terminated'.
+	    Transcript showCR:'closing the stream - even though process was terminated'.
-s close
+	    s close
-]
+	 ]
 ] fork
 "
 ! !
 !Block methodsFor:'Compatibility - Squeak'!
 Notice, that the handlerBlock may take 0,1 or 2 args.
 (1 arg  -> the exception;
 2 args -> the errorString and the erronous receiver)"
 handlerBlock numArgs == 1 ifTrue:[
-^ self on:Error do:handlerBlock
+	^ self on:Error do:handlerBlock
 ].
 ^ self
-on:Error
+	on:Error
-do:[:ex |
+	do:[:ex |
-|errString errReceiver|
+	    |errString errReceiver|
-handlerBlock numArgs == 0 ifTrue:[
+	    handlerBlock numArgs == 0 ifTrue:[
-ex return:handlerBlock value
+		ex return:handlerBlock value
-].
+	    ].
-errString := ex description.
+	    errString := ex description.
-errReceiver := ex suspendedContext receiver.
+	    errReceiver := ex suspendedContext receiver.
-ex return:(handlerBlock value:errString value:errReceiver)
+	    ex return:(handlerBlock value:errString value:errReceiver)
-]
+	]
 "
 |a|
 a := 0.
 (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.
 Q: is this the exact semantics of V'Ages method ?
-the documentation is unclean; it could be a valueNowOrOnUnwindDo: ..."
+	the documentation is unclean; it could be a valueNowOrOnUnwindDo: ..."
 ^ self ifCurtailed:aBlock
 "Created: 15.11.1996 / 11:38:37 / cg"
 ! !
 homeMethod
 "return the receivers home method.
 Thats the method where the block was created."
 home notNil ifTrue:[
-^ home method
+	^ home method
 ].
 ^ nil
 "Created: 19.6.1997 / 16:14:57 / cg"
 !
 !Block methodsFor:'binary storage'!
 storeBinaryDefinitionOn:stream manager:manager
 byteCode isNil ifTrue:[
-self error:'cannot preserve semantics of block'.
+	self error:'cannot preserve semantics of block'.
 ].
 ^ super storeBinaryDefinitionOn:stream manager:manager
 ! !
 !Block methodsFor:'conversion'!
 "convert myself into a varArg block;
 this one has 1 formal argument, which gets the list
 of actual arguments when evaluated."
 nargs ~~ 1 ifTrue:[
-self error:'vararg blocks must take exactly 1 argument - the arg list'.
+	self error:'vararg blocks must take exactly 1 argument - the arg list'.
-^ nil
+	^ nil
 ].
 self changeClassTo:VarArgBlock.
 ^ self
 "
 |b|
 b := [:argList | Transcript
-show:'invoked with args:';
+			show:'invoked with args:';
-showCR:argList
+			showCR:argList
-] asVarArgBlock.
+	  ] asVarArgBlock.
 b value.
 b value:'arg1'.
 b value:'arg1' value:'arg2' value:'arg3' value:'arg4'
 "
 |oldPrio retVal|
 oldPrio := Processor activePriority.
 [
-Processor activeProcess priority:priority.
+	Processor activeProcess priority:priority.
-retVal := self value.
+	retVal := self value.
 ] ensure:[
-Processor activeProcess priority:oldPrio
+	Processor activeProcess priority:oldPrio
 ].
 ^ retVal
 "
 [
-1000 timesRepeat:[
+	 1000 timesRepeat:[
-1000 factorial
+	     1000 factorial
-]
+	 ]
 ] valueAt:3
 "
 "Created: / 29.7.1998 / 19:19:48 / cg"
 !
 The size of the argArray must match the number of arguments the receiver expects."
 |a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12|
 (argArray notNil and:[(argArray class ~~ Array) and:[argArray isArray not]]) ifTrue:[
-^ self badArgumentArry
+	^ self badArgumentArry
 ].
 (argArray size == nargs) ifFalse:[
-^ self wrongNumberOfArguments:(argArray size)
+	^ self wrongNumberOfArguments:(argArray size)
 ].
 %{
 REGISTER OBJFUNC thecode;
 OBJ home;
 int __nargs;
 OBJ nA;
 #if defined(THIS_CONTEXT)
 if (__ISVALID_ILC_LNO(__pilc))
-__ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
+	    __ContextInstPtr(__thisContext)->c_lineno = __ILC_LNO_AS_OBJ(__pilc);
 #endif
 thecode = __BlockInstPtr(self)->b_code;
+nA = __INST(nargs);
 #ifndef NEW_BLOCK_CALL
 home = __BlockInstPtr(self)->b_home;
 if (thecode != (OBJFUNC)nil) {
-if ((nA = __INST(nargs)) == __MKSMALLINT(0)) {
+	/* the most common case (0 args) here (without a switch) */
-RETURN ( (*thecode)(home) );
-}
+	if (nA == __MKSMALLINT(0)) {
+	    RETURN ( (*thecode)(home) );
-switch (__intVal(__INST(nargs))) {
+	}
-default:
-goto error;
+	ap = __arrayVal(argArray);   /* nonNil after above test (size is known to be ok) */
-case 12:
+	switch ((INT)(nA)) {
-ap = __ArrayInstPtr(argArray)->a_element;
+	    default:
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11]) );
+		goto error;
-case 11:
+	    case __MKSMALLINT(12):
-ap = __ArrayInstPtr(argArray)->a_element;
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10], ap[11]) );
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10]) );
+	    case __MKSMALLINT(11):
-case 10:
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9], ap[10]) );
-ap = __ArrayInstPtr(argArray)->a_element;
+	    case __MKSMALLINT(10):
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9]) );
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8], ap[9]) );
-case 9:
+	    case __MKSMALLINT(9):
-ap = __ArrayInstPtr(argArray)->a_element;
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) );
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7], ap[8]) );
+	    case __MKSMALLINT(8):
-case 8:
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) );
-ap = __ArrayInstPtr(argArray)->a_element;
+	    case __MKSMALLINT(7):
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6], ap[7]) );
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
-case 7:
+	    case __MKSMALLINT(6):
-ap = __ArrayInstPtr(argArray)->a_element;
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5], ap[6]) );
+	    case __MKSMALLINT(5):
-case 6:
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4]) );
-ap = __ArrayInstPtr(argArray)->a_element;
+	    case __MKSMALLINT(4):
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4], ap[5]) );
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3]) );
-case 5:
+	    case __MKSMALLINT(3):
-ap = __ArrayInstPtr(argArray)->a_element;
+		RETURN ( (*thecode)(home, ap[0], ap[1], ap[2]) );
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3], ap[4]) );
+	    case __MKSMALLINT(2):
-case 4:
+		RETURN ( (*thecode)(home, ap[0], ap[1]) );
-ap = __ArrayInstPtr(argArray)->a_element;
+	    case __MKSMALLINT(1):
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2], ap[3]) );
+		RETURN ( (*thecode)(home, ap[0]) );
-case 3:
+	    case __MKSMALLINT(0):
-ap = __ArrayInstPtr(argArray)->a_element;
+		RETURN ( (*thecode)(home) );
-RETURN ( (*thecode)(home, ap[0], ap[1], ap[2]) );
+		break;
-case 2:
+	}
-ap = __ArrayInstPtr(argArray)->a_element;
-RETURN ( (*thecode)(home, ap[0], ap[1]) );
-case 1:
-RETURN ( (*thecode)(home, __ArrayInstPtr(argArray)->a_element[0]) );
-case 0:
-RETURN ( (*thecode)(home) );
-break;
-}
 }
 #endif
-__nargs = __intVal(__INST(nargs));
+if (nA != __MKSMALLINT(0)) {
-if (__nargs) {
+	ap = __arrayVal(argArray);   /* nonNil after above test (size is known to be ok) */
-switch (__nargs) {
+	switch ((INT)nA) {
-default:
+	    default:
-goto error;
+		goto error;
-case 12:
+	    case __MKSMALLINT(12):
-a12 = __ArrayInstPtr(argArray)->a_element[11];
+		a12 = ap[11];
-case 11:
+	    case __MKSMALLINT(11):
-a11 = __ArrayInstPtr(argArray)->a_element[10];
+		a11 = ap[10];
-case 10:
+	    case __MKSMALLINT(10):
-a10 = __ArrayInstPtr(argArray)->a_element[9];
+		a10 = ap[9];
-case 9:
+	    case __MKSMALLINT(9):
-a9 = __ArrayInstPtr(argArray)->a_element[8];
+		a9 = ap[8];
-case 8:
+	    case __MKSMALLINT(8):
-a8 = __ArrayInstPtr(argArray)->a_element[7];
+		a8 = ap[7];
-case 7:
+	    case __MKSMALLINT(7):
-a7 = __ArrayInstPtr(argArray)->a_element[6];
+		a7 = ap[6];
-case 6:
+	    case __MKSMALLINT(6):
-a6 = __ArrayInstPtr(argArray)->a_element[5];
+		a6 = ap[5];
-case 5:
+	    case __MKSMALLINT(5):
-a5 = __ArrayInstPtr(argArray)->a_element[4];
+		a5 = ap[4];
-case 4:
+	    case __MKSMALLINT(4):
-a4 = __ArrayInstPtr(argArray)->a_element[3];
+		a4 = ap[3];
-case 3:
+	    case __MKSMALLINT(3):
-a3 = __ArrayInstPtr(argArray)->a_element[2];
+		a3 = ap[2];
-case 2:
+	    case __MKSMALLINT(2):
-a2 = __ArrayInstPtr(argArray)->a_element[1];
+		a2 = ap[1];
-case 1:
+	    case __MKSMALLINT(1):
-a1 = __ArrayInstPtr(argArray)->a_element[0];
+		a1 = ap[0];
-case 0:
+	    case __MKSMALLINT(0):
-break;
+		break;
-}
+	}
 }
 #ifdef NEW_BLOCK_CALL
 if (thecode != (OBJFUNC)nil) {
-RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) );
+	RETURN ( (*thecode)(self, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) );
 }
 # ifdef PASS_ARG_POINTER
 RETURN ( __interpret(self, __nargs, nil, nil, nil, nil, &a1) );
 # else
 RETURN ( __interpret(self, __nargs, nil, nil, nil, nil, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) );
 %}.
 "
 the above code only supports up-to 12 arguments
 "
 ^ ArgumentSignal
-raiseRequestWith:self
+	raiseRequestWith:self
-errorString:'only blocks with up-to 12 arguments supported'
+	errorString:'only blocks with up-to 12 arguments supported'
 !
 valueWithOptionalArgument:arg
 "evaluate the receiver.
 Optionally pass an argument (if the receiver is a one arg block)."
 self numArgs == 1 ifTrue:[
-^ self value:arg
+	^ self value:arg
 ].
 ^ self value
 "
 |block|
 Answer nil if the signal is not handled."
 |sig handler|
 theContext selector == #on:do: ifTrue:[
-sig := theContext argAt:1.
+	sig := theContext argAt:1.
-sig isNil ifTrue:[
+	sig isNil ifTrue:[
-'Block [warning]: nil arg in on:do:-context (undefined Exception)' errorPrintCR.
+	    'Block [warning]: nil arg in on:do:-context (undefined Exception)' errorPrintCR.
-theContext fullPrint.
+	    theContext fullPrint.
-^ nil.
+	    ^ nil.
-].
+	].
-sig isSignal ifFalse:[
+	sig isSignal ifFalse:[
-'Block [warning]: non-Exception arg in on:do:-context' errorPrintCR.
+	    'Block [warning]: non-Exception arg in on:do:-context' errorPrintCR.
-theContext fullPrint.
+	    theContext fullPrint.
-^ nil.
+	    ^ nil.
-].
+	].
-(sig == signal or:[sig accepts:signal]) ifTrue:[
+	(sig == signal or:[sig accepts:signal]) ifTrue:[
-handler := theContext argAt:2.
+	    handler := theContext argAt:2.
-"/ this is for backward compatibility when no ex-arg
+	    "/ this is for backward compatibility when no ex-arg
-"/ is expected in the block. Is it worth the effort ?
+	    "/ is expected in the block. Is it worth the effort ?
-handler numArgs == 0 ifTrue:[
+	    handler numArgs == 0 ifTrue:[
-^ [:ex | handler value]
+		^ [:ex | handler value]
-].
+	    ].
-^ handler
+	    ^ handler
-].
+	].
 ] ifFalse:[
-"must be #valueWithExceptionHandler:"
+	"must be #valueWithExceptionHandler:"
-handler := theContext argAt:1.
+	handler := theContext argAt:1.
-^ handler handlerForSignal:signal.
+	^ handler handlerForSignal:signal.
 ].
 ^ nil
 "Created: / 25.7.1999 / 19:52:58 / stefan"
 "/ thisContext markForHandle. -- same as above pragma
 ^ self value. "the real logic is in Exception>>doRaise"
 "
 [
-1 foo
+	1 foo
 ] on:MessageNotUnderstoodSignal do:[:ex | self halt]
 [
-1 foo
+	1 foo
 ] on:SignalSet anySignal do:[:ex| 2 bar. self halt]
 "
 "Modified: / 26.7.1999 / 15:30:48 / stefan"
 !
 restartAction := [ myContext restart ].
 ^ self value:restartAction.
 "
 [:restart |
-(self confirm:'try again ?') ifTrue:[
+	(self confirm:'try again ?') ifTrue:[
-restart value.
+	    restart value.
-]
+	]
 ] valueWithRestart
 "
 "Modified: / 25.1.2000 / 21:47:50 / cg"
 !
 "/
 "/    aStream nextPutAll:'[] in '.
 "/    homeClass := home containingClass.
 "/    homeClass notNil ifTrue:[
-"/	homeClass name printOn:aStream.
+"/      homeClass name printOn:aStream.
-"/	aStream space.
+"/      aStream space.
-"/	(homeClass selectorForMethod:home) printOn:aStream
+"/      (homeClass selectorForMethod:home) printOn:aStream
 "/    ] ifFalse:[
-"/	aStream nextPutAll:' ???'
+"/      aStream nextPutAll:' ???'
 "/    ]
 "/
 ! !
 if any becomes runnable due to the evaluation of the receiver
 (i.e. if a semaphore is signalled)."
 "we must keep track of blocking-state if this is called nested"
 (OperatingSystem blockInterrupts) ifTrue:[
-"/ already blocked.
+	"/ already blocked.
-^ self value
+	^ self value
 ].
 ^ self ensure:[OperatingSystem unblockInterrupts].
 !
 |oldPrio activeProcess|
 activeProcess := Processor activeProcess.
 oldPrio := activeProcess changePriority:(Processor highestPriority).
 ^ self ensure:[
-activeProcess priority:oldPrio
+	activeProcess priority:oldPrio
 ]
 ! !
 !Block methodsFor:'process creation'!
 This avoids hardwiring access to the first argument in
 #unwind methods (and theoretically allows for other unwinding
 methods to be added)"
 aContext selector == #'value:onUnwindDo:' ifTrue:[
-^ aContext argAt:2
+	^ aContext argAt:2
 ].
 "/ for now, only #valueNowOrOnUnwindDo:
 "/          or   #valueOnUnwindDo:
 "/          or   #ensure:
 "
 |s|
 s := 'Makefile' asFilename readStream.
 [:arg |
-^ self
+	^ self
 ] value:12345 onUnwindDo:[
-Transcript showCR:'closing the stream - even though a return occurred'.
+	Transcript showCR:'closing the stream - even though a return occurred'.
-s close
+	s close
 ]
 "
 "
 [
-|s|
+	 |s|
-s := 'Makefile' asFilename readStream.
+	 s := 'Makefile' asFilename readStream.
-[:arg |
+	 [:arg |
-Processor activeProcess terminate
+	    Processor activeProcess terminate
-] value:12345 onUnwindDo:[
+	 ] value:12345 onUnwindDo:[
-Transcript showCR:'closing the stream - even though process was terminated'.
+	    Transcript showCR:'closing the stream - even though process was terminated'.
-s close
+	    s close
-]
+	 ]
 ] fork
 "
 !
 "
 |f|
 f := 'Makefile' asFilename readStream.
 [
-l := f nextLine.
+	l := f nextLine.
-l isNil ifTrue:[^ 'oops']
+	l isNil ifTrue:[^ 'oops']
 ] valueNowOrOnUnwindDo:[
-f close
+	f close
 ]
 "
 "Modified: 16.4.1996 / 11:05:26 / stefan"
 !
 "
 |s|
 s := 'Makefile' asFilename readStream.
 [
-^ self
+	^ self
 ] valueOnUnwindDo:[
-Transcript showCR:'closing the stream - even though a return occurred'.
+	Transcript showCR:'closing the stream - even though a return occurred'.
-s close
+	s close
 ]
 "
 "
 [
-|s|
+	 |s|
-s := 'Makefile' asFilename readStream.
+	 s := 'Makefile' asFilename readStream.
-[
+	 [
-Processor activeProcess terminate
+	    Processor activeProcess terminate
-] valueOnUnwindDo:[
+	 ] valueOnUnwindDo:[
-Transcript showCR:'closing the stream - even though process was terminated'.
+	    Transcript showCR:'closing the stream - even though process was terminated'.
-s close
+	    s close
-]
+	 ]
 ] fork
 "
 ! !
 !Block class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.111 2001-12-14 10:00:45 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.112 2002-04-11 09:45:18 cg Exp $'
 ! !
 Block initialize!

changeset 6498	3db82d6e6146
parent 6320	0db3f79930a9
child 6512	f015412236b3