*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Sat, 10 Oct 2009 15:10:56 +0200
changeset 2598 2bb47a698d59
parent 2597 3f32d6e1c71f
child 2599 e8624fcf3c1b
*** empty log message ***
ProjectBuilder.st
--- a/ProjectBuilder.st	Sat Oct 10 12:50:15 2009 +0200
+++ b/ProjectBuilder.st	Sat Oct 10 15:10:56 2009 +0200
@@ -2,7 +2,7 @@
 
 Object subclass:#ProjectBuilder
 	instanceVariableNames:'package projectDefinitionClass sourceCodeManager buildDirectory
-		myWorkingDirectory mySTXTopDirectory'
+		myWorkingDirectory mySTXTopDirectory myTopDirectory'
 	classVariableNames:'PreviousBuildDirectory'
 	poolDictionaries:''
 	category:'System-Support-Projects'
@@ -47,7 +47,6 @@
     projectDefinitionClass loadExtensions.
     projectDefinitionClass loadAllClassesAsAutoloaded:false.
 
-self halt.
     module := package module.
     directory := package directory.
 
@@ -69,18 +68,21 @@
     ].
     sourceCodeManager := nil.
 
-    mySTXTopDirectory := 
+    myTopDirectory := 
         Smalltalk packagePath 
             detect:[:aPath |
                 (aPath asFilename / 'stx' / 'include') exists
                 and: [ (aPath asFilename / 'stx' / 'rules') exists ]]
             ifNone:nil.       
