STCCompilerInterface.st
branchjv
changeset 4723 524785227024
parent 4652 c945656beeba
parent 4712 3c2662449b4c
--- a/STCCompilerInterface.st	Sat Aug 08 22:49:53 2020 +0100
+++ b/STCCompilerInterface.st	Tue Aug 25 12:20:06 2020 +0100
@@ -142,7 +142,11 @@
 #   define CC_DEFINE     "__CLANG__"
 #  else
 #   ifdef __GNUC__
-#    define CC_DEFINE     "__GNUC__"
+    // https://expeccoalm.exept.de/D252306
+    // must not redefine __GNUC__, because gcc defines this anyway with the gcc version 
+    // contained in this macro (which is used by glibc includes).
+    // also defined in STCCompilerInterface class >> #getCCDefine
+#    define CC_DEFINE     "STX__GNUC__"
 #   else
 #    define CC_DEFINE     "__CC__"
 #   endif
@@ -154,6 +158,8 @@
     "
      STCCompilerInterface getCCDefine
     "
+
+    "Modified: / 11-05-2018 / 10:12:47 / stefan"
 !
 
 getCPUDefine
@@ -161,7 +167,7 @@
      compiled, and which should be passed down when compiling methods.
      For example, on a 386 (and successors), this may be '-D__x86__'; 
      on a vax, this would be '-D__vax__'.
-          This is normally not of interest to 'normal' users; however, it is passed
+     This is normally not of interest to 'normal' users; however, it is passed
      down to the c-compiler when methods are incrementally compiled to machine code.
      Do not use this for CPU determination; only to pass on to stc for compilation.
      (see OperatingSystem getCPUType for this)"
@@ -274,6 +280,9 @@
 
 initialize
     Verbose := false.
+    KeepIntermediateFiles := false.
+
+    "Modified: / 11-05-2018 / 09:34:34 / stefan"
 ! !
 
 !STCCompilerInterface methodsFor:'accessing'!
@@ -296,7 +305,7 @@
         ]
     ].
     (cmd notNil and:[cmd includes:Character space]) ifTrue:[
-        cmd := '"' , cmd , '"'.
+        cmd := cmd withDoubleQuotes.
     ].
     ^ cmd
 
@@ -319,8 +328,10 @@
 !STCCompilerInterface methodsFor:'error raising'!
 
 parseError:messageText position:position
-    originator parseError:messageText position:position.
-    "not normally reached"
+    originator notNil ifTrue:[
+        originator parseError:messageText position:position.
+        "not normally reached"
+    ].
     ParseError raiseErrorString:messageText.
 ! !
 
@@ -334,9 +345,64 @@
      As you already see, this takes some time and is therefore ONLY done for code containing prims;
      all pure smalltalk code is compiled to bytecode and jitted by the VM."
 
+    ^ self 
+        compileToMachineCode:aString forClass:aClass selector:selector inCategory:categoryArg 
+        notifying:requestorArg install:install skipIfSame:skipIfSame silent:silent
+        generateCOnly:false
+
+    "
+     |m|
+
+     Object subclass:#Test
+            instanceVariableNames:''
+            classVariableNames:''
+            poolDictionaries:''
+            category:'tests'.
+     m := ByteCodeCompiler
+            compile:'foo ^ ''hello'''
+            forClass:Test
+            inCategory:'tests'
+            notifying:nil
+            install:false
+            skipIfSame:false.
+     m inspect
+    "
+    "
+     |m|
+
+     Object subclass:#Test
+            instanceVariableNames:''
+            classVariableNames:''
+            poolDictionaries:''
+            category:'tests'.
+     m := ByteCodeCompiler
+            compileToMachineCode:'foo %{ RETURN (_MKSMALLINT(1)); %}'
+            forClass:Test
+            inCategory:'tests'
+            notifying:nil
+            install:false
+            skipIfSame:false
+            silent:false.
+     m inspect
+    "
+
+    "Modified: / 14-09-1995 / 22:33:04 / claus"
+    "Modified: / 17-09-2011 / 10:39:25 / cg"
+    "Modified: / 16-05-2018 / 13:48:25 / stefan"
+!
+
+compileToMachineCode:aString forClass:aClass selector:selector inCategory:categoryArg 
+                             notifying:requestorArg install:install skipIfSame:skipIfSame silent:silent
+                             generateCOnly:generateCOnly
+    "this is called to compile primitive code.
+     It saves the code to a tmporary, calls stc to create C-code, compiles it, links
+     it to a tiny little dll and loads it.
+     As you already see, this takes some time and is therefore ONLY done for code containing prims;
+     all pure smalltalk code is compiled to bytecode and jitted by the VM."
+
     |handle oldMethod newMethod ok dllFileName|
 
