VM: Three new special objects added to keep track of the builds version number, git...

Conflicts:
	Nmakefile
	basis/ui/tools/listener/listener.factor
	core/alien/strings/strings.factor

diff --git a/GNUmakefile b/GNUmakefile
index b4ccd5f7b71807fc7625942f02ef590f6077e195..a9fd8304f25bb9ac3de6f8945c68468020dc7110 100644 (file)
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -1,12 +1,16 @@
 ifdef CONFIG
        VERSION = 0.97
 ifdef CONFIG
        VERSION = 0.97

+       GIT_LABEL = $(shell git describe --all --long)

 
        BUNDLE = Factor.app
        LIBPATH = -L/usr/X11R6/lib
 
        include $(CONFIG)
 
 
        BUNDLE = Factor.app
        LIBPATH = -L/usr/X11R6/lib
 
        include $(CONFIG)
 

-       CFLAGS = -Wall $(SITE_CFLAGS)
+       CFLAGS = -Wall \
+               -DFACTOR_VERSION="$(VERSION)" \
+               -DFACTOR_GIT_LABEL="$(GIT_LABEL)" \
+               $(SITE_CFLAGS)

 
        ifdef DEBUG
                CFLAGS += -g -DFACTOR_DEBUG
 
        ifdef DEBUG
                CFLAGS += -g -DFACTOR_DEBUG

diff --git a/Nmakefile b/Nmakefile
index 02dbfd4fa981f1cad874a4a1b662cf8a59682164..1f69fd8a2972fea2bdc5e54685ccc460939e8e26 100644 (file)
--- a/Nmakefile
+++ b/Nmakefile
@@ -2,12 +2,25 @@
 BOOTIMAGE_VERSION = latest
 !ENDIF
 
 BOOTIMAGE_VERSION = latest
 !ENDIF
 

+!IF !DEFINED(VERSION)
+VERSION = version-missing
+!ENDIF
+
+!IF !DEFINED(GIT_LABEL)
+GIT_LABEL = git-label-missing
+!ENDIF
+

 !IF DEFINED(PLATFORM)
 
 LINK_FLAGS = /nologo shell32.lib
 !IF DEFINED(PLATFORM)
 
 LINK_FLAGS = /nologo shell32.lib

-CL_FLAGS = /nologo /O2 /WX /W3 /D_CRT_SECURE_NO_WARNINGS
+CL_FLAGS = /nologo /O2 /WX /W3 /D_CRT_SECURE_NO_WARNINGS /DFACTOR_VERSION=$(VERSION) /DFACTOR_GIT_LABEL=$(GIT_LABEL)

 CL_FLAGS_VISTA = /D_WIN32_WINNT=0x0600
 
 CL_FLAGS_VISTA = /D_WIN32_WINNT=0x0600
 

+!IF DEFINED(DEBUG)
+LINK_FLAGS = $(LINK_FLAGS) /DEBUG
+CL_FLAGS = $(CL_FLAGS) /Zi /DFACTOR_DEBUG
+!ENDIF
+

 !IF "$(PLATFORM)" == "x86-32"
 LINK_FLAGS = $(LINK_FLAGS) /safeseh
 PLAF_DLL_OBJS = vm\os-windows-x86.32.obj vm\safeseh.obj vm\cpu-x86.obj
 !IF "$(PLATFORM)" == "x86-32"
 LINK_FLAGS = $(LINK_FLAGS) /safeseh
 PLAF_DLL_OBJS = vm\os-windows-x86.32.obj vm\safeseh.obj vm\cpu-x86.obj

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 8b01ca58e4527da6f22eb80f39d2ad230ceb7bb5..64aa11253a6107ca0ffe4dd04b17413ac557057e 100644 (file)
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -6,7 +6,7 @@ concurrency.mailboxes continuations destructors documents
 documents.elements fry hashtables help help.markup help.tips io
 io.styles kernel lexer listener locals make math models
 models.arrow models.delay namespaces parser prettyprint
 documents.elements fry hashtables help help.markup help.tips io
 io.styles kernel lexer listener locals make math models
 models.arrow models.delay namespaces parser prettyprint