-    mySTXTopDirectory isNil ifTrue:[
-        self error:('Cannot figure out my top directory (where include and rules are)')
+    myTopDirectory isNil ifTrue:[
+        self error:('Cannot figure out my top directory (where stx/include and stx/rules are)')
     ].
+    myTopDirectory := myTopDirectory asFilename.
+    mySTXTopDirectory := myTopDirectory / 'stx'.
 
     self setupBuildDirectory.
     self generateSourceFiles.
+self halt.
 
     OperatingSystem
         executeCommand:(ParserFlags makeCommand)
@@ -102,17 +104,85 @@
 !
 
 copyDirectoryForBuild:subdir
-    |targetDir|
+    |targetDir targetFile|
 
     targetDir := buildDirectory / 'stx' / subdir.
     targetDir exists ifFalse:[
         targetDir makeDirectory.
-        (mySTXTopDirectory / subdir) directoryContentsAsFilenamesDo:[:eachFile |
-            eachFile isDirectory ifFalse:[
+    ].
+    (mySTXTopDirectory / subdir) directoryContentsAsFilenamesDo:[:eachFile |
+        eachFile isDirectory ifFalse:[
+            targetFile := targetDir / eachFile baseName.
+            (targetFile exists not
+            or:[ targetFile modificationTime < eachFile modificationTime ]) ifTrue:[
+                self activityNotification:'copying ',eachFile pathName,'...'.
                 eachFile copyTo:(targetDir construct:eachFile baseName)
             ]
         ].
     ].
+    self activityNotification:nil
+!
+
+createHeaderFileFor:aClass in:packageTargetDir
+    |instVarList classInstVarList classVarList bindings superclassFilename
+     template file newContents oldContents|
+
+    instVarList := StringCollection new.
+    aClass instVarNames do:[:v |
+        instVarList add:('OBJ %1;' bindWith:v)
+    ].
+    classInstVarList := StringCollection new.
+    aClass class instVarNames do:[:v |
+(v includes:$_) ifTrue:[self halt].
+        classInstVarList add:('OBJ %1;' bindWith:v)
+    ].
+    classVarList := StringCollection new.
+    aClass classVarNames do:[:v |
+        classVarList add:('extern OBJ %1_%2;' bindWith:aClass name with:v)
+    ].
+
+    bindings := Dictionary new.
+    bindings at:'ClassName' put:aClass name. 
+    aClass superclass isNil ifTrue:[
+        bindings at:'SuperclassName' put:'-'. 
+        bindings at:'SuperclassFileInclude' put:nil.
+    ] ifFalse:[
+        bindings at:'SuperclassName' put:aClass superclass name. 
+        bindings at:'SuperclassFileName' put:(superclassFilename := Smalltalk fileNameForClass:aClass superclass).
+        bindings at:'SuperclassFileInclude' put:('#include "%1.STH"' bindWith:superclassFilename).
+    ].
+    bindings at:'InstVarList' put:instVarList asString. 
+    bindings at:'ClassVarList' put:classVarList asString. 
+    bindings at:'ClassInstVarList' put:classInstVarList asString. 
+
+    template := 
+'/* This file was generated by ProjectBuilder. */
+/* !!!!!!!! Do not change by hand !!!!!!!! */
+
+/* Class: %(ClassName) */
+/* Superclass: %(SuperclassName) */
+
+%(SuperclassFileInclude)
+
+/* INDIRECTGLOBALS */
+#ifdef _HEADER_INST_
+%(InstVarList)
+#endif /* _HEADER_INST_ */
+
+#ifdef _HEADER_CLASS_
+%(ClassVarList)
+#endif /* _HEADER_CLASS_ */
+
+#ifdef _HEADER_CLASSINST_
+%(ClassInstVarList)
+#endif /* _HEADER_CLASSINST_ */
+'.
+    newContents := template bindWithArguments:bindings.
+    file := packageTargetDir asFilename / ((Smalltalk fileNameForClass:aClass),'.STH').
+    (file exists not
+    or:[ (oldContents := file contents) ~= newContents ]) ifTrue:[
+        file contents: newContents.
+    ].
 !
 
 generateSourceFiles
@@ -178,24 +248,64 @@
     ].
 
     "/ file out the package(s)
-
-    ((Array with:package) , (projectDefinitionClass allPreRequisites))
+    ((Array with:package))
     do:[:eachPackageToFileout |
-        |packageModule packageDirectory packageTargetDir|
+        |packageId packageModule packageDirectory packageTargetDir packageDef|
 
-        packageModule := eachPackageToFileout asPackageId module.
-        packageDirectory := eachPackageToFileout asPackageId directory.
+        packageId := eachPackageToFileout asPackageId.
+        packageModule := packageId module.
+        packageDirectory := packageId directory.
         packageTargetDir := (buildDirectory / packageModule / packageDirectory) recursiveMakeDirectory.
 
-        (Smalltalk allClassesInPackage:eachPackageToFileout) do:[:cls |
-            cls isPrivate ifFalse:[
-                cls isLoaded ifFalse:[
-                    self halt.
-                    cls autoload.
-                ].
-                cls fileOutIn:packageTargetDir
-            ]
+        packageDef := packageId projectDefinitionClass.
+        (packageDef compiled_classNames_common ,
+        packageDef compiled_classNamesForPlatform) do:[:eachClassName |
+            |cls|
+
+            cls := Smalltalk classNamed:eachClassName.
+            self assert:cls isLoaded.
+            cls fileOutIn:packageTargetDir
         ].
+
+"/        (Smalltalk allClassesInPackage:eachPackageToFileout) do:[:cls |
+"/            cls isPrivate ifFalse:[
+"/                cls isLoaded ifFalse:[
+"/                    self halt.
+"/                    cls autoload.
+"/                ].
+"/                cls fileOutIn:packageTargetDir
+"/            ]
+"/        ].
+    ].
+    "/ generate header files...
+    (projectDefinitionClass allPreRequisites)
+    do:[:eachPackageToFileout |
+        |packageId packageDef packageModule packageDirectory packageTargetDir|
+
+        packageId := eachPackageToFileout asPackageId.
+        packageModule := packageId module.
+        packageDirectory := packageId directory.
+        packageTargetDir := (buildDirectory / packageModule / packageDirectory) recursiveMakeDirectory.
+
+        packageDef := packageId projectDefinitionClass.
+        (packageDef compiled_classNames_common ,
+        packageDef compiled_classNamesForPlatform) do:[:eachClassName |
+            |cls|
+
+            cls := Smalltalk classNamed:eachClassName.
+            self assert:cls isLoaded.
+            cls isLoaded ifTrue:[    
+                self createHeaderFileFor:cls in:packageTargetDir
+            ].
+        ].
+
+"/        (Smalltalk allClassesInPackage:eachPackageToFileout) do:[:cls |
+"/            cls isPrivate ifFalse:[
+"/                cls isLoaded ifTrue:[
+"/                    self createHeaderFileFor:cls in:packageTargetDir
+"/                ]
+"/            ]
+"/        ].
     ].
 
 "/    "/ copy h-files preRequisite packages