--- a/BCompiler.st Wed Sep 13 14:06:27 1995 +0200
+++ b/BCompiler.st Fri Sep 15 01:31:18 1995 +0200
@@ -17,7 +17,7 @@
maxStackDepth
relocList'
classVariableNames:'JumpToAbsJump SequenceNumber STCCompilationFlags
- STCCompilation KeepSource'
+ STCCompilation KeepSource STCKeepCIntermediate'
poolDictionaries:''
category:'System-Compiler'
!
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.39 1995-09-12 10:45:39 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.40 1995-09-14 23:30:34 claus Exp $
'!
!ByteCodeCompiler class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.39 1995-09-12 10:45:39 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.40 1995-09-14 23:30:34 claus Exp $
"
!
@@ -508,25 +508,56 @@
"
!
-stcPath
- "return the path to the stc command, or nil if not found."
+stcPathOf:command
+ "return the path to an stc command, or nil if not found."
|f|
- ((f := '../../stc' asFilename construct:'stc')) isExecutable ifTrue:[
+ ((f := '../../stc' asFilename construct:command)) isExecutable ifTrue:[
^ f pathName
].
((OperatingSystem getEnvironment:'PATH')
asCollectionOfSubstringsSeparatedBy:$:) do:[:path |
- (f := (path asFilename construct:'stc')) isExecutable ifTrue:[
+ (f := (path asFilename construct:command)) isExecutable ifTrue:[
^ f pathName
].
].
^ nil
"
+ Compiler stcPathOf:'stc'
+ "
+
+ "Created: 13.9.1995 / 14:37:16 / claus"
+!
+
+stcPath
+ "return the path to the stc command, or nil if not found."
+
+ ^ self stcPathOf:'stc'
+
+ "
Compiler stcPath
"
+
+ "Modified: 13.9.1995 / 14:37:26 / claus"
+!
+
+incrementalStcPath
+ "return the path to the stc command for incremental method compilation,
+ or nil if not found."
+
+ |f|
+
+ (f := self stcPathOf:'stc') notNil ifTrue:[^ f].
+ ^ self stcPathOf:'demostc'
+
+ "
+ Compiler incrementalStcPath
+ "
+
+ "Created: 13.9.1995 / 14:36:36 / claus"
+ "Modified: 13.9.1995 / 15:15:04 / claus"
!
canCreateMachineCode
@@ -545,11 +576,13 @@
ObjectFileLoader canLoadObjectFiles ifFalse:[^ false].
"/ no chance, if no stc is available
- ^ self stcPath notNil
+ ^ self incrementalStcPath notNil
"
Compiler canCreateMachineCode
"
+
+ "Modified: 13.9.1995 / 15:15:11 / claus"
!
keepSource:aBoolean
@@ -592,7 +625,7 @@
genSymbolicCode
"traverse the parse-tree producing symbolicCode - return the codeArray"
- |codeStream thisStatement lastStatement|
+ |codeStream code thisStatement lastStatement|
litArray := nil.
codeStream := WriteStream on:(OrderedCollection new:100).
@@ -611,7 +644,9 @@
replace the previous drop by a retSelf
"
lastStatement notNil ifTrue:[
- codeStream contents last == #drop ifTrue:[
+ ((code := codeStream contents) notNil
+ and:[code size > 0
+ and:[code last == #drop]]) ifTrue:[
codeStream position:(codeStream position - 1).
codeStream nextPut:#retSelf
]
@@ -1534,10 +1569,14 @@
For a description of the arguments, see compile:forClass....."
|stFileName stream handle address flags command oFileName soFileName
- initName newMethod ok status className sep class stcPath|
+ initName newMethod ok status className sep class stcPath
+ errorStream errorMessages|
STCCompilation == #never ifTrue:[^ #Error].
- (stcPath := self class stcPath) isNil ifTrue:[^ #Error].
+ (stcPath := self class incrementalStcPath) isNil ifTrue:[
+ self parseError:'no stc compiler available - cannot create machine code' position:1.
+ ^ #Error
+ ].
SequenceNumber isNil ifTrue:[
SequenceNumber := 0.
@@ -1579,8 +1618,7 @@
stream nextPut:sep.
stream cr.
- stream nextPutAll:'"{ Line: 1 }"'; cr.
-
+ stream nextPutAll:'"{ Line: 0 }"'; cr.
stream nextPutAll:aString.
stream nextPut:sep; space; nextPut:sep.
@@ -1592,7 +1630,7 @@
oFileName := './' , initName , '.o'.
oFileName asFilename delete.
- flags := ' +sharedLibCode +newIncremental -N' , initName .
+ flags := ' +sharedLibCode +newIncremental -EerrorOutput -N' , initName .
STCCompilationFlags notNil ifTrue:[
flags := STCCompilationFlags , flags
].
@@ -1600,23 +1638,14 @@
command := stcPath , ' ' , flags , ' -c ' , stFileName.
"/ command printNL.
- ok := true.
- (OperatingSystem executeCommand:command) ifTrue:[
- status := OperatingSystem lastExecStatus.
+ ok := OperatingSystem executeCommand:command.
+ status := OperatingSystem lastExecStatus.
- "for debugging - leave c intermediate"
-"/ command := stcPath , ' ' , flags , ' -C ' , stFileName.
-"/ command printNL.
-"/ OperatingSystem executeCommand:command
- ] ifFalse:[
- status := OperatingSystem lastExecStatus.
-
- "for debugging - leave c intermediate"
+ "for debugging - leave c intermediate"
+ STCKeepCIntermediate == true ifTrue:[
command := stcPath , ' ' , flags , ' -C ' , stFileName.
command printNL.
- OperatingSystem executeCommand:command.
-
- ok := false.
+ OperatingSystem executeCommand:command
].
oFileName asFilename exists ifTrue:[
@@ -1630,10 +1659,32 @@
ok ifFalse:[
status >= 16r200 ifTrue:[
- self parseError:'STC error during compilation' position:1.
+ errorStream := 'errorOutput' asFilename readStream.
+ errorStream notNil ifTrue:[
+ errorMessages := errorStream contents.
+ errorMessages notNil ifTrue:[
+ errorMessages := errorMessages asStringCollection.
+ errorMessages size > 20 ifTrue:[
+ errorMessages := (errorMessages copyTo:20) copyWith:'... more messages skipped'
+ ].
+ errorMessages := errorMessages asString
+ ].
+ ].
+ errorMessages isNil ifTrue:[
+ errorMessages := ''
+ ].
+ self parseError:('STC error during compilation:\',errorMessages)withCRs position:1.
] ifFalse:[
self parseError:'oops, no STC - cannot create machine code' position:1.
].
+ OperatingSystem removeFile:stFileName.
+ ^ #Error
+ ].
+
+ (ObjectFileLoader notNil
+ and:[ObjectFileLoader canLoadObjectFiles]) ifFalse:[
+ self parseError:'no dynamic load configured - cannot load machine code' position:1.
+ OperatingSystem removeFile:stFileName.
^ #Error
].
@@ -1644,6 +1695,7 @@
soFileName := './' , initName , '.so'.
OperatingSystem executeCommand:'rm -f ' , soFileName.
OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName.
+ OperatingSystem removeFile:oFileName.
oFileName := soFileName.
] ifFalse:[
OperatingSystem getOSType = 'sys5.4' ifTrue:[
@@ -1653,14 +1705,11 @@
soFileName := './' , initName , '.so'.
OperatingSystem executeCommand:'rm -f ' , soFileName.
OperatingSystem executeCommand:'ld -G -o ' , soFileName , ' ' , oFileName.
+ OperatingSystem removeFile:oFileName.
oFileName := soFileName.
].
].
- ObjectFileLoader isNil ifTrue:[
- self parseError:'no dynamic load configured - cannot create machine code' position:1.
- ^ #Error
- ].
"/ ObjectFileLoader verbose:true.
"
@@ -1668,6 +1717,8 @@
"
handle := ObjectFileLoader loadDynamicObject:oFileName.
handle isNil ifTrue:[
+ OperatingSystem removeFile:stFileName.
+ OperatingSystem removeFile:oFileName.
self parseError:'dynamic load failed - cannot create machine code' position:1.
^ #Error
].
@@ -1677,6 +1728,8 @@
address isNil ifTrue:[
address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
address isNil ifTrue:[
+ OperatingSystem removeFile:stFileName.
+ OperatingSystem removeFile:oFileName.
self parseError:initName , '_Init() lookup failed - cannot create machine code' position:1.
^ #Error
]
@@ -1703,9 +1756,26 @@
Transcript showCr:(' compiled: ', className,' ',selector,' - machine code')
].
ObjectMemory flushCaches.
+
+ OperatingSystem removeFile:stFileName.
+
+ handle method:newMethod.
+
+ "/ check for obsolete loaded objects and unload them
+
+ ObjectFileLoader loadedObjectHandlesDo:[:anotherHandle |
+ anotherHandle isMethodHandle ifTrue:[
+ anotherHandle method isNil ifTrue:[
+ ObjectFileLoader unloadObjectFile:anotherHandle pathName.
+ OperatingSystem removeFile:anotherHandle pathName.
+ ]
+ ]
+ ].
^ newMethod.
].
+ OperatingSystem removeFile:stFileName.
+ OperatingSystem removeFile:oFileName.
self parseError:'dynamic load failed' position:1.
^ #Error
@@ -1744,6 +1814,8 @@
silent:false.
m inspect
"
+
+ "Modified: 14.9.1995 / 22:33:04 / claus"
!
trappingStubMethodFor:aString inCategory:cat