--- a/BCompiler.st Thu Aug 03 03:25:58 1995 +0200
+++ b/BCompiler.st Tue Aug 08 03:06:10 1995 +0200
@@ -17,7 +17,7 @@
maxStackDepth
relocList'
classVariableNames:'JumpToAbsJump SequenceNumber STCCompilationFlags
- ForceSTCCompilation ForceNoSTCCompilation KeepSource'
+ STCCompilation KeepSource'
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.27 1995-07-23 02:22:57 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.28 1995-08-08 01:05:52 claus Exp $
'!
!ByteCodeCompiler class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.27 1995-07-23 02:22:57 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.28 1995-08-08 01:05:52 claus Exp $
"
!
@@ -284,10 +284,13 @@
(compiler errorFlag or:[tree == #Error]) ifTrue:[
"/ compiler parseError:'syntax error'.
Transcript show:' '.
+ aClass notNil ifTrue:[
+ Transcript show:aClass name , '>>'
+ ].
sel notNil ifTrue:[
- Transcript show:(sel ,' ')
+ Transcript show:(sel)
].
- Transcript showCr:'syntax error'.
+ Transcript showCr:' -> Error'.
^ #Error
].
@@ -301,7 +304,7 @@
freak-out support ...
"
(compiler hasPrimitiveCode
- or:[ForceSTCCompilation == true and:[sel ~~ #doIt]]) ifTrue:[
+ or:[STCCompilation == #always and:[sel ~~ #doIt]]) ifTrue:[
newMethod := compiler
compileToMachineCode:aString
forClass:aClass
@@ -462,33 +465,89 @@
"
!
-forceSTCCompilation:aBoolean
- "if true, methods are always compiled to machine code (which takes
- longer, but provides faster code). If false, compilation is
- to bytecode except for methods containing primitive code.
+stcCompilation
+ "return the flag which controls compilation to machine code.
+ If #always, methods are always compiled to machine code (which takes
+ longer, but provides faster code). If #none, methods are never compiled
+ to machine code, instead for non-primitive ones, compilation is to bytecode
+ and for primitive ones, a trapping stub is generated.
+ Anything else lets the compiler compile to bytecode,
+ except for methods containing primitive code.
+ This can be set from your private.rc file or from a workspace
+ for selective compilation to machine code."
+
+ ^ STCCompilation
+
+ "
+ Compiler stcCompilation
+ "
+!
+
+stcCompilation:how
+ "set the flag which controls compilation to machine code.
+ If #always, methods are always compiled to machine code (which takes
+ longer, but provides faster code). If #none, methods are never compiled
+ to machine code, instead for non-primitive ones, compilation is to bytecode
+ and for primitive ones, a trapping stub is generated.
+ Anything else lets the compiler compile to bytecode,
+ except for methods containing primitive code.
This can be set from your private.rc file or from a workspace
for selective compilation to machine code."
- ForceSTCCompilation := aBoolean
+ STCCompilation := how
"
- Compiler forceSTCCompilation:true.
- Compiler forceSTCCompilation:false.
+ Compiler stcCompilation:#always
+ Compiler stcCompilation:#never
+ Compiler stcCompilation:#default
"
!
-forceNoSTCCompilation:aBoolean
- "if true, methods are never compiled to machine code, instead a trap
- method which reports an erro is created for primitive methods.
- If false, compilation is to machinecode for methods containing primitive code.
- This can be set from your private.rc file or from a workspace
- for selective compilation to machine code."
+stcPath
+ "return the path to the stc command, or nil if not found."
+
+ |f|
- ForceNoSTCCompilation := aBoolean
+ ((f := '../../stc' asFilename construct:'stc')) isExecutable ifTrue:[
+ ^ f pathName
+ ].
+ ((OperatingSystem getEnvironment:'PATH')
+ asCollectionOfSubstringsSeparatedBy:$:) do:[:path |
+ (f := (path asFilename construct:'stc')) isExecutable ifTrue:[
+ ^ f pathName
+ ].
+ ].
+ ^ nil
"
- Compiler forceNoSTCCompilation:true.
- Compiler forceNoSTCCompilation:false.
+ Compiler stcPath
+ "
+!
+
+canCreateMachineCode
+ "return true, if compilation to machine code is supported.
+ Currently, all SYSV4 and Linux systems do so
+ (due to the need for dynamic loading of object files).
+
+ However, if no compiler is around (i.e. the demo distribution),
+ there is no chance ..."
+
+ |canDo|
+
+ canDo := false.
+ OperatingSystem getSystemType = 'iris' ifTrue:[
+ canDo := true.
+ ].
+ OperatingSystem getSystemType = 'linux' ifTrue:[
+ canDo := true.
+ ].
+ canDo ifTrue:[
+ ^ self stcPath notNil
+ ].
+ ^ false
+
+ "
+ Compiler canCreateMachineCode
"
!
@@ -1433,9 +1492,13 @@
For a description of the arguments, see compile:forClass....."
|stFileName stream handle address flags command oFileName soFileName
- initName newMethod ok status className sep|
+ initName newMethod ok status className sep class stcPath|
- ForceNoSTCCompilation == true ifTrue:[^ #Error].
+ STCCompilation == #never ifTrue:[^ #Error].
+ stcPath := self class stcPath.
+ stcPath isNil ifTrue:[
+ ^ #Error
+ ].
SequenceNumber isNil ifTrue:[
SequenceNumber := 0.
@@ -1447,16 +1510,20 @@
stream := stFileName asFilename writeStream.
sep := stream class chunkSeparator.
- aClass allSuperclasses reverseDo:[:cls|
+ class := aClass.
+ class isMeta ifTrue:[
+ class := aClass soleInstance
+ ].
+ class allSuperclasses reverseDo:[:cls|
cls ~~ Object ifTrue:[
cls fileOutDefinitionOn:stream.
stream nextPut:sep; cr.
]
].
- aClass fileOutDefinitionOn:stream.
+ class fileOutDefinitionOn:stream.
stream nextPut:sep; cr.
- aClass fileOutPrimitiveDefinitionsOn:stream.
+ class fileOutPrimitiveDefinitionsOn:stream.
stream nextPut:sep.
className := aClass name.
@@ -1483,31 +1550,31 @@
oFileName := './' , initName , '.o'.
oFileName asFilename delete.
- flags := ' +newIncremental -N' , initName .
+ flags := ' +sharedLibCode +newIncremental -N' , initName .
STCCompilationFlags notNil ifTrue:[
flags := STCCompilationFlags , flags
].
- command := 'stc ' , flags , ' -c ' , stFileName.
+ command := stcPath , ' ' , flags , ' -c ' , stFileName.
"/ command printNL.
ok := true.
(OperatingSystem executeCommand:command) ifTrue:[
+ status := OperatingSystem lastExecStatus.
+
"for debugging - leave c intermediate"
-"/ command := 'stc ' , flags , ' -C ' , stFileName.
+"/ command := stcPath , ' ' , flags , ' -C ' , stFileName.
"/ command printNL.
"/ OperatingSystem executeCommand:command
] ifFalse:[
- command := '../../stc/stc ' , flags , ' -c ' , stFileName.
- Transcript showCr:command.
- (OperatingSystem executeCommand:command) ifTrue:[
- "for debugging - leave c intermediate"
-"/ command := '../../stc/stc ' , flags , ' -C ' , stFileName.
-"/ command printNL.
-"/ OperatingSystem executeCommand:command
- ] ifFalse:[
- ok := false.
- ]
+ status := OperatingSystem lastExecStatus.
+
+ "for debugging - leave c intermediate"
+ command := stcPath , ' ' , flags , ' -C ' , stFileName.
+ command printNL.
+ OperatingSystem executeCommand:command.
+
+ ok := false.
].
oFileName asFilename exists ifTrue:[
@@ -1520,11 +1587,10 @@
].
ok ifFalse:[
- status := OperatingSystem lastExecStatus.
status >= 16r200 ifTrue:[
self parseError:'STC error during compilation' position:1.
] ifFalse:[
- self parseError:'no STC - cannot compile primitive code' position:1.
+ self parseError:'oops, no STC - cannot compile primitive code' position:1.
].
^ #Error
].
@@ -1650,8 +1716,8 @@
lits := Array withAll:lits.
newMethod literals:lits
].
- newMethod code:(Method compiledMethodAt:#invalidCodeObject) code.
- newMethod byteCode:(Method compiledMethodAt:#invalidCodeObject) byteCode.
+ newMethod code:(Method compiledMethodAt:#uncompiledCodeObject) code.
+ newMethod byteCode:(Method compiledMethodAt:#uncompiledCodeObject) byteCode.
newMethod numberOfMethodVars:(self numberOfMethodVars).
newMethod numberOfMethodArgs:(self numberOfMethodArgs).
newMethod source:aString.