-quotations sequences source-files.errors strings threads
+quotations sequences source-files.errors strings system threads

 tools.errors.model ui ui.commands ui.gadgets ui.gadgets.buttons
 ui.gadgets.editors ui.gadgets.glass ui.gadgets.labeled
 ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar
 tools.errors.model ui ui.commands ui.gadgets ui.gadgets.buttons
 ui.gadgets.editors ui.gadgets.glass ui.gadgets.labeled
 ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar


@@ -392,7 +392,8 @@ interactor "completion" f {
 
 : introduction. ( -- )
     tip-of-the-day. nl
 
 : introduction. ( -- )
     tip-of-the-day. nl

-    { $strong "Press " { $snippet "F1" } " at any time for help." } print-content nl nl ;
+    { $strong "Press " { $snippet "F1" } " at any time for help." } print-content nl
+    version-info print-content nl nl ;

 
 : listener-thread ( listener -- )
     dup listener-streams [
 
 : listener-thread ( listener -- )
     dup listener-streams [

diff --git a/build-support/factor.cmd b/build-support/factor.cmd
index 6b58fd29ca9e7900ca37450f157d74c7e747e284..98f545d4edcc61e4881057ba127115c31299c940 100644 (file)
--- a/build-support/factor.cmd
+++ b/build-support/factor.cmd
@@ -27,6 +27,11 @@ if not errorlevel 1 (
     ) else goto nocl\r
 )\r
 \r
     ) else goto nocl\r
 )\r
 \r

