.
--- 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
! !
--- 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.
--- 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
! !
--- /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
+! !
--- 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:[
--- 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:[
--- 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.
"
! !
--- 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.
"
! !
--- 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::
--- /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.
+ ].
+! !
--- /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.
+"
+! !
+
+
--- 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;
--- 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;
--- 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
].
--- /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.
+! !
--- /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.
+! !
--- 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
--- 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'!
--- 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'!
--- 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:$..
--- 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:$..
--- 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:[
--- 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:[