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
+       GIT_LABEL = $(shell git describe --all --long)
 
        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

diff --git a/Nmakefile b/Nmakefile
index 02dbfd4fa981f1cad874a4a1b662cf8a59682164..1f69fd8a2972fea2bdc5e54685ccc460939e8e26 100644 (file)
--- a/Nmakefile
+++ b/Nmakefile
@@ -2,12 +2,25 @@
 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
-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
 
+!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

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
-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
@@ -392,7 +392,8 @@ interactor "completion" f {
 
 : 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 [

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
+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
@@ -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
-\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`
-    
+
     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() {
-    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() {

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 )
+
+: special-object>string ( n -- str )
+    special-object (symbol>string) ;
+
 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

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-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
 

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.
-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 ;
@@ -16,25 +16,44 @@ UNION: unix macosx linux ;
 
 : 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-compile-time ( -- string ) \ vm-compile-time get-global ; foldable
+
 <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 )
-    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 )
-    H{
-        { "windows" windows }
-        { "macosx" macosx }
-        { "linux" linux }
-    } at ;
+    string>os-hash at ;
+
+: os>string ( class -- str )
+    string>os-hash key-for-value ;
 
 PRIVATE>
 
@@ -45,3 +64,9 @@ PRIVATE>
 : 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_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;

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
 
+/* Record compilation time */
+#define FACTOR_COMPILE_TIME __TIMESTAMP__
+
 /* 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
-//   core/bootstrap/image/image.factor
+//   basis/bootstrap/image/image.factor
 
 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_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