+git describe --all --long > git_label.tmp\r
+set /p git_label= < git_label.tmp\r
+\r
+set version=0.97\r
+\r

 if %_bootimage_version%==clean (\r
     set _git_branch=clean-windows-%_target%\r
     set _bootimage_path=clean/windows-%_target%\r
 if %_bootimage_version%==clean (\r
     set _git_branch=clean-windows-%_target%\r
     set _bootimage_path=clean/windows-%_target%\r


@@ -87,4 +92,3 @@ echo     If clean is specified, then the working copy is updated to the
 echo     upstream "clean-windows-*" branch corresponding to the current\r
 echo     platform and the corresponding boot image is downloaded.\r
 goto :EOF\r
 echo     upstream "clean-windows-*" branch corresponding to the current\r
 echo     platform and the corresponding boot image is downloaded.\r
 goto :EOF\r

-\r

diff --git a/build-support/factor.sh b/build-support/factor.sh
index 8b11038cab6723718e5feadb556b9afff951faac..96fa04c235b4521e2b5fa1402a0a113333f70879 100755 (executable)
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -342,7 +342,7 @@ parse_build_info() {
     OS=`echo $1 | cut -d '-' -f 1`
     ARCH=`echo $1 | cut -d '-' -f 2`
     WORD=`echo $1 | cut -d '-' -f 3`
     OS=`echo $1 | cut -d '-' -f 1`
     ARCH=`echo $1 | cut -d '-' -f 2`
     WORD=`echo $1 | cut -d '-' -f 3`

-    
+

     if [[ $OS == linux && $ARCH == ppc ]] ; then WORD=32; fi
     if [[ $OS == linux && $ARCH == arm ]] ; then WORD=32; fi
     if [[ $OS == macosx && $ARCH == ppc ]] ; then WORD=32; fi
     if [[ $OS == linux && $ARCH == ppc ]] ; then WORD=32; fi
     if [[ $OS == linux && $ARCH == arm ]] ; then WORD=32; fi
     if [[ $OS == macosx && $ARCH == ppc ]] ; then WORD=32; fi


@@ -394,7 +394,7 @@ update_script() {
 }
 
 update_script_changed() {
 }
 
 update_script_changed() {

-    invoke_git diff --stat `invoke_git merge-base HEAD FETCH_HEAD` FETCH_HEAD | grep 'build-support.factor\.sh' >/dev/null 
+    invoke_git diff --stat `invoke_git merge-base HEAD FETCH_HEAD` FETCH_HEAD | grep 'build-support.factor\.sh' >/dev/null

 }
 
 git_fetch_factorcode() {
 }
 
 git_fetch_factorcode() {

diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor
index c14a8a5cd46b6ac2657fcab3cd909d28727e4a56..63ea05bb1cab7216de010c885e349980fb394b77 100644 (file)
--- a/core/alien/strings/strings.factor
+++ b/core/alien/strings/strings.factor
@@ -84,11 +84,18 @@ M: sequence string>symbol [ utf8 string>alien ] map ;
     utf8 alien>string ;
 
 GENERIC: symbol>string ( symbol(s) -- string )
     utf8 alien>string ;
 
 GENERIC: symbol>string ( symbol(s) -- string )

+
+: special-object>string ( n -- str )
+    special-object (symbol>string) ;
+

 M: byte-array symbol>string (symbol>string) ;
 M: array symbol>string [ (symbol>string) ] map ", " join ;
 
 [
 M: byte-array symbol>string (symbol>string) ;
 M: array symbol>string [ (symbol>string) ] map ", " join ;
 
 [

-    OBJ-CPU special-object utf8 alien>string string>cpu \ cpu set-global
-    OBJ-OS special-object utf8 alien>string string>os \ os set-global
-    OBJ-VM-COMPILER special-object utf8 alien>string \ vm-compiler set-global
+    OBJ-CPU special-object>string string>cpu \ cpu set-global
+    OBJ-OS special-object>string string>os \ os set-global
+    OBJ-VERSION special-object>string \ version set-global
+    OBJ-GIT-LABEL special-object>string \ git-label set-global
+    OBJ-VM-COMPILER special-object>string \ vm-compiler set-global
+    OBJ-VM-COMPILE-TIME special-object>string \ vm-compile-time set-global

 ] "alien.strings" add-startup-hook
 ] "alien.strings" add-startup-hook

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 5ef3cfe6b59132242865d83857d2b15b7c5d12eb..9eecbb2a027e43ba76d612100832fc88e661dede 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -352,6 +352,11 @@ CONSTANT: OBJ-WAITING-CALLBACKS 73
 
 CONSTANT: OBJ-SIGNAL-PIPE 74
 
 
 CONSTANT: OBJ-SIGNAL-PIPE 74
 

+CONSTANT: OBJ-VM-COMPILE-TIME 75
+
+CONSTANT: OBJ-VERSION 76
+CONSTANT: OBJ-GIT-LABEL 77
+

 ! Context object count and identifiers must be kept in sync with:
 !   vm/contexts.hpp
 
 ! Context object count and identifiers must be kept in sync with:
 !   vm/contexts.hpp
 

diff --git a/core/system/system.factor b/core/system/system.factor
index 595c439f0cc6fe7e76cf01442a840b26dff185e2..f59bf7ff5533261cf65ae49a7750d0ca12f53864 100644 (file)
--- a/core/system/system.factor
+++ b/core/system/system.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.

-USING: assocs init kernel.private namespaces ;
+USING: assocs init kernel kernel.private namespaces strings sequences ;

 IN: system
 
 SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;
 IN: system
 
 SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;


@@ -16,25 +16,44 @@ UNION: unix macosx linux ;
 
 : os ( -- class ) \ os get-global ; foldable
 
 
 : os ( -- class ) \ os get-global ; foldable
 

+: version ( -- string ) \ version get-global ; foldable
+
+: git-label ( -- string ) \ git-label get-global ; foldable
+

 : vm-compiler ( -- string ) \ vm-compiler get-global ; foldable
 
 : vm-compiler ( -- string ) \ vm-compiler get-global ; foldable
 

+: vm-compile-time ( -- string ) \ vm-compile-time get-global ; foldable
+

 <PRIVATE
 
 <PRIVATE
 

+CONSTANT: string>cpu-hash H{
+    { "x86.32" x86.32 }
+    { "x86.64" x86.64 }
+    { "arm" arm }
+    { "ppc.32" ppc.32 }
+    { "ppc.64" ppc.64 }
+}
+
+CONSTANT: string>os-hash H{
+    { "windows" windows }
+    { "macosx" macosx }
+    { "linux" linux }
+}
+
+: key-for-value ( key hash -- val )
+    >alist [ first2 nip = ] with filter first first ;
+

 : string>cpu ( str -- class )
 : string>cpu ( str -- class )

-    H{
-        { "x86.32" x86.32 }
-        { "x86.64" x86.64 }
-        { "arm" arm }
-        { "ppc.32" ppc.32 }
-        { "ppc.64" ppc.64 }
-    } at ;
+    string>cpu-hash at ;
+
+: cpu>string ( class -- str )
+    string>cpu-hash key-for-value ;

 
 : string>os ( str -- class )
 
 : string>os ( str -- class )

-    H{
-        { "windows" windows }
-        { "macosx" macosx }
-        { "linux" linux }
-    } at ;
+    string>os-hash at ;
+
+: os>string ( class -- str )
+    string>os-hash key-for-value ;

 
 PRIVATE>
 
 
 PRIVATE>
 


@@ -45,3 +64,9 @@ PRIVATE>
 : embedded? ( -- ? ) OBJ-EMBEDDED special-object ;
 
 : exit ( n -- * ) do-shutdown-hooks (exit) ;
 : embedded? ( -- ? ) OBJ-EMBEDDED special-object ;
 
 : exit ( n -- * ) do-shutdown-hooks (exit) ;

+
+: version-info ( -- str )
+    ! formatting vocab not available in this context.
+    "Factor " version append " (" append git-label append ", " append
+    vm-compile-time append ") [" append vm-compiler append
+    " " append cpu cpu>string append "] on " append os os>string append ;

diff --git a/vm/factor.cpp b/vm/factor.cpp
index 1343114973c24feac275443d60b3dcbe04e49f13..4cab92ea3d9b7561059aca350c351d91edd4d0a0 100644 (file)
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -152,6 +152,12 @@ void factor_vm::init_factor(vm_parameters* p) {
   special_objects[OBJ_EMBEDDED] = false_object;
   special_objects[OBJ_VM_COMPILER] =
       allot_alien(false_object, (cell)FACTOR_COMPILER_VERSION);
   special_objects[OBJ_EMBEDDED] = false_object;
   special_objects[OBJ_VM_COMPILER] =
       allot_alien(false_object, (cell)FACTOR_COMPILER_VERSION);

+  special_objects[OBJ_VM_COMPILE_TIME] =
+      allot_alien(false_object, (cell)FACTOR_COMPILE_TIME);
+  special_objects[OBJ_VERSION] =
+      allot_alien(false_object, (cell)FACTOR_STRINGIZE(FACTOR_VERSION));
+  special_objects[OBJ_GIT_LABEL] =
+      allot_alien(false_object, (cell)FACTOR_STRINGIZE(FACTOR_GIT_LABEL));

 
   /* We can GC now */
   gc_off = false;
 
   /* We can GC now */
   gc_off = false;

diff --git a/vm/master.hpp b/vm/master.hpp
index bb1fb6247ba37f51f52c9403cdc0fe575fdece0b..67289dd1170e4bbfd58b14f1eb4de1bc78e8fd03 100644 (file)
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -51,6 +51,9 @@
 #define FACTOR_COMPILER_VERSION "unknown"
 #endif
 
 #define FACTOR_COMPILER_VERSION "unknown"
 #endif
 

+/* Record compilation time */
+#define FACTOR_COMPILE_TIME __TIMESTAMP__
+

 /* Detect target CPU type */
 #if defined(__arm__)
 #define FACTOR_ARM
 /* Detect target CPU type */
 #if defined(__arm__)
 #define FACTOR_ARM

diff --git a/vm/objects.hpp b/vm/objects.hpp
index d082c18ba250290bb8de10e846b85c91bcd5918a..11950b5faa5e55a5ad1175afe8fcbd517548d9b5 100644 (file)
--- a/vm/objects.hpp
+++ b/vm/objects.hpp
@@ -2,7 +2,7 @@ namespace factor {
 
 // Special object count and identifiers must be kept in sync with:
 //   core/kernel/kernel.factor
 
 // Special object count and identifiers must be kept in sync with:
 //   core/kernel/kernel.factor

-//   core/bootstrap/image/image.factor
+//   basis/bootstrap/image/image.factor

 
 static const cell special_object_count = 80;
 
 
 static const cell special_object_count = 80;
 


@@ -106,6 +106,9 @@ enum special_object {
 
   OBJ_SIGNAL_PIPE = 74, /* file descriptor for pipe used to communicate signals
                            only used on unix */
 
   OBJ_SIGNAL_PIPE = 74, /* file descriptor for pipe used to communicate signals
                            only used on unix */

+  OBJ_VM_COMPILE_TIME = 75, /* when the binary was built */
+  OBJ_VERSION = 76, /* factor version */
+  OBJ_GIT_LABEL = 77, /* git label (git describe --all --long) */

 };
 
 /* save-image-and-exit discards special objects that are filled in on startup
 };
 
 /* save-image-and-exit discards special objects that are filled in on startup