VM: Three new special objects added to keep track of the builds version number, git label and compilation time respectively. The info is exposed in the system:version-info word and also shown in the banner during startup.

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

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

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

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 [

build-support/factor.cmd

@@ -27,6 +27,11 @@ if not errorlevel 1 (
     ) else goto nocl
 )
 
+git describe --all --long > git_label.tmp
+set /p git_label= < git_label.tmp
+
+set version=0.97
+
 if %_bootimage_version%==clean (
     set _git_branch=clean-windows-%_target%
     set _bootimage_path=clean/windows-%_target%
@@ -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
 echo     platform and the corresponding boot image is downloaded.
 goto :EOF
-

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() {

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-CPU special-object>string string>cpu \ cpu set-global
-    OBJ-OS special-object utf8 alien>string string>os \ os set-global
+    OBJ-OS special-object>string string>os \ os set-global
-    OBJ-VM-COMPILER special-object utf8 alien>string \ vm-compiler 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

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
 

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{
+    string>cpu-hash at ;
-        { "x86.32" x86.32 }
+
-        { "x86.64" x86.64 }
+: cpu>string ( class -- str )
-        { "arm" arm }
+    string>cpu-hash key-for-value ;
-        { "ppc.32" ppc.32 }
-        { "ppc.64" ppc.64 }
-    } at ;
 
 : string>os ( str -- class )
-    H{
+    string>os-hash at ;
-        { "windows" windows }
+
-        { "macosx" macosx }
+: os>string ( class -- str )
-        { "linux" linux }
+    string>os-hash key-for-value ;
-    } at ;
 
 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 ;

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;

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

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