91 ^ true |
91 ^ true |
92 ! ! |
92 ! ! |
93 |
93 |
94 !Block class methodsFor:'instance creation'! |
94 !Block class methodsFor:'instance creation'! |
95 |
95 |
96 code:codeAddress byteCode:bCode nargs:numArgs sourcePosition:sourcePos initialPC:initialPC literals:literals |
96 code:codeAddress byteCode:bCode nargs:numArgs sourcePosition:sourcePos initialPC:initialPC literals:literals dynamic:dynamic |
97 "create a new cheap (homeless) block. |
97 "create a new cheap (homeless) block. |
98 Not for public use - special hook for the compiler." |
98 Not for public use - special hook for the compiler." |
99 |
99 |
100 |newBlock| |
100 |newBlock| |
101 |
101 |
102 newBlock := super basicNew. |
102 newBlock := super basicNew code:codeAddress |
103 newBlock code:codeAddress. |
103 byteCode:bCode |
104 newBlock byteCode:bCode. |
104 nargs:numArgs |
105 newBlock nargs:numArgs. |
105 sourcePosition:sourcePos |
106 newBlock sourcePosition:sourcePos. |
106 initialPC:initialPC |
107 newBlock initialPC:initialPC. |
107 literals:literals |
108 newBlock literals:literals. |
108 dynamic:dynamic. |
109 ^ newBlock |
109 ^ newBlock |
110 ! |
110 ! |
111 |
111 |
112 basicNew |
112 basicNew |
113 "catch creation of blocks - only the system creates blocks" |
113 "catch creation of blocks - only the system creates blocks" |
176 |
178 |
177 ^ selfValue |
179 ^ selfValue |
178 ! ! |
180 ! ! |
179 |
181 |
180 !Block methodsFor:'private accessing'! |
182 !Block methodsFor:'private accessing'! |
|
183 |
|
184 code:codeAddress byteCode:bCode nargs:numArgs sourcePosition:srcPos initialPC:iPC literals:lits dynamic:dynamic |
|
185 "set all relevant internals" |
|
186 |
|
187 self code:codeAddress. |
|
188 byteCode := bCode. |
|
189 nargs := numArgs. |
|
190 sourcePos := srcPos. |
|
191 initialPC := iPC. |
|
192 literals := lits. |
|
193 self dynamic:dynamic |
|
194 ! |
181 |
195 |
182 code:anAddress |
196 code:anAddress |
183 "set the code field - danger alert. |
197 "set the code field - danger alert. |
184 This is not an object but the address of the blocks machine instructions. |
198 This is not an object but the address of the blocks machine instructions. |
185 Therefore the argument must be an integer representing for this address. |
199 Therefore the argument must be an integer representing for this address. |
217 |
231 |
218 literals:aLiteralArray |
232 literals:aLiteralArray |
219 "set the literal array for evaluation - danger alert" |
233 "set the literal array for evaluation - danger alert" |
220 |
234 |
221 literals := aLiteralArray |
235 literals := aLiteralArray |
|
236 ! |
|
237 |
|
238 dynamic:aBoolean |
|
239 "set the flag bit stating that the machine code was created |
|
240 dynamically and should be flushed on image-restart" |
|
241 |
|
242 |newFlags| |
|
243 |
|
244 newFlags := flags. |
|
245 %{ |
|
246 /* made this a primitive to get define in stc.h */ |
|
247 if (aBoolean == true) |
|
248 newFlags = _MKSMALLINT(_intVal(newFlags) | F_DYNAMIC); |
|
249 else |
|
250 newFlags = _MKSMALLINT(_intVal(newFlags) & ~F_DYNAMIC); |
|
251 %} |
|
252 . |
|
253 flags := newFlags |
222 ! ! |
254 ! ! |
223 |
255 |
224 !Block methodsFor:'error handling'! |
256 !Block methodsFor:'error handling'! |
225 |
257 |
226 argumentCountError:numberGiven |
258 argumentCountError:numberGiven |
269 if (_INST(nargs) == _MKSMALLINT(0)) { |
301 if (_INST(nargs) == _MKSMALLINT(0)) { |
270 #if defined(THIS_CONTEXT) |
302 #if defined(THIS_CONTEXT) |
271 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
303 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
272 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
304 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
273 #endif |
305 #endif |
|
306 thecode = _BlockInstPtr(self)->b_code; |
|
307 #ifdef NEW_BLOCK_CALL |
|
308 if (thecode != (OBJFUNC)nil) { |
|
309 /* compiled machine code */ |
|
310 RETURN ( (*thecode)(self, COMMA_SND) ); |
|
311 } |
|
312 /* interpreted code */ |
|
313 RETURN ( interpret(self, 0, nil, nil COMMA_SND, nil) ); |
|
314 #else |
274 home = _BlockInstPtr(self)->b_home; |
315 home = _BlockInstPtr(self)->b_home; |
275 thecode = _BlockInstPtr(self)->b_code; |
|
276 if (thecode != (OBJFUNC)nil) { |
316 if (thecode != (OBJFUNC)nil) { |
277 /* compiled machine code */ |
317 /* compiled machine code */ |
278 RETURN ( (*thecode)(home COMMA_SND) ); |
318 RETURN ( (*thecode)(home COMMA_SND) ); |
279 } |
319 } |
280 /* interpreted code */ |
320 /* interpreted code */ |
281 RETURN ( interpret(self, 0, nil, home COMMA_SND, nil) ); |
321 RETURN ( interpret(self, 0, nil, home COMMA_SND, nil) ); |
|
322 #endif |
282 } |
323 } |
283 %} |
324 %} |
284 . |
325 . |
285 ^ self argumentCountError:0 |
326 ^ self argumentCountError:0 |
286 ! |
327 ! |
297 if (_INST(nargs) == _MKSMALLINT(1)) { |
338 if (_INST(nargs) == _MKSMALLINT(1)) { |
298 #if defined(THIS_CONTEXT) |
339 #if defined(THIS_CONTEXT) |
299 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
340 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
300 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
341 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
301 #endif |
342 #endif |
|
343 thecode = _BlockInstPtr(self)->b_code; |
|
344 #ifdef NEW_BLOCK_CALL |
|
345 if (thecode != (OBJFUNC)nil) { |
|
346 RETURN ( (*thecode)(self COMMA_SND, arg) ); |
|
347 } |
|
348 /* interpreted code */ |
|
349 RETURN ( interpret(self, 1, nil, nil COMMA_SND, nil, arg) ); |
|
350 #else |
302 home = _BlockInstPtr(self)->b_home; |
351 home = _BlockInstPtr(self)->b_home; |
303 thecode = _BlockInstPtr(self)->b_code; |
352 if (thecode != (OBJFUNC)nil) { |
304 if (thecode != (OBJFUNC)nil) { |
|
305 #ifdef PASS_ARG_REF |
|
306 RETURN ( (*thecode)(home COMMA_SND, &arg) ); |
|
307 #else |
|
308 RETURN ( (*thecode)(home COMMA_SND, arg) ); |
353 RETURN ( (*thecode)(home COMMA_SND, arg) ); |
309 #endif |
|
310 } |
354 } |
311 /* interpreted code */ |
355 /* interpreted code */ |
312 #ifdef PASS_ARG_REF |
|
313 RETURN ( interpret(self, 1, nil, home COMMA_SND, nil, &arg) ); |
|
314 #else |
|
315 RETURN ( interpret(self, 1, nil, home COMMA_SND, nil, arg) ); |
356 RETURN ( interpret(self, 1, nil, home COMMA_SND, nil, arg) ); |
316 #endif |
357 #endif |
317 } |
358 } |
318 %} |
359 %} |
319 . |
360 . |
332 if (_INST(nargs) == _MKSMALLINT(2)) { |
373 if (_INST(nargs) == _MKSMALLINT(2)) { |
333 #if defined(THIS_CONTEXT) |
374 #if defined(THIS_CONTEXT) |
334 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
375 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
335 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
376 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
336 #endif |
377 #endif |
|
378 thecode = _BlockInstPtr(self)->b_code; |
|
379 #ifdef NEW_BLOCK_CALL |
|
380 if (thecode != (OBJFUNC)nil) { |
|
381 RETURN ( (*thecode)(self COMMA_SND, arg1, arg2) ); |
|
382 } |
|
383 RETURN ( interpret(self, 2, nil, nil COMMA_SND, nil, arg1, arg2) ); |
|
384 #else |
337 home = _BlockInstPtr(self)->b_home; |
385 home = _BlockInstPtr(self)->b_home; |
338 thecode = _BlockInstPtr(self)->b_code; |
386 if (thecode != (OBJFUNC)nil) { |
339 if (thecode != (OBJFUNC)nil) { |
|
340 #ifdef PASS_ARG_REF |
|
341 RETURN ( (*thecode)(home COMMA_SND, &arg1) ); |
|
342 #else |
|
343 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2) ); |
387 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2) ); |
344 #endif |
388 } |
345 } |
|
346 #ifdef PASS_ARG_REF |
|
347 RETURN ( interpret(self, 2, nil, home COMMA_SND, nil, &arg1) ); |
|
348 #else |
|
349 RETURN ( interpret(self, 2, nil, home COMMA_SND, nil, arg1, arg2) ); |
389 RETURN ( interpret(self, 2, nil, home COMMA_SND, nil, arg1, arg2) ); |
350 #endif |
390 #endif |
351 } |
391 } |
352 %} |
392 %} |
353 . |
393 . |
366 if (_INST(nargs) == _MKSMALLINT(3)) { |
406 if (_INST(nargs) == _MKSMALLINT(3)) { |
367 #if defined(THIS_CONTEXT) |
407 #if defined(THIS_CONTEXT) |
368 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
408 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
369 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
409 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
370 #endif |
410 #endif |
|
411 thecode = _BlockInstPtr(self)->b_code; |
|
412 #ifdef NEW_BLOCK_CALL |
|
413 if (thecode != (OBJFUNC)nil) { |
|
414 RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3) ); |
|
415 } |
|
416 RETURN ( interpret(self, 3, nil, nil COMMA_SND, nil, arg1, arg2, arg3) ); |
|
417 #else |
371 home = _BlockInstPtr(self)->b_home; |
418 home = _BlockInstPtr(self)->b_home; |
372 thecode = _BlockInstPtr(self)->b_code; |
419 if (thecode != (OBJFUNC)nil) { |
373 if (thecode != (OBJFUNC)nil) { |
|
374 #ifdef PASS_ARG_REF |
|
375 RETURN ( (*thecode)(home COMMA_SND, &arg1) ); |
|
376 #else |
|
377 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3) ); |
420 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3) ); |
378 #endif |
421 } |
379 } |
|
380 #ifdef PASS_ARG_REF |
|
381 RETURN ( interpret(self, 3, nil, home COMMA_SND, nil, &arg1) ); |
|
382 #else |
|
383 RETURN ( interpret(self, 3, nil, home COMMA_SND, nil, arg1, arg2, arg3) ); |
422 RETURN ( interpret(self, 3, nil, home COMMA_SND, nil, arg1, arg2, arg3) ); |
384 #endif |
423 #endif |
385 } |
424 } |
386 %} |
425 %} |
387 . |
426 . |
400 if (_INST(nargs) == _MKSMALLINT(4)) { |
439 if (_INST(nargs) == _MKSMALLINT(4)) { |
401 #if defined(THIS_CONTEXT) |
440 #if defined(THIS_CONTEXT) |
402 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
441 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
403 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
442 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
404 #endif |
443 #endif |
|
444 thecode = _BlockInstPtr(self)->b_code; |
|
445 #ifdef NEW_BLOCK_CALL |
|
446 if (thecode != (OBJFUNC)nil) { |
|
447 RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3, arg4) ); |
|
448 } |
|
449 RETURN ( interpret(self, 4, nil, nil COMMA_SND, nil, arg1, arg2, arg3, arg4) ); |
|
450 #else |
405 home = _BlockInstPtr(self)->b_home; |
451 home = _BlockInstPtr(self)->b_home; |
406 thecode = _BlockInstPtr(self)->b_code; |
452 if (thecode != (OBJFUNC)nil) { |
407 if (thecode != (OBJFUNC)nil) { |
|
408 #ifdef PASS_ARG_REF |
|
409 RETURN ( (*thecode)(home COMMA_SND, &arg1) ); |
|
410 #else |
|
411 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4) ); |
453 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4) ); |
412 #endif |
454 } |
413 } |
|
414 #ifdef PASS_ARG_REF |
|
415 RETURN ( interpret(self, 4, nil, home COMMA_SND, nil, &arg1) ); |
|
416 #else |
|
417 RETURN ( interpret(self, 4, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4) ); |
455 RETURN ( interpret(self, 4, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4) ); |
418 #endif |
456 #endif |
419 } |
457 } |
420 %} |
458 %} |
421 . |
459 . |
434 if (_INST(nargs) == _MKSMALLINT(5)) { |
472 if (_INST(nargs) == _MKSMALLINT(5)) { |
435 #if defined(THIS_CONTEXT) |
473 #if defined(THIS_CONTEXT) |
436 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
474 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
437 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
475 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
438 #endif |
476 #endif |
|
477 thecode = _BlockInstPtr(self)->b_code; |
|
478 #ifdef NEW_BLOCK_CALL |
|
479 if (thecode != (OBJFUNC)nil) { |
|
480 RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3, arg4, arg5) ); |
|
481 } |
|
482 RETURN ( interpret(self, 5, nil, nil COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5) ); |
|
483 #else |
439 home = _BlockInstPtr(self)->b_home; |
484 home = _BlockInstPtr(self)->b_home; |
440 thecode = _BlockInstPtr(self)->b_code; |
485 if (thecode != (OBJFUNC)nil) { |
441 if (thecode != (OBJFUNC)nil) { |
|
442 #ifdef PASS_ARG_REF |
|
443 RETURN ( (*thecode)(home COMMA_SND, &arg1) ); |
|
444 #else |
|
445 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5) ); |
486 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5) ); |
446 #endif |
487 } |
447 } |
|
448 #ifdef PASS_ARG_REF |
|
449 RETURN ( interpret(self, 5, nil, home COMMA_SND, nil, &arg1) ); |
|
450 #else |
|
451 RETURN ( interpret(self, 5, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5) ); |
488 RETURN ( interpret(self, 5, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5) ); |
452 #endif |
489 #endif |
453 } |
490 } |
454 %} |
491 %} |
455 . |
492 . |
468 if (_INST(nargs) == _MKSMALLINT(6)) { |
505 if (_INST(nargs) == _MKSMALLINT(6)) { |
469 #if defined(THIS_CONTEXT) |
506 #if defined(THIS_CONTEXT) |
470 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
507 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
471 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
508 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
472 #endif |
509 #endif |
|
510 thecode = _BlockInstPtr(self)->b_code; |
|
511 #ifdef NEW_BLOCK_CALL |
|
512 if (thecode != (OBJFUNC)nil) { |
|
513 RETURN ( (*thecode)(self COMMA_SND, arg1, arg2, arg3, arg4, arg5, arg6) ); |
|
514 } |
|
515 RETURN ( interpret(self, 6, nil, nil COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5, arg6) ); |
|
516 #else |
473 home = _BlockInstPtr(self)->b_home; |
517 home = _BlockInstPtr(self)->b_home; |
474 thecode = _BlockInstPtr(self)->b_code; |
518 if (thecode != (OBJFUNC)nil) { |
475 if (thecode != (OBJFUNC)nil) { |
|
476 #ifdef PASS_ARG_REF |
|
477 RETURN ( (*thecode)(home COMMA_SND, &arg1) ); |
|
478 #else |
|
479 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5, arg6) ); |
519 RETURN ( (*thecode)(home COMMA_SND, arg1, arg2, arg3, arg4, arg5, arg6) ); |
480 #endif |
520 } |
481 } |
|
482 #ifdef PASS_ARG_REF |
|
483 RETURN ( interpret(self, 6, nil, home COMMA_SND, nil, &arg1) ); |
|
484 #else |
|
485 RETURN ( interpret(self, 6, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5, arg6) ); |
521 RETURN ( interpret(self, 6, nil, home COMMA_SND, nil, arg1, arg2, arg3, arg4, arg5, arg6) ); |
486 #endif |
522 #endif |
487 } |
523 } |
488 %} |
524 %} |
489 . |
525 . |
511 #if defined(THIS_CONTEXT) |
547 #if defined(THIS_CONTEXT) |
512 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
548 if (1 /* _intVal(__pilc->ilc_lineNo) > 0 */) |
513 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
549 _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo; |
514 #endif |
550 #endif |
515 switch (_intVal(_INST(nargs))) { |
551 switch (_intVal(_INST(nargs))) { |
|
552 default: |
|
553 goto error; |
516 case 7: |
554 case 7: |
517 a7 = _ArrayInstPtr(argArray)->a_element[6]; |
555 a7 = _ArrayInstPtr(argArray)->a_element[6]; |
518 case 6: |
556 case 6: |
519 a6 = _ArrayInstPtr(argArray)->a_element[5]; |
557 a6 = _ArrayInstPtr(argArray)->a_element[5]; |
520 case 5: |
558 case 5: |
528 case 1: |
566 case 1: |
529 a1 = _ArrayInstPtr(argArray)->a_element[0]; |
567 a1 = _ArrayInstPtr(argArray)->a_element[0]; |
530 case 0: |
568 case 0: |
531 break; |
569 break; |
532 } |
570 } |
|
571 thecode = _BlockInstPtr(self)->b_code; |
|
572 #ifdef NEW_BLOCK_CALL |
|
573 if (thecode != (OBJFUNC)nil) { |
|
574 RETURN ( (*thecode)(self COMMA_SND, a1, a2, a3, a4, a5, a6, a7) ); |
|
575 } |
|
576 RETURN ( interpret(self, _intVal(_INST(nargs)), nil, |
|
577 nil COMMA_SND, nil, a1, a2, a3, a4, a5, a6, a7) ); |
|
578 #else |
533 home = _BlockInstPtr(self)->b_home; |
579 home = _BlockInstPtr(self)->b_home; |
534 thecode = _BlockInstPtr(self)->b_code; |
|
535 if (thecode != (OBJFUNC)nil) { |
580 if (thecode != (OBJFUNC)nil) { |
536 #ifdef PASS_ARG_REF |
|
537 RETURN ( (*thecode)(home COMMA_SND, &a1) ); |
|
538 #else |
|
539 RETURN ( (*thecode)(home COMMA_SND, a1, a2, a3, a4, a5, a6, a7) ); |
581 RETURN ( (*thecode)(home COMMA_SND, a1, a2, a3, a4, a5, a6, a7) ); |
540 #endif |
582 } |
541 } |
|
542 #ifdef PASS_ARG_REF |
|
543 RETURN ( interpret(self, _intVal(_INST(nargs)), nil, |
|
544 home COMMA_SND, nil, &a1) ); |
|
545 #else |
|
546 RETURN ( interpret(self, _intVal(_INST(nargs)), nil, |
583 RETURN ( interpret(self, _intVal(_INST(nargs)), nil, |
547 home COMMA_SND, nil, a1, a2, a3, a4, a5, a6, a7) ); |
584 home COMMA_SND, nil, a1, a2, a3, a4, a5, a6, a7) ); |
548 #endif |
585 #endif |
549 %} |
586 error: ; |
|
587 %} |
|
588 . |
|
589 self error:'only blocks with up-to 7 arguments supported' |
550 ! |
590 ! |
551 |
591 |
552 valueNowOrOnUnwindDo:aBlock |
592 valueNowOrOnUnwindDo:aBlock |
553 "evaluate the receiver - after that, or when some method sent within unwinds (i.e. does |
593 "evaluate the receiver - after that, or when some method sent within unwinds (i.e. does |
554 a long return), evaluate the argument, aBlock. |
594 a long return), evaluate the argument, aBlock. |