-    install ifFalse:[
+    (install not and:[generateCOnly not]) ifTrue:[
         "/ cannot do it uninstalled. reason:
         "/ if it is loaded twice, the first version could be unloaded by
         "/ finalization, which would also unload the second version
@@ -382,13 +448,17 @@
                     self reportCompilationErrorFor:stcPath fromFile:errorFile
                 ].
 
-        parserFlags stcKeepSIntermediate ifTrue:[ 
+        (generateCOnly or:[parserFlags stcKeepSIntermediate]) ifTrue:[ 
             self compileToS_onError:[:errorFile | ]
         ].
+        generateCOnly ifTrue:[
+            ^ cFileName asFilename
+        ].
+
         "/ now compile to machine code
         ok := self 
                 compileToObj_onError:[:errorFile |
-                    self reportCompilationErrorFor:ccPath fromFile:errorFile.
+                    self reportCompilationErrorFor:ccPath, cFlags fromFile:errorFile.
                 ].
 
         originator activityNotification:''.
@@ -424,7 +494,7 @@
         originator activityNotification:''.
 
         handle isNil ifTrue:[
-            KeepIntermediateFiles ~~ true ifTrue:[ OperatingSystem removeFile:dllFileName ].
+            KeepIntermediateFiles ifFalse:[ dllFileName asFilename remove ].
             "catch, so that #CannotLoad processing is done"
             ParseError catch:[
                 originator parseError:'dynamic load of machine code failed' position:1.
@@ -498,40 +568,41 @@
             ^ newMethod.
         ].
 
-        "/ OperatingSystem removeFile:moduleFileName.
+        "/ moduleFileName asFilename remove.
         self parseError:'dynamic load failed' position:1.
     ] ensure:[
-        KeepIntermediateFiles == true ifTrue:[ 
-            Transcript showCR:'keeping files'
-        ] ifFalse:[
-            parserFlags stcKeepSTIntermediate ifTrue:[
-                Transcript showCR:'keeping st file: ', stFileName asFilename pathName
+        generateCOnly ifFalse:[
+            KeepIntermediateFiles ifTrue:[ 
+                Transcript showCR:'keeping files'
             ] ifFalse:[
-                OperatingSystem removeFile:stFileName.
-                OperatingSystem removeFile:'errorOutput'.
-            ].
-            cFileName notNil ifTrue:[
-                parserFlags stcKeepCIntermediate == true ifTrue:[
-                    Transcript showCR:'keeping c file: ', cFileName asFilename pathName
+                parserFlags stcKeepSTIntermediate ifTrue:[
+                    Transcript showCR:'keeping st file: ', stFileName asFilename pathName
                 ] ifFalse:[
-                    OperatingSystem removeFile:cFileName.
-                ]
-            ].
-            oFileName notNil ifTrue:[
-                parserFlags stcKeepOIntermediate == true ifTrue:[
-                    Transcript showCR:'keeping o file: ', oFileName asFilename pathName
-                ] ifFalse:[
-                    OperatingSystem removeFile:oFileName.
+                    stFileName asFilename remove.
+                ].
+                cFileName notNil ifTrue:[
+                    parserFlags stcKeepCIntermediate == true ifTrue:[
+                        Transcript showCR:'keeping c file: ', cFileName asFilename pathName
+                    ] ifFalse:[
+                        cFileName asFilename remove.
+                    ]
                 ].
-            ].
-"/            OperatingSystem isMSDOSlike ifTrue:[
-"/                mapFileName notNil ifTrue:[
-"/                   OperatingSystem removeFile:mapFileName.
-"/                ].
-"/                libFileName notNil ifTrue:[
-"/                   OperatingSystem removeFile:libFileName.
-"/                ].
-"/            ].
+                oFileName notNil ifTrue:[
+                    parserFlags stcKeepOIntermediate == true ifTrue:[
+                        Transcript showCR:'keeping o file: ', oFileName asFilename pathName
+                    ] ifFalse:[
+                        oFileName asFilename remove.
+                    ].
+                ].
+    "/            OperatingSystem isMSDOSlike ifTrue:[
+    "/                mapFileName notNil ifTrue:[
+    "/                   mapFileName asFilename remove.
+    "/                ].
+    "/                libFileName notNil ifTrue:[
+    "/                   libFileName asFilename remove.
+    "/                ].
+    "/            ].
+            ]
         ]
     ].
 
@@ -572,8 +643,8 @@
     "
 
     "Modified: / 14-09-1995 / 22:33:04 / claus"
-    "Modified: / 19-03-1999 / 08:31:42 / stefan"
     "Modified: / 17-09-2011 / 10:39:25 / cg"
+    "Modified: / 16-05-2018 / 13:48:25 / stefan"
 ! !
 
 !STCCompilerInterface methodsFor:'machine code generation-helpers'!
@@ -584,13 +655,13 @@
 
     |command ok errorOutputFile|
 
-    command := (self possiblyQuotedPath:stcPath) , ' ' , stcFlags 
-                , ' -E:',(self possiblyQuotedPath:(Filename tempDirectory / 'lastIncrStcErrorOutput') pathName)
-                , ' -defdir=', (self possiblyQuotedPath:cFileName asFilename directory pathName).
+    command := (Filename possiblyQuotedPathname:stcPath) , ' ' 
+                , stcFlags 
+                , ' -defdir=', (Filename possiblyQuotedPathname:cFileName asFilename directory pathName).
     cFileName asFilename suffix ~= 'c' ifTrue:[
         command := command , ' -cSuffix=',cFileName asFilename suffix.
     ].
-    command := command , ' -C ' , (self possiblyQuotedPath:stFileName asFilename pathName).
+    command := command , ' -C ' , (Filename possiblyQuotedPathname:stFileName asFilename pathName).
 
     Verbose == true ifTrue:[
         Transcript show:'executing: '; showCR:command.
@@ -600,6 +671,7 @@
 
     errorOutputFile := Filename tempDirectory / 'stcErrorOutput'. 
     errorOutputFile writingFileDo:[:errorStream |
+        errorStream nextPutAll:'Command: '; nextPutLine:command; cr; flush.
         ok := OperatingSystem 
                     executeCommand:command 
                     inputFrom:nil
@@ -635,7 +707,9 @@
     ^ ok
 
     "Created: / 07-11-2006 / 12:11:24 / cg"
-    "Modified: / 08-08-2011 / 22:12:01 / cg"
+    "Modified: / 16-05-2018 / 13:49:01 / stefan"
+    "Modified: / 28-03-2019 / 16:17:03 / Claus Gittinger"
+    "Modified: / 16-06-2020 / 19:08:12 / cg"
 !
 
 compileToExe_onError:aBlock 
@@ -644,7 +718,7 @@
 
     |command errorOutputFile ok|
 
-    command := (self possiblyQuotedPath:ccPath) , ' ' , cFlags , ' -D__INCREMENTAL_COMPILE__ ' , (self possiblyQuotedPath:cFileName).
+    command := (Filename possiblyQuotedPathname:ccPath) , ' ' , cFlags , ' -D__INCREMENTAL_COMPILE__ ' , (Filename possiblyQuotedPathname:cFileName).
 
     Verbose == true ifTrue:[
         Transcript show:'executing: ' showCR:command.
@@ -673,6 +747,8 @@
         errorOutputFile remove.
     ].
     ^ ok
+
+    "Modified: / 28-03-2019 / 16:17:06 / Claus Gittinger"
 !
 
 compileToObj_onError:aBlock
@@ -695,11 +771,11 @@
         commandTemplate := '%1 %2%3 -D__INCREMENTAL_COMPILE__ -o %4 -c %5'.
     ].
     command := commandTemplate
-                    bindWith:(self possiblyQuotedPath:ccPath) 
+                    bindWith:(Filename possiblyQuotedPathname:ccPath) 
                     with:cFlags
                     with:ccDefine
-                    with:(self possiblyQuotedPath:oFileName)
-                    with:(self possiblyQuotedPath:cFileName).
+                    with:(Filename possiblyQuotedPathname:oFileName)
+                    with:(Filename possiblyQuotedPathname:cFileName).
 
     Verbose == true ifTrue:[
         Transcript show:'executing: '; showCR:command.
@@ -765,6 +841,7 @@
 
     "Created: / 07-11-2006 / 12:14:51 / cg"
     "Modified: / 04-01-2016 / 21:12:56 / jv"
+    "Modified: / 28-03-2019 / 16:17:10 / Claus Gittinger"
 !
 
 compileToS_onError:aBlock
@@ -773,7 +850,7 @@
 
     |command errorOutputFile ok|
 
-    command := (self possiblyQuotedPath:ccPath) , ' ' , cFlags , ' -D__INCREMENTAL_COMPILE__ -S ' , (self possiblyQuotedPath:cFileName).
+    command := (Filename possiblyQuotedPathname:ccPath) , ' ' , cFlags , ' -D__INCREMENTAL_COMPILE__ -S ' , (Filename possiblyQuotedPathname:cFileName).
 
     Verbose == true ifTrue:[
         Transcript show:'executing: '; showCR:command.
@@ -801,6 +878,8 @@
         errorOutputFile remove.
     ].
     ^ ok
+
+    "Modified: / 28-03-2019 / 16:17:13 / Claus Gittinger"
 !
 
 ensureExternalToolsArePresent
@@ -929,7 +1008,7 @@
 
     [
         stream := stFileName asFilename writeStream.
-    ] on:FileStream openErrorSignal do:[:ex|
+    ] on:OpenError do:[:ex|
         self parseError:'cannot create temporary sourcefile for compilation' position:1.
         ^ #CannotLoad
     ].
@@ -975,7 +1054,12 @@
 
     className := theNonMetaclassToCompileFor name.
     ns := theNonMetaclassToCompileFor topNameSpace.
-    (ns notNil and:[ns ~= Smalltalk and:[nsName := ns name. className startsWith:(nsName,'::')]]) ifTrue:[
+    
+    (ns notNil 
+      and:[ns ~= Smalltalk 
+      and:[nsName := ns name. 
+           className startsWith:(nsName,'::')
+    ]]) ifTrue:[
         className := className copyFrom:nsName size+2+1.
         "/ split to avoid being regognized as a directive
         stream nextPutLine:('"','{ NameSpace: ',nsName,' }"').
@@ -996,35 +1080,74 @@
     stream close.
 
     "Modified: / 08-08-2011 / 23:23:10 / cg"
-!
-
-possiblyQuotedPath:aPath
-    (aPath includes:Character space) ifTrue:[
-        (aPath startsWith:$") ifFalse:[
-            ^ '"',aPath,'"'
-        ]
-    ].
-    ^ aPath
+    "Modified (format): / 08-08-2018 / 08:58:35 / Claus Gittinger"
 !
 
 reportCompilationErrorFor:aCommand
-    |eMsg errorMessages lNr|
+    <resource: #obsolete>
+    self obsoleteMethodWarning.
+    ^ self reportCompilationErrorFor:aCommand fromFile:'errorOutput' asFilename.
+
+    "Created: / 07-11-2006 / 12:29:04 / cg"
+    "Modified: / 21-12-2013 / 00:08:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 11-05-2018 / 09:29:20 / stefan"
+!
+
+reportCompilationErrorFor:aCommand fromFile:anErrorFilename
+    |eMsg errorMessages errorMessagesColorized lNr cFile stFile|
 
     (executionStatus notNil and:[executionStatus couldNotExecute]) ifTrue:[
         eMsg := 'oops, no %1 - cannot create machine code' bindWith:aCommand.
     ] ifFalse:[
-        errorMessages := 'errorOutput' asFilename contents collect:[:l | OperatingSystem decodePathOrCommandOutput: l ].
-        OperatingSystem removeFile:'errorOutput'.
+        errorMessages := anErrorFilename contents 
+                            collect:[:l | OperatingSystem decodePathOrCommandOutput: l ].
+
+        "/ replace the filename string
+        cFile := cFileName asFilename name.
+        stFile := stFileName asFilename name.
+        errorMessages := errorMessages 
+            collect:[:line |
+                (line startsWith:cFile) ifTrue:[
+                    cFileName asFilename baseName,(line copyFrom:cFile size+1)
+                ] ifFalse:[
+                    (line startsWith:stFile) ifTrue:[
+                        stFileName asFilename baseName,(line copyFrom:stFile size+1)
+                    ] ifFalse:[
+                        line
+                    ].
+                ].
+            ].
+
+        errorMessagesColorized := 
+            errorMessages collect:[:line |
+                (line includesString:'warning:' caseSensitive:false) ifTrue:[
+                    line withColor:Color orange
+                ] ifFalse:[
+                    (line includesString:'error:' caseSensitive:false) ifTrue:[
+                        line allRed
+                    ] ifFalse:[
+                        line
+                    ]
+                ]
+            ].
+        Transcript showCR:errorMessagesColorized asString.
 
         errorMessages notNil ifTrue:[
-            errorMessages := errorMessages reject:[:line | line includesString:'Warning:'].
-
+            errorMessages := errorMessages reject:[:line | line includesString:'Note:' caseSensitive:false].
+            errorMessages size > 20 ifTrue:[
+                errorMessages := errorMessages reject:[:line | line startsWith:'Note ' caseSensitive:false].
+            ].
             errorMessages size > 20 ifTrue:[
-                errorMessages := errorMessages select:[:line | line asLowercase startsWith:'error'].
+                errorMessages := errorMessages reject:[:line | line includesString:'Warning:' caseSensitive:false].
+                errorMessages size > 20 ifTrue:[
+                    errorMessages := errorMessages reject:[:line | line startsWith:'Warning ' caseSensitive:false].
+                ].
                 errorMessages size > 20 ifTrue:[
-                    errorMessages := (errorMessages copyTo:20) copyWith:'... more messages skipped'
+                    "/ errorMessages := errorMessages select:[:line | line asLowercase startsWith:'error'].
+                    errorMessages size > 20 ifTrue:[
+                        errorMessages := (errorMessages copyTo:20) copyWith:'... more messages skipped'
+                    ].
                 ].
-            ].
 "/                    errorMessages := errorMessages collect:[:line |
 "/                        (line startsWith:(stFileName , ':')) ifTrue:[
 "/                            'Line: ' , (line copyFrom:(stFileName size + 2))
@@ -1032,74 +1155,8 @@
 "/                            line
 "/                        ]
 "/                      ].
-        ].
-        errorMessages isNil ifTrue:[
-            errorMessages := #('')
-        ].
-        errorMessages := (Array with:'Failed to execute: "', aCommand,'"') , errorMessages.
-
-        "/ try to extract a line number"
-        (errorMessages contains:[:line | line includesString:'Borland']) ifTrue:[
-            |i i2 s|
-            i := errorMessages findFirst:[:l | l startsWith:(cFileName,':')].
-            i ~~ 0 ifTrue:[
-                ((errorMessages at:i+1) startsWith:'Error') ifTrue:[
-                    i2 := (errorMessages at:i+1) indexOfSubCollection:(stFileName).
-                    i2 ~~ 0 ifTrue:[
-                        s := (errorMessages at:i+1) copyFrom:(i2+stFileName size+1).
-                        s := s readStream.
-                        lNr := Integer readFrom:s.
-                        s skipSeparators.
-                    ].    
-                ]
             ].
         ].
-
-        errorMessages isEmpty ifTrue:[
-            eMsg := 'Error during compilation:\\Unspecified error (no output)' withCRs
-        ] ifFalse:[
-            eMsg := 'Error during compilation:\\' withCRs ,
-                    (errorMessages asStringCollection asString).
-        ].
-    ].
-
-    originator activityNotification:''.
-
-    ParseError new
-        lineNumber:lNr;
-        errorMessage:eMsg;
-        raise.
-
-    "Created: / 07-11-2006 / 12:29:04 / cg"
-    "Modified: / 21-12-2013 / 00:08:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-reportCompilationErrorFor:aCommand fromFile:anErrorFilename
-    |eMsg errorMessages lNr|
-
-    (executionStatus notNil and:[executionStatus couldNotExecute]) ifTrue:[
-        eMsg := 'oops, no %1 - cannot create machine code' bindWith:aCommand.
-    ] ifFalse:[
-        errorMessages := anErrorFilename contents 
-                            collect:[:l | OperatingSystem decodePathOrCommandOutput: l ].
-        Transcript showCR:errorMessages asString.
-        errorMessages notNil ifTrue:[
-            errorMessages := errorMessages reject:[:line | line includesString:'Warning:'].
-
-            errorMessages size > 20 ifTrue:[
-                "/ errorMessages := errorMessages select:[:line | line asLowercase startsWith:'error'].
-                errorMessages size > 20 ifTrue:[
-                    errorMessages := (errorMessages copyTo:20) copyWith:'... more messages skipped'
-                ].
-            ].
-"/                    errorMessages := errorMessages collect:[:line |
-"/                        (line startsWith:(stFileName , ':')) ifTrue:[
-"/                            'Line: ' , (line copyFrom:(stFileName size + 2))
-"/                        ] ifFalse:[
-"/                            line
-"/                        ]
-"/                      ].
-        ].
         errorMessages isNil ifTrue:[
             errorMessages := #('')
         ].
@@ -1141,6 +1198,7 @@
     "Modified: / 21-12-2013 / 00:08:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 25-02-2017 / 09:58:18 / cg"
     "Modified (format): / 25-02-2017 / 19:33:58 / cg"
+    "Modified: / 01-10-2018 / 09:18:53 / Claus Gittinger"
 !
 
 setupCompilationCommandArguments
@@ -1149,7 +1207,7 @@
     parserFlags isNil ifTrue:[ parserFlags := ParserFlags new].
 
     stFn := stFileName asFilename.
-    oFileName := stFn nameWithoutSuffix , (ObjectFileLoader objectFileExtension).
+    oFileName := (stFn withSuffix:(ObjectFileLoader objectFileSuffix)) name.
     cFileName := (stFn withSuffix:'c') name. 
 "/    ParserFlags useBorlandC ifTrue:[
 "/        cFileName := (stFn withSuffix:'sc') name. 
@@ -1158,6 +1216,7 @@
     cFileName asFilename remove.
 
     "/ stcFlags := '-commonSymbols +sharedLibCode +newIncremental -E:errorOutput -N' , initName .
+    stcFlags := '+newIncremental +opt +optInline'.
     stcFlags := '+newIncremental'.
     initName notEmptyOrNil ifTrue:[
         stcFlags := stcFlags,' -N' , initName .
@@ -1197,7 +1256,7 @@
     ].
 
     "Created: / 07-11-2006 / 12:24:47 / cg"
-    "Modified: / 07-11-2006 / 13:58:54 / cg"
+    "Modified: / 16-06-2020 / 19:07:43 / cg"
     "Modified: / 09-12-2015 / 17:00:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !