# HG changeset patch # User claus # Date 806466296 -7200 # Node ID ccc7f9389a8e890ed040672775312ba69344400d # Parent 3b0d380771e9454fd62696dfb462d2162a2caa66 . diff -r 3b0d380771e9 -r ccc7f9389a8e BCompiler.st --- a/BCompiler.st Mon Jul 03 04:38:59 1995 +0200 +++ b/BCompiler.st Sun Jul 23 04:24:56 1995 +0200 @@ -26,7 +26,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.26 1995-07-03 02:38:16 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.27 1995-07-23 02:22:57 claus Exp $ '! !ByteCodeCompiler class methodsFor:'documentation'! @@ -47,7 +47,7 @@ version " -$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.26 1995-07-03 02:38:16 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.27 1995-07-23 02:22:57 claus Exp $ " ! @@ -82,18 +82,52 @@ " ! ! -!ByteCodeCompiler class methodsFor:'compiling methods'! +!ByteCodeCompiler methodsFor:'ST-80 compatibility'! -compile:textOrStream in:aClass notifying:aRequestor ifFail:aBlock +compile:textOrStream in:aClass notifying:requestor ifFail:exceptionBlock "name alias for ST-80 compatibility" - ^ self compile:textOrStream + ^ self class + compile:textOrStream + in:aClass + notifying:requestor + ifFail:exceptionBlock +"/ |m| +"/ +"/ m := self class +"/ compile:textOrStream +"/ forClass:aClass +"/ inCategory:'no category' +"/ notifying:requestor +"/ install:true +"/ skipIfSame:false +"/ silent:false. +"/ m == #Error ifTrue:[ +"/ ^ exceptionBlock value +"/ ]. +"/ ^ m +! ! + +!ByteCodeCompiler class methodsFor:'compiling methods'! + +compile:textOrStream in:aClass notifying:requestor ifFail:exceptionBlock + "name alias for ST-80 compatibility" + + |m| + + m := self + compile:textOrStream forClass:aClass inCategory:'others' - notifying:aRequestor + notifying:requestor install:true skipIfSame:false - silent:false + silent:false. + m == #Error ifTrue:[ + ^ exceptionBlock value + ]. + ^ m + ! compile:methodText forClass:classToCompileFor @@ -312,7 +346,7 @@ ]. newMethod category:cat. Project notNil ifTrue:[ - newMethod package:(Project current packageName) + newMethod package:(Project currentPackageName) ]. aClass addSelector:sel withLazyMethod:newMethod. @@ -377,7 +411,7 @@ ]. newMethod category:cat. Project notNil ifTrue:[ - newMethod package:(Project current packageName) + newMethod package:(Project currentPackageName) ]. install ifTrue:[ @@ -1401,7 +1435,7 @@ |stFileName stream handle address flags command oFileName soFileName initName newMethod ok status className sep| - ForceNoSTCCompilation ifTrue:[^ #Error]. + ForceNoSTCCompilation == true ifTrue:[^ #Error]. SequenceNumber isNil ifTrue:[ SequenceNumber := 0. @@ -1503,6 +1537,16 @@ OperatingSystem executeCommand:'rm -f ' , soFileName. OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName. oFileName := soFileName. + ] ifFalse:[ + OperatingSystem getOSType = 'sys5.4' ifTrue:[ + " + link it to a shared object + " + soFileName := './' , initName , '.so'. + OperatingSystem executeCommand:'rm -f ' , soFileName. + OperatingSystem executeCommand:'ld -G -o ' , soFileName , ' ' , oFileName. + oFileName := soFileName. + ]. ]. ObjectFileLoader isNil ifTrue:[ @@ -1549,6 +1593,7 @@ (silent or:[Smalltalk silentLoading == true]) ifFalse:[ Transcript showCr:(' compiled: ', className,' ',selector,' - machine code') ]. + ObjectMemory flushCaches. ^ newMethod. ]. @@ -1612,7 +1657,7 @@ newMethod source:aString. newMethod category:cat. Project notNil ifTrue:[ - newMethod package:(Project current packageName) + newMethod package:(Project currentPackageName) ]. ^ newMethod ! ! diff -r 3b0d380771e9 -r ccc7f9389a8e BlockNode.st --- a/BlockNode.st Mon Jul 03 04:38:59 1995 +0200 +++ b/BlockNode.st Sun Jul 23 04:24:56 1995 +0200 @@ -23,7 +23,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.13 1995-06-27 02:17:05 claus Exp $ +$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.14 1995-07-23 02:23:06 claus Exp $ '! !BlockNode class methodsFor:'documentation'! @@ -44,7 +44,7 @@ version " -$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.13 1995-06-27 02:17:05 claus Exp $ +$Header: /cvs/stx/stx/libcomp/BlockNode.st,v 1.14 1995-07-23 02:23:06 claus Exp $ " ! @@ -531,14 +531,25 @@ !BlockNode methodsFor:'printing'! printOn:aStream indent:i + |n "{Class: SmallInteger }"| + aStream nextPut:$[. - blockArgs size > 0 ifTrue:[ - 1 to:blockArgs size do:[:index | + (n := blockArgs size) > 0 ifTrue:[ + 1 to:n do:[:index | aStream nextPut:$:. aStream nextPutAll:(blockArgs at:index) name. aStream space. ]. - aStream nextPut:$| + aStream nextPut:$|. + aStream space. + ]. + (n := blockVars size) > 0 ifTrue:[ + aStream nextPut:$|. + 1 to:n do:[:index | + aStream nextPutAll:(blockVars at:index) name. + aStream space. + ]. + aStream nextPut:$|. ]. statements notNil ifTrue:[ aStream cr. diff -r 3b0d380771e9 -r ccc7f9389a8e ByteCodeCompiler.st --- a/ByteCodeCompiler.st Mon Jul 03 04:38:59 1995 +0200 +++ b/ByteCodeCompiler.st Sun Jul 23 04:24:56 1995 +0200 @@ -26,7 +26,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.26 1995-07-03 02:38:16 claus Exp $ +$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.27 1995-07-23 02:22:57 claus Exp $ '! !ByteCodeCompiler class methodsFor:'documentation'! @@ -47,7 +47,7 @@ version " -$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.26 1995-07-03 02:38:16 claus Exp $ +$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.27 1995-07-23 02:22:57 claus Exp $ " ! @@ -82,18 +82,52 @@ " ! ! -!ByteCodeCompiler class methodsFor:'compiling methods'! +!ByteCodeCompiler methodsFor:'ST-80 compatibility'! -compile:textOrStream in:aClass notifying:aRequestor ifFail:aBlock +compile:textOrStream in:aClass notifying:requestor ifFail:exceptionBlock "name alias for ST-80 compatibility" - ^ self compile:textOrStream + ^ self class + compile:textOrStream + in:aClass + notifying:requestor + ifFail:exceptionBlock +"/ |m| +"/ +"/ m := self class +"/ compile:textOrStream +"/ forClass:aClass +"/ inCategory:'no category' +"/ notifying:requestor +"/ install:true +"/ skipIfSame:false +"/ silent:false. +"/ m == #Error ifTrue:[ +"/ ^ exceptionBlock value +"/ ]. +"/ ^ m +! ! + +!ByteCodeCompiler class methodsFor:'compiling methods'! + +compile:textOrStream in:aClass notifying:requestor ifFail:exceptionBlock + "name alias for ST-80 compatibility" + + |m| + + m := self + compile:textOrStream forClass:aClass inCategory:'others' - notifying:aRequestor + notifying:requestor install:true skipIfSame:false - silent:false + silent:false. + m == #Error ifTrue:[ + ^ exceptionBlock value + ]. + ^ m + ! compile:methodText forClass:classToCompileFor @@ -312,7 +346,7 @@ ]. newMethod category:cat. Project notNil ifTrue:[ - newMethod package:(Project current packageName) + newMethod package:(Project currentPackageName) ]. aClass addSelector:sel withLazyMethod:newMethod. @@ -377,7 +411,7 @@ ]. newMethod category:cat. Project notNil ifTrue:[ - newMethod package:(Project current packageName) + newMethod package:(Project currentPackageName) ]. install ifTrue:[ @@ -1401,7 +1435,7 @@ |stFileName stream handle address flags command oFileName soFileName initName newMethod ok status className sep| - ForceNoSTCCompilation ifTrue:[^ #Error]. + ForceNoSTCCompilation == true ifTrue:[^ #Error]. SequenceNumber isNil ifTrue:[ SequenceNumber := 0. @@ -1503,6 +1537,16 @@ OperatingSystem executeCommand:'rm -f ' , soFileName. OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName. oFileName := soFileName. + ] ifFalse:[ + OperatingSystem getOSType = 'sys5.4' ifTrue:[ + " + link it to a shared object + " + soFileName := './' , initName , '.so'. + OperatingSystem executeCommand:'rm -f ' , soFileName. + OperatingSystem executeCommand:'ld -G -o ' , soFileName , ' ' , oFileName. + oFileName := soFileName. + ]. ]. ObjectFileLoader isNil ifTrue:[ @@ -1549,6 +1593,7 @@ (silent or:[Smalltalk silentLoading == true]) ifFalse:[ Transcript showCr:(' compiled: ', className,' ',selector,' - machine code') ]. + ObjectMemory flushCaches. ^ newMethod. ]. @@ -1612,7 +1657,7 @@ newMethod source:aString. newMethod category:cat. Project notNil ifTrue:[ - newMethod package:(Project current packageName) + newMethod package:(Project currentPackageName) ]. ^ newMethod ! ! diff -r 3b0d380771e9 -r ccc7f9389a8e CodeStream.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/CodeStream.st Sun Jul 23 04:24:56 1995 +0200 @@ -0,0 +1,114 @@ +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" + +WriteStream subclass:#CodeStream + instanceVariableNames:'class scope requestor' + classVariableNames:'' + poolDictionaries:'' + category:'System-Compiler ST-80- compatibility' +! + +CodeStream comment:' +COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + +$Header: /cvs/stx/stx/libcomp/CodeStream.st,v 1.1 1995-07-23 02:23:10 claus Exp $ +'! + +!CodeStream class methodsFor:'documentation'! + +copyright +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" +! + +version +" +$Header: /cvs/stx/stx/libcomp/CodeStream.st,v 1.1 1995-07-23 02:23:10 claus Exp $ +" +! + +documentation +" + This is a pure mimicri class. + It is not used by ST/X, but provided to support limited + compatibility for applications which build up codetrees, + knowing internals of ST-80's compiler class hierarchy. + This classes protocol is not (not meant to be) fully covering + the corresponding ST-80's classes protocol. It maps ST-80 messages + to corresponding ST/X messages (as far as possible). + + NO WARRANTY and GUARANTEE; this class may be removed without notice. +" +! ! + +!CodeStream class methodsFor:'instance creation'! + +new + ^ super on:(OrderedCollection new:100) +! ! + +!CodeStream methodsFor:'accessing'! + +class:aClass outerScope:aScope + class := aClass. + scope := aScope +! + +requestor:someOne + requestor := someOne +! ! + +!CodeStream methodsFor:'code generation'! + +makeMethod:aMethodNode + "mhmh - kludge-create a compiler and let it generate code" + + |compiler symbolicCodeArray newMethod lits| + + compiler := ByteCodeCompiler new. + compiler notifying:requestor. + compiler targetClass:class. + + symbolicCodeArray := self contents. + (compiler genByteCodeFrom:symbolicCodeArray) == #Error ifTrue:[ + self halt + ]. + + newMethod := Method new. + newMethod byteCode:(compiler code). + lits := compiler literalArray. + lits notNil ifTrue:[ + "literals MUST be an array - not just any Collection" + lits := Array withAll:lits. + newMethod literals:lits + ]. + newMethod numberOfMethodVars:(compiler numberOfMethodVars). + newMethod numberOfMethodArgs:(compiler numberOfMethodArgs). + newMethod stackSize:(compiler maxStackDepth). + + Project notNil ifTrue:[ + newMethod package:(Project currentPackageName) + ]. + + class addSelector:aMethodNode selector withMethod:newMethod. + ^ newMethod +! ! diff -r 3b0d380771e9 -r ccc7f9389a8e ConstNode.st --- a/ConstNode.st Mon Jul 03 04:38:59 1995 +0200 +++ b/ConstNode.st Sun Jul 23 04:24:56 1995 +0200 @@ -22,7 +22,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/Attic/ConstNode.st,v 1.11 1995-06-27 02:17:11 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/ConstNode.st,v 1.12 1995-07-23 02:23:30 claus Exp $ '! !ConstantNode class methodsFor:'documentation'! @@ -43,7 +43,7 @@ version " -$Header: /cvs/stx/stx/libcomp/Attic/ConstNode.st,v 1.11 1995-06-27 02:17:11 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/ConstNode.st,v 1.12 1995-07-23 02:23:30 claus Exp $ " ! @@ -64,6 +64,10 @@ ^ #Integer ]. + anObject isNil ifTrue:[ + ^ #Nil + ]. + anObject isNumber ifTrue:[ "the most common case first ..." (anObject isMemberOf:Float) ifTrue:[ @@ -73,9 +77,6 @@ ^ #Integer ]. ]. - anObject isNil ifTrue:[ - ^ #Nil - ]. (anObject == true) ifTrue:[ ^ #True ]. @@ -87,6 +88,10 @@ !ConstantNode class methodsFor:'instance creation'! +value:val + ^ self type:(self typeOfConstant:val) value:val +! + type:t value:val "some constant nodes are used so often, its worth caching them" (t == #True) ifTrue:[ diff -r 3b0d380771e9 -r ccc7f9389a8e ConstantNode.st --- a/ConstantNode.st Mon Jul 03 04:38:59 1995 +0200 +++ b/ConstantNode.st Sun Jul 23 04:24:56 1995 +0200 @@ -22,7 +22,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/ConstantNode.st,v 1.11 1995-06-27 02:17:11 claus Exp $ +$Header: /cvs/stx/stx/libcomp/ConstantNode.st,v 1.12 1995-07-23 02:23:30 claus Exp $ '! !ConstantNode class methodsFor:'documentation'! @@ -43,7 +43,7 @@ version " -$Header: /cvs/stx/stx/libcomp/ConstantNode.st,v 1.11 1995-06-27 02:17:11 claus Exp $ +$Header: /cvs/stx/stx/libcomp/ConstantNode.st,v 1.12 1995-07-23 02:23:30 claus Exp $ " ! @@ -64,6 +64,10 @@ ^ #Integer ]. + anObject isNil ifTrue:[ + ^ #Nil + ]. + anObject isNumber ifTrue:[ "the most common case first ..." (anObject isMemberOf:Float) ifTrue:[ @@ -73,9 +77,6 @@ ^ #Integer ]. ]. - anObject isNil ifTrue:[ - ^ #Nil - ]. (anObject == true) ifTrue:[ ^ #True ]. @@ -87,6 +88,10 @@ !ConstantNode class methodsFor:'instance creation'! +value:val + ^ self type:(self typeOfConstant:val) value:val +! + type:t value:val "some constant nodes are used so often, its worth caching them" (t == #True) ifTrue:[ diff -r 3b0d380771e9 -r ccc7f9389a8e ImmArray.st --- a/ImmArray.st Mon Jul 03 04:38:59 1995 +0200 +++ b/ImmArray.st Sun Jul 23 04:24:56 1995 +0200 @@ -37,21 +37,21 @@ version " -$Header: /cvs/stx/stx/libcomp/Attic/ImmArray.st,v 1.5 1995-07-03 02:38:27 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/ImmArray.st,v 1.6 1995-07-23 02:23:34 claus Exp $ " ! documentation " By default, array literals in smalltalk are mutable objects. That - may lead to some subtle (and hard to find errors) if some method passes + may lead to some subtle (and hard to find errors), if some method passes a literal array constant as argument to someone else, who changes the array using at:put: like messages. Since the array object is kept in the first methods literals, the array constant has now been changed without - having the methods sourcecode reflect this. Thus, method the methods will + having the methods sourcecode reflect this. Thus, the method will behave differently from what its source may make you think. - To help finding this kind of 'feature/bug', the compiler class can be + To help finding this kind of 'feature/bug', the compiler can be configured to create instances of this ImmutableArray instead of Arrays for array literals. Instances of ImmutableArray catch storing accesses and enter the debugger. Although useful, this feature is disabled by default @@ -60,7 +60,7 @@ a workspace somewhat strange: you cannot modify it any longer). Turn the ImmutableArray feature on by setting the Parsers class variable - 'ArraysAreImmutable' to true. + 'ArraysAreImmutable' to true or use the new launchers settings menu. " ! ! diff -r 3b0d380771e9 -r ccc7f9389a8e ImmutableArray.st --- a/ImmutableArray.st Mon Jul 03 04:38:59 1995 +0200 +++ b/ImmutableArray.st Sun Jul 23 04:24:56 1995 +0200 @@ -37,21 +37,21 @@ version " -$Header: /cvs/stx/stx/libcomp/Attic/ImmutableArray.st,v 1.5 1995-07-03 02:38:27 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/ImmutableArray.st,v 1.6 1995-07-23 02:23:34 claus Exp $ " ! documentation " By default, array literals in smalltalk are mutable objects. That - may lead to some subtle (and hard to find errors) if some method passes + may lead to some subtle (and hard to find errors), if some method passes a literal array constant as argument to someone else, who changes the array using at:put: like messages. Since the array object is kept in the first methods literals, the array constant has now been changed without - having the methods sourcecode reflect this. Thus, method the methods will + having the methods sourcecode reflect this. Thus, the method will behave differently from what its source may make you think. - To help finding this kind of 'feature/bug', the compiler class can be + To help finding this kind of 'feature/bug', the compiler can be configured to create instances of this ImmutableArray instead of Arrays for array literals. Instances of ImmutableArray catch storing accesses and enter the debugger. Although useful, this feature is disabled by default @@ -60,7 +60,7 @@ a workspace somewhat strange: you cannot modify it any longer). Turn the ImmutableArray feature on by setting the Parsers class variable - 'ArraysAreImmutable' to true. + 'ArraysAreImmutable' to true or use the new launchers settings menu. " ! ! diff -r 3b0d380771e9 -r ccc7f9389a8e Make.proto --- a/Make.proto Mon Jul 03 04:38:59 1995 +0200 +++ b/Make.proto Sun Jul 23 04:24:56 1995 +0200 @@ -1,4 +1,4 @@ -# $Header: /cvs/stx/stx/libcomp/Make.proto,v 1.24 1995-06-27 02:17:58 claus Exp $ +# $Header: /cvs/stx/stx/libcomp/Make.proto,v 1.25 1995-07-23 02:24:56 claus Exp $ # # -------------- no need to change anything below ---------- @@ -94,6 +94,9 @@ -rm -f *.c *.H clean:: + -mv ObjFloader.o __ObjFLoader.o + -rm -f [A-Z]*.o + -mv __ObjFLoader.o ObjFloader.o -rm -f *.c *.H abbrev.stc classList.stc clobber:: diff -r 3b0d380771e9 -r ccc7f9389a8e MethodNode.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MethodNode.st Sun Jul 23 04:24:56 1995 +0200 @@ -0,0 +1,108 @@ +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" + +ParseNode subclass:#MethodNode + instanceVariableNames:'selector arguments locals statements' + classVariableNames:'' + poolDictionaries:'' + category:'System-Compiler ST-80- compatibility' +! + +MethodNode comment:' +COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + +$Header: /cvs/stx/stx/libcomp/MethodNode.st,v 1.1 1995-07-23 02:23:40 claus Exp $ +'! + +!MethodNode class methodsFor:'documentation'! + +copyright +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" +! + +version +" +$Header: /cvs/stx/stx/libcomp/MethodNode.st,v 1.1 1995-07-23 02:23:40 claus Exp $ +" +! + +documentation +" + This is a pure mimicri class. + It is not used by ST/X, but provided to support limited + compatibility for applications which build up codetrees, + knowing internals of ST-80's compiler class hierarchy. + This classes protocol is not (not meant to be) fully covering + the corresponding ST-80's classes protocol. It maps ST-80 messages + to corresponding ST/X messages (as far as possible). + + NO WARRANTY and GUARANTEE; this class may be removed without notice. +" +! ! + +!MethodNode methodsFor:'accessing'! + +selector:sel arguments:argVars locals:localVars statements:stats + selector := sel. + arguments := argVars. + locals := localVars. + statements := stats. +! + +selector + ^ selector +! ! + +!MethodNode methodsFor:'code generation'! + +emitEffect:aStream + statements do:[:stat | + stat codeForSideEffectOn:aStream inBlock:nil + ]. +! ! + +!MethodNode methodsFor:'printing'! + +printOn:aStream indent:i + |n parts| + + n := selector numArgs. + n == 0 ifTrue:[ + aStream nextPutAll:selector printString. + ] ifFalse:[ + parts := selector partsIfSelector. + parts with:arguments do:[:part :arg | + aStream nextPutAll:part. + aStream space. + aStream nextPutAll:arg name + ] + ]. + aStream cr. + + statements do:[:stat | + aStream spaces:i+4. + stat printOn:aStream indent:i+4. + aStream nextPut:$.. + aStream cr. + ]. +! ! diff -r 3b0d380771e9 -r ccc7f9389a8e NullScope.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/NullScope.st Sun Jul 23 04:24:56 1995 +0200 @@ -0,0 +1,63 @@ +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" + +Object subclass:#NullScope + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'System-Compiler ST-80- compatibility' +! + +NullScope comment:' +COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + +$Header: /cvs/stx/stx/libcomp/NullScope.st,v 1.1 1995-07-23 02:23:43 claus Exp $ +'! + +!NullScope class methodsFor:'documentation'! + +copyright +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" +! + +version +" +$Header: /cvs/stx/stx/libcomp/NullScope.st,v 1.1 1995-07-23 02:23:43 claus Exp $ +" +! + +documentation +" + This is a pure mimicri class. + It is not used by ST/X, but provided to support limited + compatibility for applications which build up codetrees, + knowing internals of ST-80's compiler class hierarchy. + This classes protocol is not (not meant to be) fully covering + the corresponding ST-80's classes protocol. It maps ST-80 messages + to corresponding ST/X messages (as far as possible). + + NO WARRANTY and GUARANTEE; this class may be removed without notice. +" +! ! + + diff -r 3b0d380771e9 -r ccc7f9389a8e ObjFLoader.st --- a/ObjFLoader.st Mon Jul 03 04:38:59 1995 +0200 +++ b/ObjFLoader.st Sun Jul 23 04:24:56 1995 +0200 @@ -21,7 +21,7 @@ COPYRIGHT (c) 1993 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.27 1995-07-03 02:38:34 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.28 1995-07-23 02:23:48 claus Exp $ '! !ObjectFileLoader class methodsFor:'documentation'! @@ -42,7 +42,7 @@ version " -$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.27 1995-07-03 02:38:34 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.28 1995-07-23 02:23:48 claus Exp $ " ! @@ -104,7 +104,7 @@ # define HAS_DL #endif -#ifdef aix +#ifdef _AIX # define AIX_DL # define HAS_DL #endif @@ -1082,9 +1082,9 @@ } if (__isString(pathName)) { - if (dld_link(_stringVal(pathName))) { + if (dld_link(__stringVal(pathName))) { if (ObjectFileLoader_Verbose == true) { - printf ("link file %s failed\n", _stringVal(pathName)); + printf ("link file %s failed\n", __stringVal(pathName)); dld_perror("cant link"); } ObjectFileLoader_LastError = @symbol(linkError); @@ -1100,9 +1100,9 @@ char *ldname; if (__isString(pathName)) { - if ( dl_loadmod_only(__myName__, _stringVal(pathName), &ldname) == 0 ) { + if ( dl_loadmod_only(__myName__, __stringVal(pathName), &ldname) == 0 ) { if (ObjectFileLoader_Verbose == true) { - printf ("link file %s failed\n", _stringVal(pathName)); + printf ("link file %s failed\n", __stringVal(pathName)); } RETURN ( nil ); } @@ -1123,14 +1123,14 @@ if (__isString(pathName)) { if (__isArray(aBuffer) && (_arraySize(aBuffer) == 2)) {; - if ( (handle = load(_stringVal(pathName), 0, 0)) == 0 ) { + if ( (handle = load(__stringVal(pathName), 0, 0)) == 0 ) { if (ObjectFileLoader_Verbose == true) { - printf ("link file %s failed\n", _stringVal(pathName)); + printf ("load file %s failed\n", __stringVal(pathName)); } RETURN ( nil ); } if (ObjectFileLoader_Verbose == true) - printf("load %s handle = %x\n", _stringVal(pathName), handle); + printf("load %s handle = %x\n", __stringVal(pathName), handle); _ArrayInstPtr(aBuffer)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF ); @@ -1144,24 +1144,25 @@ #ifdef SYSV4_DL void *handle; + char *nm; if ((pathName == nil) || __isString(pathName)) { if (__isArray(aBuffer) && (_arraySize(aBuffer) == 2)) {; - if (pathName == nil) - handle = dlopen((char *)0, RTLD_NOW); - else - handle = dlopen(_stringVal(pathName), RTLD_NOW); + handle = dlopen(pathName == nil ? + (char *)0 : + __stringVal(pathName), + RTLD_NOW); if (! handle) { fprintf(stderr, "dlopen %s error: <%s>\n", - _stringVal(pathName), dlerror()); + __stringVal(pathName), dlerror()); ObjectFileLoader_LastError = @symbol(linkError); RETURN (nil); } if (ObjectFileLoader_Verbose == true) - printf("open %s handle = %x\n", _stringVal(pathName), handle); + printf("open %s handle = %x\n", __stringVal(pathName), handle); _ArrayInstPtr(aBuffer)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF ); @@ -1181,17 +1182,17 @@ if (pathName == nil) handle = dlopen((char *)0, 1); else - handle = dlopen(_stringVal(pathName), 1); + handle = dlopen(__stringVal(pathName), 1); if (! handle) { fprintf(stderr, "dlopen %s error: <%s>\n", - _stringVal(pathName), dlerror()); + __stringVal(pathName), dlerror()); ObjectFileLoader_LastError = @symbol(linkError); RETURN (nil); } if (ObjectFileLoader_Verbose == true) - printf("open %s handle = %x\n", _stringVal(pathName), handle); + printf("open %s handle = %x\n", __stringVal(pathName), handle); _ArrayInstPtr(aBuffer)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF ); @@ -1208,7 +1209,7 @@ NXStream *errOut; if (__isString(pathName)) { - files[0] = (char *) _stringVal(pathName); + files[0] = (char *) __stringVal(pathName); files[1] = (char *) 0; errOut = NXOpenFile(2, 2); result = rld_load(errOut, @@ -1218,12 +1219,12 @@ NXClose(errOut); if (! result) { ObjectFileLoader_LastError = @symbol(linkError); - fprintf(stderr, "rld_load %s failed\n", _stringVal(pathName)); + fprintf(stderr, "rld_load %s failed\n", __stringVal(pathName)); RETURN (nil); } if (ObjectFileLoader_Verbose == true) - printf("rld_load %s ok\n", _stringVal(pathName)); + printf("rld_load %s ok\n", __stringVal(pathName)); RETURN (pathName); } @@ -1263,9 +1264,9 @@ %{ #ifdef GNU_DL if (__isString(handle)) { - if (dld_unlink_by_file(_stringVal(handle), 1)) { + if (dld_unlink_by_file(__stringVal(handle), 1)) { if (ObjectFileLoader_Verbose == true) { - printf ("unlink file %s failed\n", _stringVal(handle)); + printf ("unlink file %s failed\n", __stringVal(handle)); dld_perror("cant unlink"); } RETURN (false); @@ -1423,7 +1424,7 @@ char *name; if (__isString(aString)) { - name = (char *) _stringVal(aString); + name = (char *) __stringVal(aString); if (isFunction == false) { addr = dld_get_symbol(name); } else { @@ -1470,8 +1471,8 @@ if (__isString(handle)) { if (ObjectFileLoader_Verbose == true) printf("get sym <%s> handle = %x\n", - _stringVal(aString), _stringVal(handle)); - addr = dl_getsymbol(_stringVal(handle), _stringVal(aString)); + __stringVal(aString), __stringVal(handle)); + addr = dl_getsymbol(__stringVal(handle), __stringVal(aString)); if (addr) { if (ObjectFileLoader_Verbose == true) printf("addr = %x\n", addr); @@ -1479,7 +1480,7 @@ hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF ); } else { if (ObjectFileLoader_Verbose == true) - printf("dl_getsymbol %s failed\n", _stringVal(aString)); + printf("dl_getsymbol %s failed\n", __stringVal(aString)); } } } @@ -1503,8 +1504,8 @@ h = (void *)(val); if (__isString(aString)) { if (ObjectFileLoader_Verbose == true) - printf("get sym <%s> handle = %x\n", _stringVal(aString), h); - addr = dlsym(h, (char *) _stringVal(aString)); + printf("get sym <%s> handle = %x\n", __stringVal(aString), h); + addr = dlsym(h, (char *) __stringVal(aString)); if (addr) { if (ObjectFileLoader_Verbose == true) printf("addr = %x\n", addr); @@ -1512,7 +1513,7 @@ hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF ); } else { if (ObjectFileLoader_Verbose == true) - printf("dlsym %s error: %s\n", _stringVal(aString), dlerror()); + printf("dlsym %s error: %s\n", __stringVal(aString), dlerror()); } } } @@ -1540,12 +1541,12 @@ if (__isString(aString)) { if (ObjectFileLoader_Verbose == true) printf("get sym <%s> handle = %x file = %s\n", - _stringVal(aString), h, _stringVal(fileName)); + __stringVal(aString), h, __stringVal(fileName)); - nl[0].n_name = _stringVal(aString); + nl[0].n_name = __stringVal(aString); nl[1].n_name = ""; - if (nlist(_stringVal(fileName), &nl) == -1) { + if (nlist(__stringVal(fileName), &nl) == -1) { if (ObjectFileLoader_Verbose == true) printf("nlist error\n"); } else { @@ -1575,8 +1576,8 @@ h = (void *)(val); if (__isString(aString)) { if (ObjectFileLoader_Verbose == true) - printf("get sym <%s> handle = %x\n", _stringVal(aString), h); - addr = dlsym(h, _stringVal(aString)); + printf("get sym <%s> handle = %x\n", __stringVal(aString), h); + addr = dlsym(h, __stringVal(aString)); if (addr) { if (ObjectFileLoader_Verbose == true) printf("addr = %x\n", addr); @@ -1584,7 +1585,7 @@ hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF ); } else { if (ObjectFileLoader_Verbose == true) - printf("dlsym %s error: %s\n", _stringVal(aString), dlerror()); + printf("dlsym %s error: %s\n", __stringVal(aString), dlerror()); } } } @@ -1597,10 +1598,10 @@ if (__isString(aString)) { if (ObjectFileLoader_Verbose == true) - printf("get sym <%s>\n", _stringVal(aString)); + printf("get sym <%s>\n", __stringVal(aString)); errOut = NXOpenFile(2, 2); result = rld_lookup(errOut, - (char *) _stringVal(aString), + (char *) __stringVal(aString), &addr); NXClose(errOut); if (result) { @@ -1823,7 +1824,6 @@ unsigned val; typedef void (*VOIDFUNC)(); int savInt; - extern int __immediateInterrupt__; int prevSpace, force; int arg = 0; int wasBlocked = 1; @@ -1839,10 +1839,6 @@ /* * allow function to be interrupted */ -#ifdef OLD - savInt = __immediateInterrupt__; - __immediateInterrupt__ = 1; -#endif if (interruptable != true) { wasBlocked = (__BLOCKINTERRUPTS() == true); } @@ -1864,9 +1860,6 @@ if (! wasBlocked) { __UNBLOCKINTERRUPTS(); } -#ifdef OLD - __immediateInterrupt__ = savInt; -#endif RETURN (self); } } @@ -1880,20 +1873,12 @@ %{ int savInt; - extern int __immediateInterrupt__; int prevSpace, force; int arg = 0; int wasBlocked = 1; extern OBJ __BLOCKINTERRUPTS(); if (_isSmallInteger(phase)) { - /* - * allow function to be interrupted - */ -#ifdef OLD - savInt = __immediateInterrupt__; - __immediateInterrupt__ = 1; -#endif if (interruptable != true) { wasBlocked = (__BLOCKINTERRUPTS() == true); } @@ -1912,9 +1897,6 @@ if (! wasBlocked) { __UNBLOCKINTERRUPTS(); } -#ifdef OLD - __immediateInterrupt__ = savInt; -#endif RETURN (self); } %}. @@ -1941,7 +1923,7 @@ RETURN (nil); } - fname = (char *) _stringVal(aFileName); + fname = (char *) __stringVal(aFileName); # if defined(A_DOT_OUT) && !defined(ELF) # if !defined(sco) && !defined(isc) @@ -1995,7 +1977,7 @@ RETURN ( nil ); } - fname = (char *) _stringVal(aFileName); + fname = (char *) __stringVal(aFileName); # if defined(A_DOT_OUT) && !defined(ELF) # if !defined(sco) && !defined(isc) @@ -2058,7 +2040,7 @@ # if defined(A_DOT_OUT) && !defined(ELF) # if !defined(sco) && !defined(isc) { - char *fname = (char *) _stringVal(aFileName); + char *fname = (char *) __stringVal(aFileName); unsigned taddr, daddr; unsigned tsize, dsize; unsigned toffset = 0; diff -r 3b0d380771e9 -r ccc7f9389a8e ObjectFileLoader.st --- a/ObjectFileLoader.st Mon Jul 03 04:38:59 1995 +0200 +++ b/ObjectFileLoader.st Sun Jul 23 04:24:56 1995 +0200 @@ -21,7 +21,7 @@ COPYRIGHT (c) 1993 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.27 1995-07-03 02:38:34 claus Exp $ +$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.28 1995-07-23 02:23:48 claus Exp $ '! !ObjectFileLoader class methodsFor:'documentation'! @@ -42,7 +42,7 @@ version " -$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.27 1995-07-03 02:38:34 claus Exp $ +$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.28 1995-07-23 02:23:48 claus Exp $ " ! @@ -104,7 +104,7 @@ # define HAS_DL #endif -#ifdef aix +#ifdef _AIX # define AIX_DL # define HAS_DL #endif @@ -1082,9 +1082,9 @@ } if (__isString(pathName)) { - if (dld_link(_stringVal(pathName))) { + if (dld_link(__stringVal(pathName))) { if (ObjectFileLoader_Verbose == true) { - printf ("link file %s failed\n", _stringVal(pathName)); + printf ("link file %s failed\n", __stringVal(pathName)); dld_perror("cant link"); } ObjectFileLoader_LastError = @symbol(linkError); @@ -1100,9 +1100,9 @@ char *ldname; if (__isString(pathName)) { - if ( dl_loadmod_only(__myName__, _stringVal(pathName), &ldname) == 0 ) { + if ( dl_loadmod_only(__myName__, __stringVal(pathName), &ldname) == 0 ) { if (ObjectFileLoader_Verbose == true) { - printf ("link file %s failed\n", _stringVal(pathName)); + printf ("link file %s failed\n", __stringVal(pathName)); } RETURN ( nil ); } @@ -1123,14 +1123,14 @@ if (__isString(pathName)) { if (__isArray(aBuffer) && (_arraySize(aBuffer) == 2)) {; - if ( (handle = load(_stringVal(pathName), 0, 0)) == 0 ) { + if ( (handle = load(__stringVal(pathName), 0, 0)) == 0 ) { if (ObjectFileLoader_Verbose == true) { - printf ("link file %s failed\n", _stringVal(pathName)); + printf ("load file %s failed\n", __stringVal(pathName)); } RETURN ( nil ); } if (ObjectFileLoader_Verbose == true) - printf("load %s handle = %x\n", _stringVal(pathName), handle); + printf("load %s handle = %x\n", __stringVal(pathName), handle); _ArrayInstPtr(aBuffer)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF ); @@ -1144,24 +1144,25 @@ #ifdef SYSV4_DL void *handle; + char *nm; if ((pathName == nil) || __isString(pathName)) { if (__isArray(aBuffer) && (_arraySize(aBuffer) == 2)) {; - if (pathName == nil) - handle = dlopen((char *)0, RTLD_NOW); - else - handle = dlopen(_stringVal(pathName), RTLD_NOW); + handle = dlopen(pathName == nil ? + (char *)0 : + __stringVal(pathName), + RTLD_NOW); if (! handle) { fprintf(stderr, "dlopen %s error: <%s>\n", - _stringVal(pathName), dlerror()); + __stringVal(pathName), dlerror()); ObjectFileLoader_LastError = @symbol(linkError); RETURN (nil); } if (ObjectFileLoader_Verbose == true) - printf("open %s handle = %x\n", _stringVal(pathName), handle); + printf("open %s handle = %x\n", __stringVal(pathName), handle); _ArrayInstPtr(aBuffer)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF ); @@ -1181,17 +1182,17 @@ if (pathName == nil) handle = dlopen((char *)0, 1); else - handle = dlopen(_stringVal(pathName), 1); + handle = dlopen(__stringVal(pathName), 1); if (! handle) { fprintf(stderr, "dlopen %s error: <%s>\n", - _stringVal(pathName), dlerror()); + __stringVal(pathName), dlerror()); ObjectFileLoader_LastError = @symbol(linkError); RETURN (nil); } if (ObjectFileLoader_Verbose == true) - printf("open %s handle = %x\n", _stringVal(pathName), handle); + printf("open %s handle = %x\n", __stringVal(pathName), handle); _ArrayInstPtr(aBuffer)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF ); @@ -1208,7 +1209,7 @@ NXStream *errOut; if (__isString(pathName)) { - files[0] = (char *) _stringVal(pathName); + files[0] = (char *) __stringVal(pathName); files[1] = (char *) 0; errOut = NXOpenFile(2, 2); result = rld_load(errOut, @@ -1218,12 +1219,12 @@ NXClose(errOut); if (! result) { ObjectFileLoader_LastError = @symbol(linkError); - fprintf(stderr, "rld_load %s failed\n", _stringVal(pathName)); + fprintf(stderr, "rld_load %s failed\n", __stringVal(pathName)); RETURN (nil); } if (ObjectFileLoader_Verbose == true) - printf("rld_load %s ok\n", _stringVal(pathName)); + printf("rld_load %s ok\n", __stringVal(pathName)); RETURN (pathName); } @@ -1263,9 +1264,9 @@ %{ #ifdef GNU_DL if (__isString(handle)) { - if (dld_unlink_by_file(_stringVal(handle), 1)) { + if (dld_unlink_by_file(__stringVal(handle), 1)) { if (ObjectFileLoader_Verbose == true) { - printf ("unlink file %s failed\n", _stringVal(handle)); + printf ("unlink file %s failed\n", __stringVal(handle)); dld_perror("cant unlink"); } RETURN (false); @@ -1423,7 +1424,7 @@ char *name; if (__isString(aString)) { - name = (char *) _stringVal(aString); + name = (char *) __stringVal(aString); if (isFunction == false) { addr = dld_get_symbol(name); } else { @@ -1470,8 +1471,8 @@ if (__isString(handle)) { if (ObjectFileLoader_Verbose == true) printf("get sym <%s> handle = %x\n", - _stringVal(aString), _stringVal(handle)); - addr = dl_getsymbol(_stringVal(handle), _stringVal(aString)); + __stringVal(aString), __stringVal(handle)); + addr = dl_getsymbol(__stringVal(handle), __stringVal(aString)); if (addr) { if (ObjectFileLoader_Verbose == true) printf("addr = %x\n", addr); @@ -1479,7 +1480,7 @@ hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF ); } else { if (ObjectFileLoader_Verbose == true) - printf("dl_getsymbol %s failed\n", _stringVal(aString)); + printf("dl_getsymbol %s failed\n", __stringVal(aString)); } } } @@ -1503,8 +1504,8 @@ h = (void *)(val); if (__isString(aString)) { if (ObjectFileLoader_Verbose == true) - printf("get sym <%s> handle = %x\n", _stringVal(aString), h); - addr = dlsym(h, (char *) _stringVal(aString)); + printf("get sym <%s> handle = %x\n", __stringVal(aString), h); + addr = dlsym(h, (char *) __stringVal(aString)); if (addr) { if (ObjectFileLoader_Verbose == true) printf("addr = %x\n", addr); @@ -1512,7 +1513,7 @@ hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF ); } else { if (ObjectFileLoader_Verbose == true) - printf("dlsym %s error: %s\n", _stringVal(aString), dlerror()); + printf("dlsym %s error: %s\n", __stringVal(aString), dlerror()); } } } @@ -1540,12 +1541,12 @@ if (__isString(aString)) { if (ObjectFileLoader_Verbose == true) printf("get sym <%s> handle = %x file = %s\n", - _stringVal(aString), h, _stringVal(fileName)); + __stringVal(aString), h, __stringVal(fileName)); - nl[0].n_name = _stringVal(aString); + nl[0].n_name = __stringVal(aString); nl[1].n_name = ""; - if (nlist(_stringVal(fileName), &nl) == -1) { + if (nlist(__stringVal(fileName), &nl) == -1) { if (ObjectFileLoader_Verbose == true) printf("nlist error\n"); } else { @@ -1575,8 +1576,8 @@ h = (void *)(val); if (__isString(aString)) { if (ObjectFileLoader_Verbose == true) - printf("get sym <%s> handle = %x\n", _stringVal(aString), h); - addr = dlsym(h, _stringVal(aString)); + printf("get sym <%s> handle = %x\n", __stringVal(aString), h); + addr = dlsym(h, __stringVal(aString)); if (addr) { if (ObjectFileLoader_Verbose == true) printf("addr = %x\n", addr); @@ -1584,7 +1585,7 @@ hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF ); } else { if (ObjectFileLoader_Verbose == true) - printf("dlsym %s error: %s\n", _stringVal(aString), dlerror()); + printf("dlsym %s error: %s\n", __stringVal(aString), dlerror()); } } } @@ -1597,10 +1598,10 @@ if (__isString(aString)) { if (ObjectFileLoader_Verbose == true) - printf("get sym <%s>\n", _stringVal(aString)); + printf("get sym <%s>\n", __stringVal(aString)); errOut = NXOpenFile(2, 2); result = rld_lookup(errOut, - (char *) _stringVal(aString), + (char *) __stringVal(aString), &addr); NXClose(errOut); if (result) { @@ -1823,7 +1824,6 @@ unsigned val; typedef void (*VOIDFUNC)(); int savInt; - extern int __immediateInterrupt__; int prevSpace, force; int arg = 0; int wasBlocked = 1; @@ -1839,10 +1839,6 @@ /* * allow function to be interrupted */ -#ifdef OLD - savInt = __immediateInterrupt__; - __immediateInterrupt__ = 1; -#endif if (interruptable != true) { wasBlocked = (__BLOCKINTERRUPTS() == true); } @@ -1864,9 +1860,6 @@ if (! wasBlocked) { __UNBLOCKINTERRUPTS(); } -#ifdef OLD - __immediateInterrupt__ = savInt; -#endif RETURN (self); } } @@ -1880,20 +1873,12 @@ %{ int savInt; - extern int __immediateInterrupt__; int prevSpace, force; int arg = 0; int wasBlocked = 1; extern OBJ __BLOCKINTERRUPTS(); if (_isSmallInteger(phase)) { - /* - * allow function to be interrupted - */ -#ifdef OLD - savInt = __immediateInterrupt__; - __immediateInterrupt__ = 1; -#endif if (interruptable != true) { wasBlocked = (__BLOCKINTERRUPTS() == true); } @@ -1912,9 +1897,6 @@ if (! wasBlocked) { __UNBLOCKINTERRUPTS(); } -#ifdef OLD - __immediateInterrupt__ = savInt; -#endif RETURN (self); } %}. @@ -1941,7 +1923,7 @@ RETURN (nil); } - fname = (char *) _stringVal(aFileName); + fname = (char *) __stringVal(aFileName); # if defined(A_DOT_OUT) && !defined(ELF) # if !defined(sco) && !defined(isc) @@ -1995,7 +1977,7 @@ RETURN ( nil ); } - fname = (char *) _stringVal(aFileName); + fname = (char *) __stringVal(aFileName); # if defined(A_DOT_OUT) && !defined(ELF) # if !defined(sco) && !defined(isc) @@ -2058,7 +2040,7 @@ # if defined(A_DOT_OUT) && !defined(ELF) # if !defined(sco) && !defined(isc) { - char *fname = (char *) _stringVal(aFileName); + char *fname = (char *) __stringVal(aFileName); unsigned taddr, daddr; unsigned tsize, dsize; unsigned toffset = 0; diff -r 3b0d380771e9 -r ccc7f9389a8e Parser.st --- a/Parser.st Mon Jul 03 04:38:59 1995 +0200 +++ b/Parser.st Sun Jul 23 04:24:56 1995 +0200 @@ -32,7 +32,8 @@ correctedSource' classVariableNames:'PrevClass PrevInstVarNames PrevClassVarNames PrevClassInstVarNames - LazyCompilation ArraysAreImmutable' + LazyCompilation ArraysAreImmutable + ImplicitSelfSends' poolDictionaries:'' category:'System-Compiler' ! @@ -41,7 +42,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.45 1995-07-03 02:38:44 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.46 1995-07-23 02:23:59 claus Exp $ '! !Parser class methodsFor:'documentation'! @@ -62,7 +63,7 @@ version " -$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.45 1995-07-03 02:38:44 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.46 1995-07-23 02:23:59 claus Exp $ " ! @@ -478,8 +479,9 @@ !Parser class methodsFor:'initialization '! initialize - LazyCompilation := false. "/ usually set to true in your .rc file - ArraysAreImmutable := false "/ usually left true for ST-80 compatibility + LazyCompilation := false. "/ usually set to true in your .rc file + ArraysAreImmutable := false. "/ usually left true for ST-80 compatibility + ImplicitSelfSends := false ! ! !Parser class methodsFor:'instance creation'! @@ -855,6 +857,25 @@ Compiler arraysAreImmutable:true Compiler arraysAreImmutable:false " +! + +implicitSelfSends + "return true if undefined variables with + lowercase first character are to be turned + into implicit self sends" + + ^ ImplicitSelfSends +! + +implicitSelfSends:aBoolean + "turn on/off implicit self sends" + + ImplicitSelfSends := aBoolean + + " + Compiler implicitSelfSends:true + Compiler implicitSelfSends:false + " ! ! !Parser methodsFor:'ST-80 compatibility'! @@ -2227,7 +2248,7 @@ classToCompileFor notNil ifTrue:[ "is it an instance-variable ?" - instIndex := (self instVarNames) indexOf:varName startingAt:1. + instIndex := (self instVarNames) lastIndexOf:varName. instIndex ~~ 0 ifTrue:[ parseForCode ifFalse:[self rememberInstVarUsed:varName]. ^ VariableNode type:#InstanceVariable @@ -2238,7 +2259,7 @@ "is it a class-instance-variable ?" - instIndex := (self classInstVarNames) indexOf:varName startingAt:1. + instIndex := (self classInstVarNames) lastIndexOf:varName. instIndex ~~ 0 ifTrue:[ aClass := self inWhichClassIsClassInstVar:varName. aClass notNil ifTrue:[ @@ -2252,13 +2273,12 @@ "is it a class-variable ?" - instIndex := (self classVarNames) indexOf:varName startingAt:1. + instIndex := (self classVarNames) lastIndexOf:varName. instIndex ~~ 0 ifTrue:[ aClass := self inWhichClassIsClassVar:varName. aClass notNil ifTrue:[ parseForCode ifFalse:[self rememberClassVarUsed:varName]. - ^ VariableNode type:#ClassVariable - name:(aClass name , ':' , varName) asSymbol + ^ VariableNode type:#ClassVariable class:aClass name:varName ] ] ]. @@ -2283,7 +2303,18 @@ (v == #Error) ifFalse:[^ v]. v := self correctVariable. (v == #Error) ifFalse:[^ v]. - parseForCode ifFalse:[self rememberGlobalUsed:tokenName]. + parseForCode ifFalse:[ + self rememberGlobalUsed:tokenName + ] ifTrue:[ + tokenName first isLowercase ifTrue:[ + ImplicitSelfSends ifTrue:[ + selfNode isNil ifTrue:[ + selfNode := SelfNode value:selfValue + ]. + ^ UnaryNode receiver:selfNode selector:('implicit_' , tokenName) asSymbol. + ] + ] + ]. ^ VariableNode type:#GlobalVariable name:tokenName asSymbol ! @@ -2324,6 +2355,17 @@ ^ nil ! +blockExpression + "parse a blockExpression; return a node-tree, nil or #Error. + Not used by ST/X's parser, but added for ST-80 compatibility." + + tokenType ~~ $[ ifTrue:[ + self syntaxError:'[ expected'. + ^ #Error. + ]. + ^ self block +! + block "parse a block; return a node-tree, nil or #Error" @@ -2829,7 +2871,7 @@ (self confirm:('confirm correction to: ' , newName)) ifFalse:[^ #Error] " ] ifFalse:[ - self notify:'no good correction found'. + self information:'no good correction found'. ^ #Error ]. @@ -2923,7 +2965,7 @@ newSelector := self askForCorrection:'correct selector to: ' fromList:suggestedNames. newSelector isNil ifTrue:[^ aSelectorString]. ] ifFalse:[ - self notify:'no good correction found'. + self information:'no good correction found'. ^ aSelectorString ]. diff -r 3b0d380771e9 -r ccc7f9389a8e ProgNodeBldr.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ProgNodeBldr.st Sun Jul 23 04:24:56 1995 +0200 @@ -0,0 +1,84 @@ +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" + +Object subclass:#ProgramNodeBuilder + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'System-Compiler ST-80-compatibility' +! + +ProgramNodeBuilder comment:' +COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + +$Header: /cvs/stx/stx/libcomp/Attic/ProgNodeBldr.st,v 1.1 1995-07-23 02:24:08 claus Exp $ +'! + +!ProgramNodeBuilder class methodsFor:'documentation'! + +copyright +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" +! + +version +" +$Header: /cvs/stx/stx/libcomp/Attic/ProgNodeBldr.st,v 1.1 1995-07-23 02:24:08 claus Exp $ +" +! + +documentation +" + This is a pure mimicri class. + It is not used by ST/X, but provided to support limited + compatibility for applications which build up codetrees, + knowing internals of ST-80's compiler class hierarchy. + This classes protocol is not (not meant to be) fully covering + the corresponding ST-80's classes protocol. It maps ST-80 messages + to corresponding ST/X messages (as far as possible). + + NO WARRANTY and GUARANTEE; this class may be removed without notice. +" +! ! + +!ProgramNodeBuilder methodsFor:'tree building'! + +newLiteralValue:aConstantValue + "return a treeNode for a literal constant" + + ^ ConstantNode value:aConstantValue +! + +newReturnValue:anExpressionNode + "return a treeNode for a method-return" + + ^ ReturnNode expression:anExpressionNode +! + +newMethodSelector:sel arguments:argVars temporaries:localVars statements:statementNodes + "mhmh - in ST/X we have no methodNodes ...." + ^ MethodNode new + selector:sel + arguments:argVars + locals:localVars + statements:statementNodes. +! ! diff -r 3b0d380771e9 -r ccc7f9389a8e ProgramNodeBuilder.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ProgramNodeBuilder.st Sun Jul 23 04:24:56 1995 +0200 @@ -0,0 +1,84 @@ +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" + +Object subclass:#ProgramNodeBuilder + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'System-Compiler ST-80-compatibility' +! + +ProgramNodeBuilder comment:' +COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + +$Header: /cvs/stx/stx/libcomp/ProgramNodeBuilder.st,v 1.1 1995-07-23 02:24:08 claus Exp $ +'! + +!ProgramNodeBuilder class methodsFor:'documentation'! + +copyright +" + COPYRIGHT (c) 1995 by Claus Gittinger + All Rights Reserved + + This software is furnished under a license and may be used + only in accordance with the terms of that license and with the + inclusion of the above copyright notice. This software may not + be provided or otherwise made available to, or used by, any + other person. No title to or ownership of the software is + hereby transferred. +" +! + +version +" +$Header: /cvs/stx/stx/libcomp/ProgramNodeBuilder.st,v 1.1 1995-07-23 02:24:08 claus Exp $ +" +! + +documentation +" + This is a pure mimicri class. + It is not used by ST/X, but provided to support limited + compatibility for applications which build up codetrees, + knowing internals of ST-80's compiler class hierarchy. + This classes protocol is not (not meant to be) fully covering + the corresponding ST-80's classes protocol. It maps ST-80 messages + to corresponding ST/X messages (as far as possible). + + NO WARRANTY and GUARANTEE; this class may be removed without notice. +" +! ! + +!ProgramNodeBuilder methodsFor:'tree building'! + +newLiteralValue:aConstantValue + "return a treeNode for a literal constant" + + ^ ConstantNode value:aConstantValue +! + +newReturnValue:anExpressionNode + "return a treeNode for a method-return" + + ^ ReturnNode expression:anExpressionNode +! + +newMethodSelector:sel arguments:argVars temporaries:localVars statements:statementNodes + "mhmh - in ST/X we have no methodNodes ...." + ^ MethodNode new + selector:sel + arguments:argVars + locals:localVars + statements:statementNodes. +! ! diff -r 3b0d380771e9 -r ccc7f9389a8e Scanner.st --- a/Scanner.st Mon Jul 03 04:38:59 1995 +0200 +++ b/Scanner.st Sun Jul 23 04:24:56 1995 +0200 @@ -35,7 +35,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.30 1995-07-03 02:38:54 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.31 1995-07-23 02:24:35 claus Exp $ '! !Scanner class methodsFor:'documentation'! @@ -56,7 +56,7 @@ version " -$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.30 1995-07-03 02:38:54 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.31 1995-07-23 02:24:35 claus Exp $ " ! @@ -224,6 +224,12 @@ " ! ! +!Scanner methodsFor:'ST-80 compatibility'! + +endOfLastToken + ^ source position +! ! + !Scanner methodsFor:'private'! initializeFor:aStringOrStream diff -r 3b0d380771e9 -r ccc7f9389a8e SourceFileLoader.st --- a/SourceFileLoader.st Mon Jul 03 04:38:59 1995 +0200 +++ b/SourceFileLoader.st Sun Jul 23 04:24:56 1995 +0200 @@ -23,7 +23,7 @@ version " -$Header: /cvs/stx/stx/libcomp/SourceFileLoader.st,v 1.4 1995-07-03 02:38:59 claus Exp $ +$Header: /cvs/stx/stx/libcomp/SourceFileLoader.st,v 1.5 1995-07-23 02:24:40 claus Exp $ " ! @@ -82,7 +82,16 @@ This is sent by the compiler/evaluator if it detects errors." ^ self +! +insertAndSelect:aString at:aCharacterPosition + "ST-80 compatible error notification during fileIn." + + " + will eventually open a TextBox here, showing the error .... + " + Transcript show:'===> '; showCr:aString. + ^ false ! ! !SourceFileLoader methodsFor:'private access'! diff -r 3b0d380771e9 -r ccc7f9389a8e SrcFLoader.st --- a/SrcFLoader.st Mon Jul 03 04:38:59 1995 +0200 +++ b/SrcFLoader.st Sun Jul 23 04:24:56 1995 +0200 @@ -23,7 +23,7 @@ version " -$Header: /cvs/stx/stx/libcomp/Attic/SrcFLoader.st,v 1.4 1995-07-03 02:38:59 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/SrcFLoader.st,v 1.5 1995-07-23 02:24:40 claus Exp $ " ! @@ -82,7 +82,16 @@ This is sent by the compiler/evaluator if it detects errors." ^ self +! +insertAndSelect:aString at:aCharacterPosition + "ST-80 compatible error notification during fileIn." + + " + will eventually open a TextBox here, showing the error .... + " + Transcript show:'===> '; showCr:aString. + ^ false ! ! !SourceFileLoader methodsFor:'private access'! diff -r 3b0d380771e9 -r ccc7f9389a8e StatNode.st --- a/StatNode.st Mon Jul 03 04:38:59 1995 +0200 +++ b/StatNode.st Sun Jul 23 04:24:56 1995 +0200 @@ -21,7 +21,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/Attic/StatNode.st,v 1.6 1994-11-28 20:58:31 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/StatNode.st,v 1.7 1995-07-23 02:24:45 claus Exp $ '! !StatementNode class methodsFor:'documentation'! @@ -42,7 +42,7 @@ version " -$Header: /cvs/stx/stx/libcomp/Attic/StatNode.st,v 1.6 1994-11-28 20:58:31 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/StatNode.st,v 1.7 1995-07-23 02:24:45 claus Exp $ " ! @@ -145,7 +145,7 @@ thisStatement := self. [thisStatement notNil] whileTrue:[ - i timesRepeat:[aStream space]. + aStream spaces:i. thisStatement printOn:aStream indent:i. thisStatement nextStatement notNil ifTrue:[ aStream nextPut:$.. diff -r 3b0d380771e9 -r ccc7f9389a8e StatementNode.st --- a/StatementNode.st Mon Jul 03 04:38:59 1995 +0200 +++ b/StatementNode.st Sun Jul 23 04:24:56 1995 +0200 @@ -21,7 +21,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/StatementNode.st,v 1.6 1994-11-28 20:58:31 claus Exp $ +$Header: /cvs/stx/stx/libcomp/StatementNode.st,v 1.7 1995-07-23 02:24:45 claus Exp $ '! !StatementNode class methodsFor:'documentation'! @@ -42,7 +42,7 @@ version " -$Header: /cvs/stx/stx/libcomp/StatementNode.st,v 1.6 1994-11-28 20:58:31 claus Exp $ +$Header: /cvs/stx/stx/libcomp/StatementNode.st,v 1.7 1995-07-23 02:24:45 claus Exp $ " ! @@ -145,7 +145,7 @@ thisStatement := self. [thisStatement notNil] whileTrue:[ - i timesRepeat:[aStream space]. + aStream spaces:i. thisStatement printOn:aStream indent:i. thisStatement nextStatement notNil ifTrue:[ aStream nextPut:$.. diff -r 3b0d380771e9 -r ccc7f9389a8e VarNode.st --- a/VarNode.st Mon Jul 03 04:38:59 1995 +0200 +++ b/VarNode.st Sun Jul 23 04:24:56 1995 +0200 @@ -21,7 +21,7 @@ COPYRIGHT (c) 1994 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/Attic/VarNode.st,v 1.4 1995-02-06 00:25:58 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/VarNode.st,v 1.5 1995-07-23 02:24:51 claus Exp $ '! !VariableNode class methodsFor:'documentation'! @@ -42,7 +42,7 @@ version " -$Header: /cvs/stx/stx/libcomp/Attic/VarNode.st,v 1.4 1995-02-06 00:25:58 claus Exp $ +$Header: /cvs/stx/stx/libcomp/Attic/VarNode.st,v 1.5 1995-07-23 02:24:51 claus Exp $ " ! @@ -62,6 +62,10 @@ ^ (self basicNew) type:t name:n ! +type:t class:class name:n + ^ (self basicNew) type:t class:class name:n +! + type:t index:i selfValue:s ^ (self basicNew) type:t index:i selfValue:s ! @@ -135,6 +139,13 @@ selfValue := s ! +type:t class:class name:n + type := t. + value := nil. + name := n. + selfClass := class +! + type:t name:n value:val type := t. name := n. @@ -183,15 +194,14 @@ !VariableNode methodsFor:'evaluating'! evaluate - (type == #MethodVariable) ifTrue:[ + (type == #MethodVariable + or:[type == #BlockArg + or:[type == #BlockVariable]]) ifTrue:[ ^ token variableValue ]. (type == #InstanceVariable) ifTrue:[ ^ selfValue instVarAt:index ]. - (type == #BlockArg) ifTrue:[ - ^ token variableValue - ]. (type == #GlobalVariable) ifTrue:[ (Smalltalk includesKey:name) ifTrue:[ ^ Smalltalk at:name @@ -203,11 +213,8 @@ ^ UndefinedVariable name:name. ^ nil ]. - (type == #BlockVariable) ifTrue:[ - ^ token variableValue - ]. (type == #ClassVariable) ifTrue:[ - ^ Smalltalk at:name + ^ Smalltalk at:(selfClass name , ':' , name) asSymbol ]. (type == #ClassInstanceVariable) ifTrue:[ ^ selfClass instVarAt:index @@ -221,7 +228,8 @@ ! store:aValue - (type == #MethodVariable) ifTrue:[ + (type == #MethodVariable + or:[type == #BlockVariable]) ifTrue:[ token value:aValue. ^ aValue ]. (type == #InstanceVariable) ifTrue:[ @@ -231,10 +239,7 @@ ^ Smalltalk at:name put:aValue ]. (type == #ClassVariable) ifTrue:[ - ^ Smalltalk at:name put:aValue - ]. - (type == #BlockVariable) ifTrue:[ - token value:aValue. ^ aValue + ^ Smalltalk at:(selfClass name , ':' , name) asSymbol put:aValue ]. (type == #ClassInstanceVariable) ifTrue:[ ^ selfClass instVarAt:index put:aValue @@ -262,8 +267,7 @@ pushMethodArg4) at:index). ^ self ]. - aStream nextPut:#pushMethodArg. - aStream nextPut:index. + aStream nextPut:#pushMethodArg; nextPut:index. ^ self ]. (type == #MethodVariable) ifTrue:[ @@ -276,8 +280,7 @@ pushMethodVar6) at:index). ^ self ]. - aStream nextPut:#pushMethodVar. - aStream nextPut:index. + aStream nextPut:#pushMethodVar; nextPut:index. ^ self ]. (type == #InstanceVariable) ifTrue:[ @@ -289,8 +292,7 @@ aStream nextPut:theCode. ^ self ]. - aStream nextPut:#pushInstVar. - aStream nextPut:index. + aStream nextPut:#pushInstVar; nextPut:index. ^ self ]. (type == #BlockArg) ifTrue:[ @@ -311,7 +313,6 @@ ^ self ]. aStream nextPut:#pushBlockArg. - aStream nextPut:index ] ifFalse:[ (deltaLevel == 1) ifTrue:[ aStream nextPut:#pushOuter1BlockArg @@ -319,32 +320,23 @@ (deltaLevel == 2) ifTrue:[ aStream nextPut:#pushOuter2BlockArg ] ifFalse:[ - aStream nextPut:#pushOuterBlockArg. - aStream nextPut:deltaLevel + aStream nextPut:#pushOuterBlockArg; nextPut:deltaLevel ] ]. - aStream nextPut:index ]. + aStream nextPut:index. ^ self ]. (type == #GlobalVariable) ifTrue:[ - aStream nextPut:#pushGlobal. - aStream nextPut:name. - aStream nextPut:0. "slot for generation " - aStream nextPut:0. "slot for cell address (4 byte) " - aStream nextPut:0. - aStream nextPut:0. - aStream nextPut:0. + aStream nextPut:#pushGlobal; nextPut:name. + "slot for generation and cell address (4 byte)" + aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0. ^ self ]. (type == #ClassVariable) ifTrue:[ - aStream nextPut:#pushClassVar. - aStream nextPut:name. - aStream nextPut:0. "slot for generation " - aStream nextPut:0. "slot for cell address (4 byte) " - aStream nextPut:0. - aStream nextPut:0. - aStream nextPut:0. + aStream nextPut:#pushClassVar; nextPut:(selfClass name , ':' , name) asSymbol. + "slot for generation and cell address (4 byte)" + aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0. ^ self ]. (type == #BlockVariable) ifTrue:[ @@ -360,17 +352,14 @@ (deltaLevel == 0) ifTrue:[ aStream nextPut:#pushBlockVar. - aStream nextPut:index ] ifFalse:[ - aStream nextPut:#pushOuterBlockVar. - aStream nextPut:deltaLevel. - aStream nextPut:index + aStream nextPut:#pushOuterBlockVar; nextPut:deltaLevel. ]. + aStream nextPut:index. ^ self ]. (type == #ClassInstanceVariable) ifTrue:[ - aStream nextPut:#pushClassInstVar. - aStream nextPut:index. + aStream nextPut:#pushClassInstVar; nextPut:index. ^ self ]. (type == #ThisContext) ifTrue:[ @@ -382,12 +371,11 @@ "not reached" self halt:'bad type'. - aStream nextPut:#pushLit. - aStream nextPut:value + aStream nextPut:#pushLit; nextPut:value ! codeStoreOn:aStream inBlock:codeBlock valueNeeded:valueNeeded - |theCode b deltaLevel| + |theCode b deltaLevel nm| valueNeeded ifTrue:[ aStream nextPut:#dup @@ -400,8 +388,7 @@ aStream nextPut:theCode. ^ self ]. - aStream nextPut:#storeMethodVar. - aStream nextPut:index. + aStream nextPut:#storeMethodVar; nextPut:index. ^ self ]. (type == #InstanceVariable) ifTrue:[ @@ -414,18 +401,13 @@ aStream nextPut:theCode. ^ self ]. - aStream nextPut:#storeInstVar. - aStream nextPut:index. + aStream nextPut:#storeInstVar; nextPut:index. ^ self ]. (type == #GlobalVariable) ifTrue:[ - aStream nextPut:#storeGlobal. - aStream nextPut:name. - aStream nextPut:0. "slot for generation " - aStream nextPut:0. "slot for cell address (4 byte) " - aStream nextPut:0. - aStream nextPut:0. - aStream nextPut:0. + aStream nextPut:#storeGlobal; nextPut:name. + "slot for generation and cell address (4 byte)" + aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0. ^ self ]. (type == #BlockVariable) ifTrue:[ @@ -440,28 +422,21 @@ ]. (deltaLevel == 0) ifTrue:[ - aStream nextPut:#storeBlockVar. - aStream nextPut:index + aStream nextPut:#storeBlockVar ] ifFalse:[ - aStream nextPut:#storeOuterBlockVar. - aStream nextPut:deltaLevel. - aStream nextPut:index + aStream nextPut:#storeOuterBlockVar; nextPut:deltaLevel ]. + aStream nextPut:index. ^ self ]. (type == #ClassVariable) ifTrue:[ - aStream nextPut:#storeClassVar. - aStream nextPut:name. - aStream nextPut:0. "slot for generation " - aStream nextPut:0. "slot for cell address (4 byte) " - aStream nextPut:0. - aStream nextPut:0. - aStream nextPut:0. + aStream nextPut:#storeClassVar; nextPut:(selfClass name , ':' , name) asSymbol. + "slot for generation and cell address (4 byte)" + aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0. ^ self ]. (type == #ClassInstanceVariable) ifTrue:[ - aStream nextPut:#storeClassInstVar. - aStream nextPut:index. + aStream nextPut:#storeClassInstVar; nextPut:index. ^ self ]. "cannot be reached" @@ -475,28 +450,15 @@ ! printOn:aStream indent:i - (type == #MethodArg) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #MethodVariable) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #InstanceVariable) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #BlockArg) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #GlobalVariable) ifTrue:[ - aStream nextPutAll:name.^ self - ]. - (type == #ClassVariable) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #BlockVariable) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #ClassInstanceVariable) ifTrue:[ + + (type == #MethodArg "/ actually only a debug-check + or:[type == #MethodVariable + or:[type == #InstanceVariable + or:[type == #BlockArg + or:[type == #GlobalVariable + or:[type == #ClassVariable + or:[type == #BlockVariable + or:[type == #ClassInstanceVariable]]]]]]]) ifTrue:[ aStream nextPutAll:name. ^ self ]. (type == #ThisContext) ifTrue:[ diff -r 3b0d380771e9 -r ccc7f9389a8e VariableNode.st --- a/VariableNode.st Mon Jul 03 04:38:59 1995 +0200 +++ b/VariableNode.st Sun Jul 23 04:24:56 1995 +0200 @@ -21,7 +21,7 @@ COPYRIGHT (c) 1994 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libcomp/VariableNode.st,v 1.4 1995-02-06 00:25:58 claus Exp $ +$Header: /cvs/stx/stx/libcomp/VariableNode.st,v 1.5 1995-07-23 02:24:51 claus Exp $ '! !VariableNode class methodsFor:'documentation'! @@ -42,7 +42,7 @@ version " -$Header: /cvs/stx/stx/libcomp/VariableNode.st,v 1.4 1995-02-06 00:25:58 claus Exp $ +$Header: /cvs/stx/stx/libcomp/VariableNode.st,v 1.5 1995-07-23 02:24:51 claus Exp $ " ! @@ -62,6 +62,10 @@ ^ (self basicNew) type:t name:n ! +type:t class:class name:n + ^ (self basicNew) type:t class:class name:n +! + type:t index:i selfValue:s ^ (self basicNew) type:t index:i selfValue:s ! @@ -135,6 +139,13 @@ selfValue := s ! +type:t class:class name:n + type := t. + value := nil. + name := n. + selfClass := class +! + type:t name:n value:val type := t. name := n. @@ -183,15 +194,14 @@ !VariableNode methodsFor:'evaluating'! evaluate - (type == #MethodVariable) ifTrue:[ + (type == #MethodVariable + or:[type == #BlockArg + or:[type == #BlockVariable]]) ifTrue:[ ^ token variableValue ]. (type == #InstanceVariable) ifTrue:[ ^ selfValue instVarAt:index ]. - (type == #BlockArg) ifTrue:[ - ^ token variableValue - ]. (type == #GlobalVariable) ifTrue:[ (Smalltalk includesKey:name) ifTrue:[ ^ Smalltalk at:name @@ -203,11 +213,8 @@ ^ UndefinedVariable name:name. ^ nil ]. - (type == #BlockVariable) ifTrue:[ - ^ token variableValue - ]. (type == #ClassVariable) ifTrue:[ - ^ Smalltalk at:name + ^ Smalltalk at:(selfClass name , ':' , name) asSymbol ]. (type == #ClassInstanceVariable) ifTrue:[ ^ selfClass instVarAt:index @@ -221,7 +228,8 @@ ! store:aValue - (type == #MethodVariable) ifTrue:[ + (type == #MethodVariable + or:[type == #BlockVariable]) ifTrue:[ token value:aValue. ^ aValue ]. (type == #InstanceVariable) ifTrue:[ @@ -231,10 +239,7 @@ ^ Smalltalk at:name put:aValue ]. (type == #ClassVariable) ifTrue:[ - ^ Smalltalk at:name put:aValue - ]. - (type == #BlockVariable) ifTrue:[ - token value:aValue. ^ aValue + ^ Smalltalk at:(selfClass name , ':' , name) asSymbol put:aValue ]. (type == #ClassInstanceVariable) ifTrue:[ ^ selfClass instVarAt:index put:aValue @@ -262,8 +267,7 @@ pushMethodArg4) at:index). ^ self ]. - aStream nextPut:#pushMethodArg. - aStream nextPut:index. + aStream nextPut:#pushMethodArg; nextPut:index. ^ self ]. (type == #MethodVariable) ifTrue:[ @@ -276,8 +280,7 @@ pushMethodVar6) at:index). ^ self ]. - aStream nextPut:#pushMethodVar. - aStream nextPut:index. + aStream nextPut:#pushMethodVar; nextPut:index. ^ self ]. (type == #InstanceVariable) ifTrue:[ @@ -289,8 +292,7 @@ aStream nextPut:theCode. ^ self ]. - aStream nextPut:#pushInstVar. - aStream nextPut:index. + aStream nextPut:#pushInstVar; nextPut:index. ^ self ]. (type == #BlockArg) ifTrue:[ @@ -311,7 +313,6 @@ ^ self ]. aStream nextPut:#pushBlockArg. - aStream nextPut:index ] ifFalse:[ (deltaLevel == 1) ifTrue:[ aStream nextPut:#pushOuter1BlockArg @@ -319,32 +320,23 @@ (deltaLevel == 2) ifTrue:[ aStream nextPut:#pushOuter2BlockArg ] ifFalse:[ - aStream nextPut:#pushOuterBlockArg. - aStream nextPut:deltaLevel + aStream nextPut:#pushOuterBlockArg; nextPut:deltaLevel ] ]. - aStream nextPut:index ]. + aStream nextPut:index. ^ self ]. (type == #GlobalVariable) ifTrue:[ - aStream nextPut:#pushGlobal. - aStream nextPut:name. - aStream nextPut:0. "slot for generation " - aStream nextPut:0. "slot for cell address (4 byte) " - aStream nextPut:0. - aStream nextPut:0. - aStream nextPut:0. + aStream nextPut:#pushGlobal; nextPut:name. + "slot for generation and cell address (4 byte)" + aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0. ^ self ]. (type == #ClassVariable) ifTrue:[ - aStream nextPut:#pushClassVar. - aStream nextPut:name. - aStream nextPut:0. "slot for generation " - aStream nextPut:0. "slot for cell address (4 byte) " - aStream nextPut:0. - aStream nextPut:0. - aStream nextPut:0. + aStream nextPut:#pushClassVar; nextPut:(selfClass name , ':' , name) asSymbol. + "slot for generation and cell address (4 byte)" + aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0. ^ self ]. (type == #BlockVariable) ifTrue:[ @@ -360,17 +352,14 @@ (deltaLevel == 0) ifTrue:[ aStream nextPut:#pushBlockVar. - aStream nextPut:index ] ifFalse:[ - aStream nextPut:#pushOuterBlockVar. - aStream nextPut:deltaLevel. - aStream nextPut:index + aStream nextPut:#pushOuterBlockVar; nextPut:deltaLevel. ]. + aStream nextPut:index. ^ self ]. (type == #ClassInstanceVariable) ifTrue:[ - aStream nextPut:#pushClassInstVar. - aStream nextPut:index. + aStream nextPut:#pushClassInstVar; nextPut:index. ^ self ]. (type == #ThisContext) ifTrue:[ @@ -382,12 +371,11 @@ "not reached" self halt:'bad type'. - aStream nextPut:#pushLit. - aStream nextPut:value + aStream nextPut:#pushLit; nextPut:value ! codeStoreOn:aStream inBlock:codeBlock valueNeeded:valueNeeded - |theCode b deltaLevel| + |theCode b deltaLevel nm| valueNeeded ifTrue:[ aStream nextPut:#dup @@ -400,8 +388,7 @@ aStream nextPut:theCode. ^ self ]. - aStream nextPut:#storeMethodVar. - aStream nextPut:index. + aStream nextPut:#storeMethodVar; nextPut:index. ^ self ]. (type == #InstanceVariable) ifTrue:[ @@ -414,18 +401,13 @@ aStream nextPut:theCode. ^ self ]. - aStream nextPut:#storeInstVar. - aStream nextPut:index. + aStream nextPut:#storeInstVar; nextPut:index. ^ self ]. (type == #GlobalVariable) ifTrue:[ - aStream nextPut:#storeGlobal. - aStream nextPut:name. - aStream nextPut:0. "slot for generation " - aStream nextPut:0. "slot for cell address (4 byte) " - aStream nextPut:0. - aStream nextPut:0. - aStream nextPut:0. + aStream nextPut:#storeGlobal; nextPut:name. + "slot for generation and cell address (4 byte)" + aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0. ^ self ]. (type == #BlockVariable) ifTrue:[ @@ -440,28 +422,21 @@ ]. (deltaLevel == 0) ifTrue:[ - aStream nextPut:#storeBlockVar. - aStream nextPut:index + aStream nextPut:#storeBlockVar ] ifFalse:[ - aStream nextPut:#storeOuterBlockVar. - aStream nextPut:deltaLevel. - aStream nextPut:index + aStream nextPut:#storeOuterBlockVar; nextPut:deltaLevel ]. + aStream nextPut:index. ^ self ]. (type == #ClassVariable) ifTrue:[ - aStream nextPut:#storeClassVar. - aStream nextPut:name. - aStream nextPut:0. "slot for generation " - aStream nextPut:0. "slot for cell address (4 byte) " - aStream nextPut:0. - aStream nextPut:0. - aStream nextPut:0. + aStream nextPut:#storeClassVar; nextPut:(selfClass name , ':' , name) asSymbol. + "slot for generation and cell address (4 byte)" + aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0. ^ self ]. (type == #ClassInstanceVariable) ifTrue:[ - aStream nextPut:#storeClassInstVar. - aStream nextPut:index. + aStream nextPut:#storeClassInstVar; nextPut:index. ^ self ]. "cannot be reached" @@ -475,28 +450,15 @@ ! printOn:aStream indent:i - (type == #MethodArg) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #MethodVariable) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #InstanceVariable) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #BlockArg) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #GlobalVariable) ifTrue:[ - aStream nextPutAll:name.^ self - ]. - (type == #ClassVariable) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #BlockVariable) ifTrue:[ - aStream nextPutAll:name. ^ self - ]. - (type == #ClassInstanceVariable) ifTrue:[ + + (type == #MethodArg "/ actually only a debug-check + or:[type == #MethodVariable + or:[type == #InstanceVariable + or:[type == #BlockArg + or:[type == #GlobalVariable + or:[type == #ClassVariable + or:[type == #BlockVariable + or:[type == #ClassInstanceVariable]]]]]]]) ifTrue:[ aStream nextPutAll:name. ^ self ]. (type == #ThisContext) ifTrue:[