--- a/Context.st Wed Apr 01 10:20:10 2015 +0100
+++ b/Context.st Wed Apr 08 12:23:25 2015 +0200
@@ -252,6 +252,7 @@
|c|
%{
+#ifndef __JAVA__
OBJ __c__;
__c__ = __ContextInstPtr(__thisContext)->c_sender;
@@ -262,6 +263,7 @@
__PATCHUPCONTEXT(__c__);
}
c = __c__;
+#endif
%}.
^ c findSpecialHandle:searchForHandle raise:searchForRaise
! !
@@ -343,8 +345,11 @@
"ANSI alias for numArgs: return the number of arguments to the Block/Method"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ return context.RETURN( self.numArgs() );
+#else
RETURN ( __mkSmallInteger( (__intVal(__INST(flags)) >> __NARG_SHIFT) & __NARG_MASK) );
+#endif
%}
!
@@ -355,7 +360,10 @@
"/ some machines have the arguments/receiver etc. kept in register vars ...
"/ the unfix updates the machine-stack version of the receiver.
%{
+#ifdef __JAVA__
+#else
__UNFIXCONTEXT(self, 0);
+#endif
%}.
^ value
!
@@ -382,9 +390,21 @@
Notice, that one of the next ST/X versions might get some syntactic
extension to get this automatically)."
- (index == %{ __MKSMALLINT(__SLOT_CONTEXT_SENDER) %} ) ifTrue:[^ self sender]."/ sender - must be accessed specially
- (index == %{ __MKSMALLINT(__SLOT_CONTEXT_RETVAL) %} ) ifTrue:[^ nil]. "/ retvalTemp - invisible
- (index == %{ __MKSMALLINT(__SLOT_CONTEXT_HANDLE) %} ) ifTrue:[^ nil]. "/ handle to machine stack - invisible
+ |what|
+
+%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
+ if (index == __MKSMALLINT(__SLOT_CONTEXT_SENDER)) { // sender - must be accessed specially
+ what = @symbol(sender);
+ } else if (index == __MKSMALLINT(__SLOT_CONTEXT_RETVAL)) { // retvalTemp - invisible
+ RETURN (nil);
+ } else if (index == __MKSMALLINT(__SLOT_CONTEXT_HANDLE)) { // handle to machine stack - invisible
+ RETURN (nil);
+ }
+#endif
+%}.
^ super instVarAt:index
!
@@ -393,16 +413,28 @@
Notice, that one of the next ST/X versions might get some syntactic
extension to get this automatically)."
- (index == %{ __MKSMALLINT(__SLOT_CONTEXT_SENDER) %} ) ifTrue:[^ nil]. "/ sender - not allowed to change
- (index == %{ __MKSMALLINT(__SLOT_CONTEXT_RETVAL) %} ) ifTrue:[^ nil]. "/ retvalTemp - not allowed to change
- (index == %{ __MKSMALLINT(__SLOT_CONTEXT_HANDLE) %} ) ifTrue:[^ nil]. "/ handle to machine stack - not allowed to change
+%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
+ if (index == __MKSMALLINT(__SLOT_CONTEXT_SENDER)) { // sender - not allowed to change
+ RETURN (nil);
+ } else if (index == __MKSMALLINT(__SLOT_CONTEXT_RETVAL)) { // retvalTemp - not allowed to change
+ RETURN (nil);
+ } else if (index == __MKSMALLINT(__SLOT_CONTEXT_HANDLE)) { // handle to machine stack - not allowed to change
+ RETURN (nil);
+ }
+#endif
+%}.
super instVarAt:index put:value.
"/ need some aid for optimized code -
"/ some machines have the arguments kept in register vars ...
"/ the unfix updates the machine-stack version of the receiver.
%{
+#ifdef __JAVA__
__UNFIXCONTEXT(self, 0);
+#endif
%}.
^ value
!
@@ -624,8 +656,11 @@
"return the number of arguments to the Block/Method"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( __mkSmallInteger( (__intVal(__INST(flags)) >> __NARG_SHIFT) & __NARG_MASK) );
+#endif
%}
!
@@ -643,8 +678,11 @@
"return the number of local variables of the Block/Method"
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( __mkSmallInteger( (__intVal(__INST(flags)) >> __NVAR_SHIFT) & __NVAR_MASK) );
+#endif
%}
!
@@ -682,7 +720,11 @@
"/ some machines have the arguments kept in register vars ...
"/ the unfix updates the machine-stack version of the receiver.
%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
__UNFIXCONTEXT(self, 0);
+#endif
%}.
!
@@ -707,6 +749,9 @@
"return the sender of the context"
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
OBJ theContext;
theContext = __INST(sender_);
@@ -734,6 +779,7 @@
}
}
RETURN (theContext);
+#endif
%}
!
@@ -746,10 +792,14 @@
invalid until needed."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
if ( __INST(sender_) == nil ) {
RETURN (true);
}
RETURN (false);
+#endif
%}.
!
@@ -763,6 +813,9 @@
"set the number of arguments and variables"
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
INT flg;
flg = __intVal(__INST(flags));
@@ -771,6 +824,7 @@
flg = flg | __intVal(nA) << __NARG_SHIFT;
flg = flg | __intVal(nV) << __NVAR_SHIFT;
__INST(flags) = __mkSmallInteger(flg);
+#endif
%}
!
@@ -927,8 +981,12 @@
fixAllLineNumbers
%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
__PATCHUPCONTEXTS(__thisContext);
__CONTEXTLINENOS(self);
+#endif
%}
! !
@@ -940,7 +998,7 @@
self receiverPrintString print. ' ' errorPrint. selector errorPrint.
self size ~~ 0 ifTrue: [
- ' ' errorPrint. self argsDisplayString errorPrint
+ ' ' errorPrint. self argsDisplayString errorPrint
].
' [' errorPrint. self lineNumber errorPrint. ']' errorPrintCR
@@ -1006,14 +1064,14 @@
context := self.
'--------------------------' errorPrintCR.
[context notNil] whileTrue: [
- context errorPrintCR.
- context := context sender.
- nOrNil notNil ifTrue:[
- (count := count+1) > nOrNil ifTrue:[
- '--------------------------' errorPrintCR.
- ^ self
- ].
- ]
+ context errorPrintCR.
+ context := context sender.
+ nOrNil notNil ifTrue:[
+ (count := count+1) > nOrNil ifTrue:[
+ '--------------------------' errorPrintCR.
+ ^ self
+ ].
+ ]
].
'--------------------------' errorPrintCR.
@@ -1084,11 +1142,15 @@
If such a context is restarted, a runtime error is raised."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
if (__INST(sender_) == nil) {
RETURN(nil);
} else {
__RESUMECONTEXT__(self, RESTART_VALUE, 0);
}
+#endif
%}.
"
@@ -1140,6 +1202,9 @@
"
%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
OBJ sndr;
theContext = __thisContext;
@@ -1153,6 +1218,7 @@
__PATCHUPCONTEXT(theContext);
}
}
+#endif
%}.
theContext isNil ifTrue:[
@@ -1187,6 +1253,9 @@
"
%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
OBJ theContext, sndr;
theContext = __thisContext;
@@ -1202,6 +1271,7 @@
}
}
}
+#endif
%}.
"/ no error reporting
@@ -1229,6 +1299,9 @@
"
%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
OBJ theContext, sndr;
theContext = __thisContext;
@@ -1242,6 +1315,7 @@
__RESUMECONTEXT__(theContext, value, 0);
}
}
+#endif
%}.
"/ no error reporting
@@ -1279,11 +1353,15 @@
If such a context is restarted, a runtime error is raised."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
if (__INST(sender_) == nil) {
RETURN(nil);
} else {
__RESUMECONTEXT__(self, value, 0);
}
+#endif
%}.
"
@@ -1310,11 +1388,15 @@
If such a context is restarted, a runtime error is raised."
%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
if (__INST(sender_) == nil) {
RETURN(nil);
} else {
__RESUMECONTEXT__(self, aBlock, 2);
}
+#endif
%}.
"
@@ -1569,6 +1651,9 @@
argStringFor:someObject
|s|
%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
/*
* special handling for (invalid) free objects.
* these only appear if some primitiveCode does not correctly use SEND macros,
@@ -1578,6 +1663,7 @@
if (__isNonNilObject(someObject) && (__qClass(someObject)==nil)) {
s = __MKSTRING("FreeObject");
}
+#endif
%}.
s isNil ifTrue:[
s := someObject displayString.
@@ -1608,15 +1694,15 @@
n := self numArgs.
1 to:n do:[:index |
- Error handle:[:ex |
- s := '*Error in argString*'.
- ] do:[
- s := self argStringFor:(self at:index).
- s := s contractTo:100.
- ].
-
- aStream nextPutAll:s asString string.
- index ~~ n ifTrue:[ aStream space ].
+ Error handle:[:ex |
+ s := '*Error in argString*'.
+ ] do:[
+ s := self argStringFor:(self at:index).
+ s := s contractTo:100.
+ ].
+
+ aStream nextPutAll:s asString string.
+ index ~~ n ifTrue:[ aStream space ].
].
"Modified: / 07-03-2012 / 13:09:17 / cg"
@@ -1759,7 +1845,7 @@
(nonMeta := aClass theNonMetaclass) isJavaClass ifTrue:[
nonMeta javaName printOn: aStream
] ifFalse:[
- (aClass name ? '????') printOn:aStream.
+ (aClass name ? '????') printOn:aStream.
].
"Modified: / 08-08-2014 / 09:39:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1776,28 +1862,28 @@
aStream bold.
m := self method.
- m isJavaMethod ifTrue:[
- aStream nextPutAll: (m printStringForBrowserWithSelector: self selector).
+ m isJavaMethod ifTrue:[
+ aStream nextPutAll: (m printStringForBrowserWithSelector: self selector).
] ifFalse:[
- self selector printOn:aStream. "show as string (as symbol looks too ugly in browser ...)"
- "/ self selector storeOn:aStream. "show as symbol"
+ self selector printOn:aStream. "show as string (as symbol looks too ugly in browser ...)"
+ "/ self selector storeOn:aStream. "show as symbol"
].
aStream normal.
(method notNil and:[method isWrapped]) ifTrue:[
- aStream nextPutAll:' (wrapped) '
+ aStream nextPutAll:' (wrapped) '
].
aStream nextPutAll:' ['.
- m isJavaMethod ifTrue:[
- aStream nextPutAll: self method mclass sourceFile ? '???' .
- m isNative ifTrue:[
- aStream nextPutAll: ':in native code'
- ] ifFalse:[
- aStream nextPut: $:.
- (m lineNumberForPC0: lineNr) ? '???' printOn: aStream.
- ].
+ m isJavaMethod ifTrue:[
+ aStream nextPutAll: self method mclass sourceFile ? '???' .
+ m isNative ifTrue:[
+ aStream nextPutAll: ':in native code'
+ ] ifFalse:[
+ aStream nextPut: $:.
+ (m lineNumberForPC0: lineNr) ? '???' printOn: aStream.
+ ].
] ifFalse:[
- self lineNumber printOn: aStream
+ self lineNumber printOn: aStream
].
aStream nextPut:$].
@@ -1812,79 +1898,79 @@
receiverClassName := self safeReceiverClassName.
receiverClassName notNil ifTrue:[
- "if we come here, this is a context with an illegal class"
- receiverClassName printOn:aStream.
- ^ self.
+ "if we come here, this is a context with an illegal class"
+ receiverClassName printOn:aStream.
+ ^ self.
].
receiverClass := receiver class.
(receiverClass == SmallInteger or:[receiverClass == Float]) ifTrue:[
- aStream nextPut:$(. receiver printOn:aStream. aStream nextPutAll:') '.
+ aStream nextPut:$(. receiver printOn:aStream. aStream nextPutAll:') '.
].
self printClassNameOf:receiverClass on:aStream.
(selector notNil or:[method notNil]) ifTrue:[
- "/ implementorClass := self searchClass whichClassIncludesSelector:selector.
-
- "
- kludge to avoid slow search for containing class
- "
- (method notNil
- or:[selector ~~ #doIt and:[selector ~~ #doIt:]]) ifTrue:[
- implementorClass := self methodClass.
- implementorClass isNil ifTrue:[
- "
- kludge for the frame called by a wrappedmethod;
- the wrappedmethod is in the class, so its mclass is correct.
- however, the originalmethod is invoked via performMethod, and its mclass
- is nil. Care for this here. Think about keeping the mclass in the original method.
- "
- (method notNil and:[method isWrapped not]) ifTrue:[
- WrappedMethod notNil ifTrue:[
- WrappedMethod allWrappedMethodsDo:[:wrapped |
- wrapped originalMethodIfWrapped == method ifTrue:[
- implementorClass := wrapped mclass.
- ].
- ].
- ].
- ]
- ].
- ].
-
- implementorClass notNil ifTrue: [
- (implementorClass ~~ receiverClass) ifTrue: [
- aStream nextPut:$(.
- self printClassNameOf:implementorClass on:aStream.
- aStream nextPut:$).
- ]
- ] ifFalse:[
- | srchClass where |
-
- srchClass := self searchClass.
- srchClass ~~ receiverClass ifTrue:[
- aStream nextPut:$(.
- self printClassNameOf:srchClass on:aStream.
- aStream nextPut:$).
- ].
- "
- kludge for doIt - these unbound methods are not
- found in the classes methodDictionary
- "
- true "(selector ~~ #doIt and:[selector ~~ #doIt:])" ifTrue:[
- "
- kludge for methods invoked explicitly via valueWithReceiver...
- "
- (self sender notNil
- and:[ self sender receiver isMethod
- and:[ self sender selector startsWith:'valueWithReceiver:' ]]) ifTrue:[
- where := '(**DIRECTED**)'.
- ] ifFalse:[
- where := '(**NONE**)'.
- ].
- aStream nextPutAll:where
- ]
- ]
+ "/ implementorClass := self searchClass whichClassIncludesSelector:selector.
+
+ "
+ kludge to avoid slow search for containing class
+ "
+ (method notNil
+ or:[selector ~~ #doIt and:[selector ~~ #doIt:]]) ifTrue:[
+ implementorClass := self methodClass.
+ implementorClass isNil ifTrue:[
+ "
+ kludge for the frame called by a wrappedmethod;
+ the wrappedmethod is in the class, so its mclass is correct.
+ however, the originalmethod is invoked via performMethod, and its mclass
+ is nil. Care for this here. Think about keeping the mclass in the original method.
+ "
+ (method notNil and:[method isWrapped not]) ifTrue:[
+ WrappedMethod notNil ifTrue:[
+ WrappedMethod allWrappedMethodsDo:[:wrapped |
+ wrapped originalMethodIfWrapped == method ifTrue:[
+ implementorClass := wrapped mclass.
+ ].
+ ].
+ ].
+ ]
+ ].
+ ].
+
+ implementorClass notNil ifTrue: [
+ (implementorClass ~~ receiverClass) ifTrue: [
+ aStream nextPut:$(.
+ self printClassNameOf:implementorClass on:aStream.
+ aStream nextPut:$).
+ ]
+ ] ifFalse:[
+ | srchClass where |
+
+ srchClass := self searchClass.
+ srchClass ~~ receiverClass ifTrue:[
+ aStream nextPut:$(.
+ self printClassNameOf:srchClass on:aStream.
+ aStream nextPut:$).
+ ].
+ "
+ kludge for doIt - these unbound methods are not
+ found in the classes methodDictionary
+ "
+ true "(selector ~~ #doIt and:[selector ~~ #doIt:])" ifTrue:[
+ "
+ kludge for methods invoked explicitly via valueWithReceiver...
+ "
+ (self sender notNil
+ and:[ self sender receiver isMethod
+ and:[ self sender selector startsWith:'valueWithReceiver:' ]]) ifTrue:[
+ where := '(**DIRECTED**)'.
+ ] ifFalse:[
+ where := '(**NONE**)'.
+ ].
+ aStream nextPutAll:where
+ ]
+ ]
].
"Created: / 23-10-2013 / 11:13:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1913,6 +1999,9 @@
|receiverClassName|
%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
/*
* special handling for (invalid) free objects.
* these only appear if some primitiveCode does not correctly use SEND macros,
@@ -1921,6 +2010,7 @@
if (__isNonNilObject(__INST(receiver)) && (__qClass(__INST(receiver))==nil)) {
receiverClassName = __MKSTRING("FreeObject");
}
+#endif
%}.
^ receiverClassName
@@ -1935,7 +2025,11 @@
this context - a highly internal mechanism and not for public use."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__UNWIND_MARK)) ? true : false );
+#endif
%}
"
thisContext isMarkedForUnwind
@@ -1948,7 +2042,11 @@
this context - a highly internal mechanism and not for public use."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
__INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__HANDLE_MARK));
+#endif
%}
"Modified: 13.12.1995 / 19:05:22 / cg"
@@ -1960,7 +2058,11 @@
this context upon return - a highly internal mechanism and not for public use."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
__markInterrupted(__ContextInstPtr(self));
+#endif
%}
!
@@ -1971,7 +2073,11 @@
- a highly internal mechanism and not for public use."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
__INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__IRQ_ON_UNWIND));
+#endif
%}
!
@@ -1981,7 +2087,11 @@
this context - a highly internal mechanism and not for public use."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
__INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__RAISE_MARK));
+#endif
%}
"Modified: 13.12.1995 / 19:05:22 / cg"
@@ -1993,7 +2103,11 @@
this context - a highly internal mechanism and not for public use."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
__INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__UNWIND_MARK));
+#endif
%}
"Modified: 13.12.1995 / 19:05:22 / cg"
@@ -2011,7 +2125,11 @@
DANGER: this is for experimental, internal use only (byteCode interpreters)"
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
__INST(sender_) = aContext;
+#endif
%}
!
@@ -2021,7 +2139,11 @@
this context - a highly internal mechanism and not for public use."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
__INST(flags) = (OBJ)((INT)__INST(flags) & ~__MASKSMALLINT(__UNWIND_MARK));
+#endif
%}
! !
@@ -2050,7 +2172,9 @@
"/ although they aren't really - this is expert knowledge, no need to understand that ...)
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
OBJ theContext;
theContext = self;
@@ -2068,14 +2192,15 @@
* We'll see, if this is really required.
*/
theContext->o_space |= CATCHMARK;
-#if 0
+# if 0
__markNonLIFO(theContext);
-#endif
+# endif
}
RETURN (theContext);
}
theContext = __ContextInstPtr(theContext)->c_sender;
}
+#endif
%}.
^ nil
!
@@ -2102,7 +2227,9 @@
"/ although they aren't really - this is expert knowledge, no need to understand that ...)
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
OBJ theContext;
OBJ sel;
OBJ __FETCHSELECTOR();
@@ -2110,13 +2237,13 @@
theContext = __INST(sender_);
while (__isNonNilObject(theContext)) {
if (__isLazy(theContext)) {
-#ifdef TRADITIONAL_STACK_FRAME
+# ifdef TRADITIONAL_STACK_FRAME
sel = __FETCHSELECTOR(theContext);
-#else
+# else
/* mhmh - not really needed */
__PATCHUPCONTEXT(theContext);
sel = __ContextInstPtr(theContext)->c_selector;
-#endif
+# endif
} else {
sel = __ContextInstPtr(theContext)->c_selector;
}
@@ -2143,6 +2270,7 @@
theContext = __ContextInstPtr(theContext)->c_sender;
}
RETURN (nil);
+#endif
%}.
"
|con sel|
@@ -2179,7 +2307,9 @@
"/ although they aren't really - this is expert knowledge, no need to understand that ...)
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
OBJ theContext;
if (self == aContext) {
@@ -2201,14 +2331,15 @@
* We'll see, if this is really required.
*/
theContext->o_space |= CATCHMARK;
-#if 0
+# if 0
__markNonLIFO(theContext);
-#endif
+# endif
}
RETURN (theContext);
}
theContext = __ContextInstPtr(theContext)->c_sender;
}
+#endif
%}.
^ nil
!
@@ -2236,7 +2367,9 @@
"/ although they aren't really - this is expert knowledge, no need to understand that ...)
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
OBJ theContext;
int flagMask = 0;
INT mask;
@@ -2262,14 +2395,15 @@
* We'll see, if this is really required.
*/
theContext->o_space |= CATCHMARK;
-#if 0
+# if 0
__markNonLIFO(theContext);
-#endif
+# endif
}
RETURN (theContext);
}
theContext = __ContextInstPtr(theContext)->c_sender;
}
+#endif
%}.
^ nil
! !
@@ -2288,105 +2422,105 @@
homeContext := self methodHome.
homeContext notNil ifTrue:[
- sel := homeContext selector.
- homeMethod := homeContext method.
+ sel := homeContext selector.
+ homeMethod := homeContext method.
].
extractFromBlock :=
- [
- |blockNode argNames varNames vars args blocksHome|
-
- blockNode := Compiler
- blockAtLine:blocksLineNr
- in:m
- orSource:src
- numArgs:numArgs
- numVars:numVars.
-
- blockNode notNil ifTrue:[
- "/ a kludge
- blockNode lineNumber == blocksLineNr ifTrue:[
- blocksHome := blockNode home.
- (blocksHome notNil and:[blocksHome isBlock]) ifTrue:[
- (blocksHome numArgs == numArgs
- and:[ blocksHome numVars == numVars ]) ifTrue:[
- blockNode := blocksHome
- ].
- ].
- ].
-
- argNames := #().
- varNames := #().
-
- numArgs > 0 ifTrue:[
- vars := blockNode arguments.
- vars notEmptyOrNil ifTrue:[
- argNames := vars collect:[:var | var name]
- ]
- ].
- numVars > 0 ifTrue:[
- vars := blockNode variablesIncludingInlined: (homeMethod code notNil and:[homeMethod byteCode isNil]).
- vars notEmptyOrNil ifTrue:[
- varNames := vars collect:[:var | var name].
- ]
- ].
- ^ argNames , varNames
- ].
- ].
+ [
+ |blockNode argNames varNames vars args blocksHome|
+
+ blockNode := Compiler
+ blockAtLine:blocksLineNr
+ in:m
+ orSource:src
+ numArgs:numArgs
+ numVars:numVars.
+
+ blockNode notNil ifTrue:[
+ "/ a kludge
+ blockNode lineNumber == blocksLineNr ifTrue:[
+ blocksHome := blockNode home.
+ (blocksHome notNil and:[blocksHome isBlock]) ifTrue:[
+ (blocksHome numArgs == numArgs
+ and:[ blocksHome numVars == numVars ]) ifTrue:[
+ blockNode := blocksHome
+ ].
+ ].
+ ].
+
+ argNames := #().
+ varNames := #().
+
+ numArgs > 0 ifTrue:[
+ vars := blockNode arguments.
+ vars notEmptyOrNil ifTrue:[
+ argNames := vars collect:[:var | var name]
+ ]
+ ].
+ numVars > 0 ifTrue:[
+ vars := blockNode variablesIncludingInlined: (homeMethod code notNil and:[homeMethod byteCode isNil]).
+ vars notEmptyOrNil ifTrue:[
+ varNames := vars collect:[:var | var name].
+ ]
+ ].
+ ^ argNames , varNames
+ ].
+ ].
"/ #doIt needs special handling below
isDoIt := (sel == #'doIt') or:[sel == #'doIt:'].
self isBlockContext ifFalse:[
- isDoIt ifTrue:[
- homeMethod notNil ifTrue:[
- "/ special for #doIt
- m := nil.
- src := ('[' , homeMethod source , '\]') withCRs.
- "/ blocksLineNr := self lineNumber.
- blocksLineNr := (self home ? self) lineNumber.
- extractFromBlock value.
- ]
- ].
-
- homeMethod notNil ifTrue:[
- ^ homeMethod methodArgAndVarNamesInContext: self.
- ].
- ^ #()
+ isDoIt ifTrue:[
+ homeMethod notNil ifTrue:[
+ "/ special for #doIt
+ m := nil.
+ src := ('[' , homeMethod source , '\]') withCRs.
+ "/ blocksLineNr := self lineNumber.
+ blocksLineNr := (self home ? self) lineNumber.
+ extractFromBlock value.
+ ]
+ ].
+
+ homeMethod notNil ifTrue:[
+ ^ homeMethod methodArgAndVarNamesInContext: self.
+ ].
+ ^ #()
].
homeMethod notNil ifTrue:[
- isDoIt ifTrue:[
- "/ special for #doIt
- "/ my source is found in the method.
- m := nil.
- src := ('[' , homeMethod source , '\]') withCRs.
- ] ifFalse:[
- m := homeMethod.
- src := nil.
- ].
- blocksLineNr := self lineNumber.
- extractFromBlock value.
- blocksLineNr := self home lineNumber.
- extractFromBlock value.
+ isDoIt ifTrue:[
+ "/ special for #doIt
+ "/ my source is found in the method.
+ m := nil.
+ src := ('[' , homeMethod source , '\]') withCRs.
+ ] ifFalse:[
+ m := homeMethod.
+ src := nil.
+ ].
+ blocksLineNr := self lineNumber.
+ extractFromBlock value.
+ blocksLineNr := self home lineNumber.
+ extractFromBlock value.
].
blocksLineNr isNil ifTrue:[
- self isBlockContext ifTrue:[
- sender := self sender.
- (sender notNil
- and:[sender receiver isBlock
- and:[sender selector startsWith:'value']])
- ifTrue:[
- block := sender receiver.
- src := block source.
- src isNil ifTrue:[
- self error:'no source'.
- ].
- blocksLineNr := 1.
- extractFromBlock value.
- ].
- sender := nil.
- ].
+ self isBlockContext ifTrue:[
+ sender := self sender.
+ (sender notNil
+ and:[sender receiver isBlock
+ and:[sender selector startsWith:'value']])
+ ifTrue:[
+ block := sender receiver.
+ src := block source.
+ src isNil ifTrue:[
+ self error:'no source'.
+ ].
+ blocksLineNr := 1.
+ extractFromBlock value.
+ ].
+ sender := nil.
+ ].
].
^ #()
@@ -2406,6 +2540,9 @@
(i.e. the one that I have called) and return from it.
"
%{
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
OBJ sndr;
theContext = __thisContext;
@@ -2419,6 +2556,7 @@
__PATCHUPCONTEXT(theContext);
}
}
+#endif
%}.
theContext isNil ifTrue:[
^ false
@@ -2439,8 +2577,11 @@
are all compiled with this flag turned on."
%{ /* NOCONTEXT */
-
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( ((INT)(__INST(flags)) & __MASKSMALLINT(__CANNOT_RETURN)) ? false : true );
+#endif
%}.
^ true
!
@@ -2460,7 +2601,11 @@
"return true, if this is a context with exception-handle flag set"
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__HANDLE_MARK)) ? true : false );
+#endif
%}
!
@@ -2473,7 +2618,11 @@
debug query, which may be removed without notice."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__NONLIFO)) ? true : false );
+#endif
%}
!
@@ -2484,7 +2633,11 @@
debug query, which may be removed without notice."
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( (__qSpace(self) >= STACKSPACE) ? true : false );
+#endif
%}
!
@@ -2492,7 +2645,11 @@
"return true, if this is a context with exception-raise flag set"
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__RAISE_MARK)) ? true : false );
+#endif
%}
!
@@ -2500,7 +2657,11 @@
"return true, if this is either a nonLifo or interrupted context"
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__SPECIAL)) ? true : false );
+#endif
%}
!
@@ -2508,7 +2669,11 @@
"return true, if this is an unwindContext"
%{ /* NOCONTEXT */
+#ifdef __JAVA__
+ ERROR("unimplemented");
+#else
RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__UNWIND_MARK)) ? true : false );
+#endif
%}
!
@@ -2558,29 +2723,29 @@
c := self findNextContextWithSelector:selector or:nil or:nil.
[c notNil] whileTrue:[
- (c receiver == receiver) ifTrue:[
- c method == self method ifTrue:[
- sameArgs := true.
- 1 to:self numArgs do:[:i |
- (c argAt:1) ~~ (self argAt:i)ifTrue:[
- sameArgs := false
- ]
- ].
- sameArgs ifTrue:[^ true].
- ]
- ].
- c := c findNextContextWithSelector:selector or:nil or:nil.
-
- "
- this special test was added to get out after a while
- if the sender chain is corrupt - this gives us at least
- a chance to find those errors.
- "
- count := count + 1.
- count >= 100000 ifTrue:[
- 'Context [warning]: bad context chain' errorPrintCR.
- ^ true
- ]
+ (c receiver == receiver) ifTrue:[
+ c method == self method ifTrue:[
+ sameArgs := true.
+ 1 to:self numArgs do:[:i |
+ (c argAt:1) ~~ (self argAt:i)ifTrue:[
+ sameArgs := false
+ ]
+ ].
+ sameArgs ifTrue:[^ true].
+ ]
+ ].
+ c := c findNextContextWithSelector:selector or:nil or:nil.
+
+ "
+ this special test was added to get out after a while
+ if the sender chain is corrupt - this gives us at least
+ a chance to find those errors.
+ "
+ count := count + 1.
+ count >= 100000 ifTrue:[
+ 'Context [warning]: bad context chain' errorPrintCR.
+ ^ true
+ ]
].
^ false
!
@@ -2598,7 +2763,7 @@
c := self findNextContextWithSelector:selector or:nil or:nil.
[c notNil] whileTrue:[
- (c receiver == receiver) ifTrue:[
+ (c receiver == receiver) ifTrue:[
"/ "
"/ stupid: the current ST/X context does not include
"/ the method, but the class, in which the search started ...
@@ -2609,21 +2774,21 @@
"/ c methodClass == myMethodsClass ifTrue:[
"/ ^ true
"/ ].
- "/ now it does!!
- c method == self method ifTrue:[^ true].
- ].
- c := c findNextContextWithSelector:selector or:nil or:nil.
-
- "
- this special test was added to get out after a while
- if the sender chain is corrupt - this gives us at least
- a chance to find those errors.
- "
- count := count + 1.
- count >= 100000 ifTrue:[
- 'Context [warning]: bad context chain' errorPrintCR.
- ^ true
- ]
+ "/ now it does!!
+ c method == self method ifTrue:[^ true].
+ ].
+ c := c findNextContextWithSelector:selector or:nil or:nil.
+
+ "
+ this special test was added to get out after a while
+ if the sender chain is corrupt - this gives us at least
+ a chance to find those errors.
+ "
+ count := count + 1.
+ count >= 100000 ifTrue:[
+ 'Context [warning]: bad context chain' errorPrintCR.
+ ^ true
+ ]
].
^ false
@@ -2633,11 +2798,11 @@
!Context class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.210 2015-01-20 14:09:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.211 2015-04-07 20:17:36 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.210 2015-01-20 14:09:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.211 2015-04-07 20:17:36 cg Exp $'
!
version_HG