This file is indexed.

/usr/share/gnu-smalltalk/kernel/BlkClosure.st is in gnu-smalltalk-common 3.2.5-1build2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
"======================================================================
|
|   BlockClosure Method Definitions
|
|
 ======================================================================"

"======================================================================
|
| Copyright 1999, 2000, 2001, 2002, 2003, 2007, 2008, 2009
| Free Software Foundation, Inc.
| Written by Steve Byrne.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
| 
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
| General Public License for more details.
| 
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02110-1301, USA.  
|
 ======================================================================"



Object subclass: BlockClosure [
    | outerContext block receiver |
    
    <category: 'Language-Implementation'>
    <comment: 'I am a factotum class.  My instances represent Smalltalk blocks, portions
of executeable code that have access to the environment that they were
declared in, take parameters, and can be passed around as objects to be
executed by methods outside the current class.
Block closures are sent a message to compute their value and create a new
execution context; this property can be used in the construction of
control flow methods.  They also provide some methods that are used in the
creation of Processes from blocks.'>

    BlockClosure class >> exceptionHandlerResetBlock [
	<category: 'private-instance creation'>
	^[:context | context at: context numArgs + 1 put: 0]
    ]

    BlockClosure class >> exceptionHandlerSearchBlock [
	<category: 'private-instance creation'>
	^
	[:context :signal | 
	| best bestGoodness goodness activeHandlers nested |
	bestGoodness := -1.
	activeHandlers := context at: context numArgs + 1.
	context at: context numArgs + 1 put: -1.
	nested := activeHandlers = -1.
	nested 
	    ifFalse: 
		[1 to: context numArgs - 1
		    by: 2
		    do: 
			[:i | 
			goodness := (context at: i) goodness: signal class.
			goodness > -1 
			    ifTrue: 
				[(activeHandlers bitAt: i) = 1 
				    ifTrue: 
					["Sorry, this handler is already active..."

					nested := true.
					goodness := -1]].
			goodness > bestGoodness 
			    ifTrue: 
				[best := i.
				bestGoodness := goodness]]].

	"Now instantiate the best handler we found"
	best isNil 
	    ifFalse: 
		[context at: context numArgs + 1 put: (activeHandlers setBit: best).
		signal 
		    onDoBlock: context receiver
		    handlerBlock: (context at: best + 1)
		    onDoContext: context
		    previousState: activeHandlers.
		#found]
	    ifTrue: 
		[context at: context numArgs + 1 put: activeHandlers.
		nested ifTrue: [#skip] ifFalse: [nil]]]
    ]

    BlockClosure class >> numArgs: args numTemps: temps bytecodes: bytecodes depth: depth literals: literalArray [
	"Answer a BlockClosure for a new CompiledBlock that is created using
	 the passed parameters.  To make it work, you must put the BlockClosure
	 into a CompiledMethod's literals."

	<category: 'instance creation'>
	^self block: (CompiledBlock 
		    numArgs: args
		    numTemps: temps
		    bytecodes: bytecodes
		    depth: depth
		    literals: literalArray)
    ]

    BlockClosure class >> block: aCompiledBlock receiver: anObject outerContext: aContext [
	"Answer a BlockClosure that activates the passed CompiledBlock
	 with the given receiver."

	<category: 'instance creation'>
	^(self new)
	    block: aCompiledBlock;
	    receiver: anObject;
	    outerContext: aContext;
	    yourself
    ]

    BlockClosure class >> block: aCompiledBlock receiver: anObject [
	"Answer a BlockClosure that activates the passed CompiledBlock
	 with the given receiver."

	<category: 'instance creation'>
	^(self new)
	    block: aCompiledBlock;
	    receiver: anObject;
	    yourself
    ]

    BlockClosure class >> block: aCompiledBlock [
	"Answer a BlockClosure that activates the passed CompiledBlock."

	<category: 'instance creation'>
	^(self new)
	    block: aCompiledBlock;
	    yourself
    ]

    BlockClosure class >> isImmediate [
	"Answer whether, if x is an instance of the receiver, x copy == x"

	<category: 'testing'>
	^true
    ]

    copy [
	<category: 'overriding'>
	^self	"We only have one instance"
    ]

    deepCopy [
	"Answer a shallow copy."
	<category: 'overriding'>
	^self shallowCopy	"it's about as deep as we need to get"
    ]

    asContext: parent [
	"Answer a context which will evaluate the receiver without effects on
	 the given context's stack (the return value won't be pushed), as
	 soon as it becomes the VM's thisContext.
	 parent can be nil - in which case reaching the end of the block will
	 probably crash Smalltalk.
	 Note that the block has no home, so it cannot contain returns."

	<category: 'private'>
	^BlockContext
	    fromClosure: [
	        | top |
	        top := parent isNil
		    ifTrue: [nil]
		    ifFalse: [
			parent sp == 0 
			    ifTrue: [parent receiver]
			    ifFalse: [parent at: parent sp]].
	        self value. top]
	    parent: parent.
    ]

    on: anException do: aBlock [
	"Evaluate the receiver; when anException is signaled, evaluate aBlock
	 passing a Signal describing the exception. Answer either the result of
	 evaluating the receiver or the parameter of a Signal>>#return:"

	<category: 'exception handling'>
	| active |
	<exceptionHandlerSearch: BlockClosure exceptionHandlerSearchBlock
	reset: BlockClosure exceptionHandlerResetBlock>
	active := 0.
	^self valueAndResumeOnUnwind
    ]

    on: e1 do: b1 on: e2 do: b2 [
	"Evaluate the receiver; when e1 or e2 are signaled, evaluate respectively
	 b1 or b2, passing a Signal describing the exception. Answer either the
	 result of evaluating the receiver or the argument of a Signal>>#return:"

	<category: 'exception handling'>
	| active |
	<exceptionHandlerSearch: BlockClosure exceptionHandlerSearchBlock
	reset: BlockClosure exceptionHandlerResetBlock>
	active := 0.
	^self valueAndResumeOnUnwind
    ]

    on: e1 do: b1 on: e2 do: b2 on: e3 do: b3 [
	"Evaluate the receiver; when e1, e2 or e3 are signaled, evaluate
	 respectively b1, b2 or b3, passing a Signal describing the exception.
	 Answer either the result of evaluating the receiver or the parameter of a
	 Signal>>#return:"

	<category: 'exception handling'>
	| active |
	<exceptionHandlerSearch: BlockClosure exceptionHandlerSearchBlock
	reset: BlockClosure exceptionHandlerResetBlock>
	active := 0.
	^self valueAndResumeOnUnwind
    ]

    on: e1 do: b1 on: e2 do: b2 on: e3 do: b3 on: e4 do: b4 [
	"Evaluate the receiver; when e1, e2, e3 or e4 are signaled, evaluate
	 respectively b1, b2, b3 or b4, passing a Signal describing the exception.
	 Answer either the result of evaluating the receiver or the parameter of a
	 Signal>>#return:"

	<category: 'exception handling'>
	| active |
	<exceptionHandlerSearch: BlockClosure exceptionHandlerSearchBlock
	reset: BlockClosure exceptionHandlerResetBlock>
	active := 0.
	^self valueAndResumeOnUnwind
    ]

    on: e1 do: b1 on: e2 do: b2 on: e3 do: b3 on: e4 do: b4 on: e5 do: b5 [
	"Evaluate the receiver; when e1, e2, e3, e4 or e5 are signaled, evaluate
	 respectively b1, b2, b3, b4 or b5, passing a Signal describing the exception.
	 Answer either the result of evaluating the receiver or the parameter of a
	 Signal>>#return:"

	<category: 'exception handling'>
	| active |
	<exceptionHandlerSearch: BlockClosure exceptionHandlerSearchBlock
	reset: BlockClosure exceptionHandlerResetBlock>
	active := 0.
	^self valueAndResumeOnUnwind
    ]

    ifError: aBlock [
	"Evaluate the receiver; when #error: is called, pass to aBlock the receiver
	 and the parameter, and answer the result of evaluating aBlock.  If another
	 exception is raised, it is passed to an outer handler; if no exception is
	 raised, the result of evaluating the receiver is returned."

	<category: 'exception handling'>
	^self on: Error do: [:sig | sig return: (aBlock cull: sig messageText)]
    ]

    ensure: aBlock [
	"Evaluate the receiver; when any exception is signaled exit returning the
	 result of evaluating aBlock; if no exception is raised, return the result
	 of evaluating aBlock when the receiver has ended"

	<category: 'unwind protection'>
	| result |
	result := self valueAndResumeOnUnwind.
	aBlock value.
	^result
    ]

    ifCurtailed: aBlock [
	"Evaluate the receiver; if its execution triggers an unwind which truncates
	 the execution of the block (`curtails' the block), evaluate aBlock.  The
	 three cases which can curtail the execution of the receiver are: a non-local
	 return in the receiver, a non-local return in a block evaluated by the
	 receiver which returns past the receiver itself, and an exception raised
	 and not resumed during the execution of the receiver."

	<category: 'unwind protection'>
	| curtailed |
	^
	[| result |
	curtailed := true.
	result := self value.
	curtailed := false.
	result] 
		ensure: [curtailed ifTrue: [aBlock value]]
    ]

    valueWithUnwind [
	"Evaluate the receiver. Any errors caused by the block will cause a
	 backtrace, but execution will continue in the method that sent
	 #valueWithUnwind, after that call. Example:
	 [ 1 / 0 ] valueWithUnwind.
	 'unwind works!' printNl.
	 
	 Important: this method is public, but it is intended to be used in
	 very special cases (as a rule of thumb, use it only when the
	 corresponding C code uses the _gst_prepare_execution_environment and
	 _gst_finish_execution_environment functions). You should usually
	 rely on #ensure: and #on:do:."

	<category: 'unwind protection'>
	thisContext mark.
	^self value
    ]

    repeat [
	"Evaluate the receiver 'forever' (actually until a return is executed
	 or the process is terminated)."

	"When the receiver is a block expression, repeat is optimized
	 by the compiler"

	<category: 'control structures'>
	[self value] repeat
    ]

    whileTrue: aBlock [
	"Evaluate the receiver. If it returns true, evaluate aBlock and restart"

	"When the receiver is a block expression, whileTrue: is optimized
	 by the compiler"

	<category: 'control structures'>
	[self value] whileTrue: [aBlock value].
	^nil
    ]

    whileFalse: aBlock [
	"Evaluate the receiver. If it returns false, evaluate aBlock and restart"

	"When the receiver is a block expression, whileFalse: is optimized
	 by the compiler"

	<category: 'control structures'>
	[self value] whileFalse: [aBlock value].
	^nil
    ]

    whileTrue [
	"Evaluate the receiver until it returns false"

	"When the receiver is a block expression, whileTrue is optimized
	 by the compiler"

	<category: 'control structures'>
	^[self value] whileTrue
    ]

    whileFalse [
	"Evaluate the receiver until it returns true"

	"When the receiver is a block expression, whileFalse is optimized
	 by the compiler"

	<category: 'control structures'>
	^[self value] whileFalse
    ]

    fork [
	"Create a new process executing the receiver and start it"

	<category: 'multiple process'>
	^Process 
	    on: self
	    at: Processor activePriority
	    suspend: false
    ]

    forkAt: priority [
	"Create a new process executing the receiver with given priority
	 and start it"

	<category: 'multiple process'>
	^Process 
	    on: self
	    at: priority
	    suspend: false
    ]

    newProcess [
	"Create a new process executing the receiver in suspended state.
	 The priority is the same as for the calling process. The receiver
	 must not contain returns"

	<category: 'multiple process'>
	^Process 
	    on: self
	    at: Processor activePriority
	    suspend: true
    ]

    newProcessWith: anArray [
	"Create a new process executing the receiver with the passed
	 arguments, and leave it in suspended state. The priority is
	 the same as for the calling process. The receiver must not
	 contain returns"

	<category: 'multiple process'>
	^Process 
	    on: [self valueWithArguments: anArray]
	    at: Processor activePriority
	    suspend: true
    ]

    forkWithoutPreemption [
	"Evaluate the receiver in a process that cannot be preempted.
	 If the receiver expect a parameter, pass the current process."

	<category: 'multiple process'>
	| creator |
	creator := Processor activeProcess.
	^Process 
	    on: [self cull: creator]
	    at: Processor unpreemptedPriority
	    suspend: false
    ]

    valueWithoutInterrupts [
	"Evaluate aBlock and delay all interrupts that are requested to the
	 active process during its execution to after aBlock returns."

	<category: 'multiple process'>
	^Processor activeProcess valueWithoutInterrupts: self
    ]

    valueWithoutPreemption [
	"Evaluate the receiver with external interrupts disabled.  This
	 effectively disables preemption as long as the block does not
	 explicitly yield control, wait on semaphores, and the like."

	<category: 'multiple process'>
	^
	[Processor disableInterrupts.
	self value] 
		ensure: [Processor enableInterrupts]
    ]

    hasMethodReturn [
	"Answer whether the block contains a method return"

	<category: 'testing'>
	^self method 
	    hasBytecode: 124
	    between: self initialIP
	    and: self finalIP
    ]

    fixTemps [
	"This should fix the values of the temporary variables used in the
	 block that are ordinarily shared with the method in which the block
	 is defined.  Not defined yet, but it is not harmful that it isn't.
	 Answer the receiver."

	<category: 'accessing'>
	^self
    ]

    block [
	"Answer the CompiledBlock which contains the receiver's bytecodes"

	<category: 'accessing'>
	^block
    ]

    block: aCompiledBlock [
	"Set the CompiledBlock which contains the receiver's bytecodes"

	<category: 'accessing'>
	block := aCompiledBlock
    ]

    finalIP [
	"Answer the last instruction that can be executed by the receiver"

	<category: 'accessing'>
	^self block size
    ]

    initialIP [
	"Answer the initial instruction pointer into the receiver."

	<category: 'accessing'>
	^1
    ]

    argumentCount [
	"Answer the number of arguments passed to the receiver"

	<category: 'accessing'>
	^block numArgs
    ]

    numArgs [
	"Answer the number of arguments passed to the receiver"

	<category: 'accessing'>
	^block numArgs
    ]

    numTemps [
	"Answer the number of temporary variables used by the receiver"

	<category: 'accessing'>
	^block numTemps
    ]

    stackDepth [
	"Answer the number of stack slots needed for the receiver"

	<category: 'accessing'>
	^block stackDepth
    ]

    method [
	"Answer the CompiledMethod in which the receiver lies"

	<category: 'accessing'>
	^block method
    ]

    receiver [
	"Answer the object that is used as `self' when executing the receiver
	 (if nil, it might mean that the receiver is not valid though...)"

	<category: 'accessing'>
	^receiver
    ]

    receiver: anObject [
	"Set the object that is used as `self' when executing the receiver"

	<category: 'accessing'>
	receiver := anObject
    ]

    outerContext [
	"Answer the method/block context which is the immediate outer of
	 the receiver"

	<category: 'accessing'>
	^outerContext
    ]

    outerContext: containingContext [
	"Set the method/block context which is the immediate outer of
	 the receiver"

	<category: 'accessing'>
	outerContext := containingContext
    ]

    value [
	"Evaluate the receiver passing no parameters"

	<category: 'built ins'>
	<primitive: VMpr_BlockClosure_value>
	SystemExceptions.WrongArgumentCount signal
    ]

    value: arg1 [
	"Evaluate the receiver passing arg1 as the only parameter"

	<category: 'built ins'>
	<primitive: VMpr_BlockClosure_value>
	SystemExceptions.WrongArgumentCount signal
    ]

    value: arg1 value: arg2 [
	"Evaluate the receiver passing arg1 and arg2 as the parameters"

	<category: 'built ins'>
	<primitive: VMpr_BlockClosure_value>
	SystemExceptions.WrongArgumentCount signal
    ]

    value: arg1 value: arg2 value: arg3 [
	"Evaluate the receiver passing arg1, arg2 and arg3 as the parameters"

	<category: 'built ins'>
	<primitive: VMpr_BlockClosure_value>
	SystemExceptions.WrongArgumentCount signal
    ]

    cull: arg1 [
	"Evaluate the receiver, passing arg1 as the only parameter if
	 the receiver has parameters."

	<category: 'built ins'>
	<primitive: VMpr_BlockClosure_cull>
	SystemExceptions.WrongArgumentCount signal
    ]

    cull: arg1 cull: arg2 [
	"Evaluate the receiver, passing arg1 and arg2 as parameters if
	 the receiver accepts them."

	<category: 'built ins'>
	<primitive: VMpr_BlockClosure_cull>
	SystemExceptions.WrongArgumentCount signal
    ]

    cull: arg1 cull: arg2 cull: arg3 [
	"Evaluate the receiver, passing arg1, arg2 and arg3 as parameters if
	 the receiver accepts them."

	<category: 'built ins'>
	<primitive: VMpr_BlockClosure_cull>
	SystemExceptions.WrongArgumentCount signal
    ]

    valueWithArguments: argumentsArray [
	"Evaluate the receiver passing argArray's elements as the parameters"

	<category: 'built ins'>
	<primitive: VMpr_BlockClosure_valueWithArguments>
	argumentsArray isArray 
	    ifFalse: [SystemExceptions.WrongClass signalOn: argumentsArray mustBe: Array].
	SystemExceptions.WrongArgumentCount signal
    ]

    valueAndResumeOnUnwind [
	"Private - For use by #ensure:"

	<category: 'private'>
	<primitive: VMpr_BlockClosure_valueAndResumeOnUnwind>
	SystemExceptions.WrongArgumentCount signal
    ]
]