509 when the debugged method was changed). |
509 when the debugged method was changed). |
510 This has been changed - especially to support Jan's meta-object protocol. |
510 This has been changed - especially to support Jan's meta-object protocol. |
511 It is now stored in the context" |
511 It is now stored in the context" |
512 |
512 |
513 |c sender sendersSelector m| |
513 |c sender sendersSelector m| |
514 "/. |
514 |
515 method notNil ifTrue:[ |
515 (method notNil and:[method isMethod]) ifTrue:[ |
516 method isMethod ifTrue:[ |
|
517 true "method wrapper isNil" ifTrue:[ |
|
518 ^ method |
|
519 ] |
|
520 ] |
|
521 ]. |
|
522 "/ |
|
523 |
|
524 c := self searchClass. |
|
525 " |
|
526 the below cannot happen in normal circumstances |
|
527 (added to avoid recursive errors in case of a broken sender chain) |
|
528 " |
|
529 c isBehavior ifFalse:[ |
|
530 'Context [error]: non class in searchClass' errorPrintCR. |
|
531 ' selector: ' errorPrint. selector errorPrint. |
|
532 ' receiver: ' errorPrint. receiver errorPrintCR. |
|
533 ^ nil |
|
534 ]. |
|
535 |
|
536 c := c whichClassIncludesSelector:selector. |
|
537 c notNil ifTrue:[ |
|
538 method := c compiledMethodAt:selector. |
|
539 ^ method |
516 ^ method |
540 ]. |
517 ]. |
541 |
518 |
542 "mhmh - seems to be a context for an unbound method (as generated by doIt); |
519 "mhmh - maybe I am a context for an unbound method (as generated by doIt); |
543 look in the senders context. Consider this a kludge. |
520 look in the sender's context. Consider this a kludge. |
544 (maybe it was not too good of an idea to NOT keep the current |
|
545 method in the context ...) |
|
546 Future versions of ST/X's message lookup may store the method in |
521 Future versions of ST/X's message lookup may store the method in |
547 the context. |
522 the context. |
548 " |
523 " |
549 sender := self sender. |
524 sender := self sender. |
550 sender notNil ifTrue:[ |
525 sender notNil ifTrue:[ |
558 ] |
533 ] |
559 ] |
534 ] |
560 ] |
535 ] |
561 ]. |
536 ]. |
562 |
537 |
|
538 c := self searchClass. |
|
539 " |
|
540 the below cannot happen in normal circumstances |
|
541 (added to avoid recursive errors in case of a broken sender chain) |
|
542 " |
|
543 c isBehavior ifFalse:[ |
|
544 'Context [error]: non class in searchClass' errorPrintCR. |
|
545 ' selector: ' errorPrint. selector errorPrint. |
|
546 ' receiver: ' errorPrint. receiver errorPrintCR. |
|
547 ^ nil |
|
548 ]. |
|
549 |
|
550 c := c whichClassIncludesSelector:selector. |
|
551 c notNil ifTrue:[ |
|
552 method := c compiledMethodAt:selector. |
|
553 ^ method |
|
554 ]. |
|
555 |
563 ^ nil |
556 ^ nil |
564 |
557 |
565 "Modified: / 28-06-2011 / 20:23:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
558 "Modified: / 28-06-2011 / 20:23:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
566 "Modified: / 31-05-2012 / 11:54:34 / cg" |
559 "Modified: / 20-07-2012 / 14:46:37 / cg" |
567 ! |
560 ! |
568 |
561 |
569 methodClass |
562 methodClass |
570 "return the class in which the method for which the receiver was created is." |
563 "return the class in which the method for which the receiver was created is." |
571 |
564 |
1685 aStream bold. |
1678 aStream bold. |
1686 self selector printOn:aStream. "show as string (as symbol looks too ugly in browser ...)" |
1679 self selector printOn:aStream. "show as string (as symbol looks too ugly in browser ...)" |
1687 "/ self selector storeOn:aStream. "show as symbol" |
1680 "/ self selector storeOn:aStream. "show as symbol" |
1688 aStream normal. |
1681 aStream normal. |
1689 aStream space. |
1682 aStream space. |
|
1683 (method notNil and:[method isWrapped]) ifTrue:[ |
|
1684 aStream nextPutAll:'W ' |
|
1685 ]. |
1690 aStream nextPutAll:' ['; nextPutAll:self lineNumber printString; nextPutAll:']' . |
1686 aStream nextPutAll:' ['; nextPutAll:self lineNumber printString; nextPutAll:']' . |
1691 |
1687 |
1692 "Modified: / 21-05-2007 / 13:29:21 / cg" |
1688 "Modified: / 20-07-2012 / 14:33:13 / cg" |
1693 ! |
1689 ! |
1694 |
1690 |
1695 receiverPrintString |
1691 receiverPrintString |
1696 "return a string describing the receiver of the context" |
1692 "return a string describing the receiver of the context" |
1697 |
1693 |
1712 "/ ] ifFalse:[ |
1708 "/ ] ifFalse:[ |
1713 "/ receiverClassName := receiverClass name. |
1709 "/ receiverClassName := receiverClass name. |
1714 "/ ]. |
1710 "/ ]. |
1715 receiverClassName := receiverClass name. |
1711 receiverClassName := receiverClass name. |
1716 ]. |
1712 ]. |
|
1713 receiverClassName := receiverClassName ? '???'. |
|
1714 |
1717 (receiverClass == SmallInteger |
1715 (receiverClass == SmallInteger |
1718 or:[receiverClass == Float]) ifTrue:[ |
1716 or:[receiverClass == Float]) ifTrue:[ |
1719 newString := '(' , receiver printString , ') ' , receiverClassName |
1717 newString := '(' , receiver printString , ') ' , receiverClassName |
1720 ] ifFalse:[ |
1718 ] ifFalse:[ |
1721 newString := receiverClassName |
1719 newString := receiverClassName |
1732 ]. |
1730 ]. |
1733 |
1731 |
1734 implementorClass notNil ifTrue: [ |
1732 implementorClass notNil ifTrue: [ |
1735 (implementorClass ~~ receiverClass) ifTrue: [ |
1733 (implementorClass ~~ receiverClass) ifTrue: [ |
1736 "/ newString := newString , '>>>', implementorClass name printString |
1734 "/ newString := newString , '>>>', implementorClass name printString |
1737 newString := newString,'(',implementorClass name printString,')' |
1735 newString := newString,'(',(implementorClass name ? '???') printString,')' |
1738 ] |
1736 ] |
1739 ] ifFalse:[ |
1737 ] ifFalse:[ |
1740 self searchClass ~~ receiverClass ifTrue:[ |
1738 self searchClass ~~ receiverClass ifTrue:[ |
1741 "/ newString := newString , '>>>' , self searchClass name |
1739 "/ newString := newString , '>>>' , self searchClass name |
1742 newString := newString,'(',self searchClass name,')' |
1740 newString := newString,'(',(self searchClass name ? '???'),')' |
1743 ]. |
1741 ]. |
1744 " |
1742 " |
1745 kludge for doIt - these unbound methods are not |
1743 kludge for doIt - these unbound methods are not |
1746 found in the classes methodDictionary |
1744 found in the classes methodDictionary |
1747 " |
1745 " |
1752 ] |
1750 ] |
1753 ]. |
1751 ]. |
1754 |
1752 |
1755 ^ newString |
1753 ^ newString |
1756 |
1754 |
1757 "Modified: / 24-07-2011 / 08:53:41 / cg" |
1755 "Modified: / 13-06-2012 / 14:49:33 / cg" |
1758 ! |
1756 ! |
1759 |
1757 |
1760 saveReceiverClassName |
1758 saveReceiverClassName |
1761 "return the receivers class-name string or nil, if the receiver is invalid. |
1759 "return the receivers class-name string or nil, if the receiver is invalid. |
1762 This cares for invalid (free) objects which may appear with bad primitive code, |
1760 This cares for invalid (free) objects which may appear with bad primitive code, |
2380 "return true, iff the receiver is a BlockContext, false otherwise" |
2378 "return true, iff the receiver is a BlockContext, false otherwise" |
2381 |
2379 |
2382 ^ false |
2380 ^ false |
2383 ! |
2381 ! |
2384 |
2382 |
|
2383 isCheapBlockContext |
|
2384 "return true, iff the receiver is a BlockContext, for a cheap block, false otherwise. |
|
2385 Cheap blocks do not refer to their home" |
|
2386 |
|
2387 ^ false |
|
2388 |
|
2389 "Created: / 19-07-2012 / 11:22:38 / cg" |
|
2390 ! |
|
2391 |
2385 isContext |
2392 isContext |
2386 "return true, iff the receiver is a Context, false otherwise" |
2393 "return true, iff the receiver is a Context, false otherwise" |
2387 |
2394 |
2388 ^ true |
2395 ^ true |
2389 ! |
2396 ! |