~ chicken-core (chicken-5) 5946057ddd5556ea47f7c9ff6738d018b18b5b18


commit 5946057ddd5556ea47f7c9ff6738d018b18b5b18
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue May 11 13:05:12 2010 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue May 11 13:05:12 2010 +0200

    added feature id for chicken-MAJOR.MINOR

diff --git a/chicken.h b/chicken.h
index 73de3b55..563c0f8f 100644
--- a/chicken.h
+++ b/chicken.h
@@ -37,6 +37,7 @@
 #define ___CHICKEN
 
 #define C_MAJOR_VERSION       4
+#define C_MINOR_VERSION       5
 
 /*
  * N.B. This file MUST not rely upon "chicken-config.h"
diff --git a/library.scm b/library.scm
index 1ebd40f5..29afef98 100644
--- a/library.scm
+++ b/library.scm
@@ -234,7 +234,7 @@ EOF
 (define (argc+argv) (##sys#values main_argc main_argv))
 (define ##sys#make-structure (##core#primitive "C_make_structure"))
 (define ##sys#ensure-heap-reserve (##core#primitive "C_ensure_heap_reserve"))
-(define (##sys#fudge fudge-factor) (##core#inline "C_fudge" fudge-factor))
+(define (##sys#fudge index) (##core#inline "C_fudge" index))
 (define ##sys#call-host (##core#primitive "C_return_to_host"))
 (define return-to-host ##sys#call-host)
 (define ##sys#file-info (##core#primitive "C_file_info"))
@@ -3318,8 +3318,7 @@ EOF
 	    [else	  (err x)] ) ) ) )
 
 (define ##sys#features
-  '(#:chicken #:chicken-4
-    #:srfi-23 #:srfi-30 #:srfi-39 #:srfi-62 #:srfi-17 #:srfi-12 #:srfi-88 #:srfi-98))
+  '(#:chicken #:srfi-23 #:srfi-30 #:srfi-39 #:srfi-62 #:srfi-17 #:srfi-12 #:srfi-88 #:srfi-98))
 
 ;; Add system features:
 
@@ -3337,6 +3336,15 @@ EOF
 (when (##sys#fudge 28) (set! ##sys#features (cons #:ptables ##sys#features)))
 (when (##sys#fudge 39) (set! ##sys#features (cons #:cross-chicken ##sys#features)))
 
+(set! ##sys#features
+  (let ((major (##sys#string-append "chicken-" (##sys#number->string (##sys#fudge 41)))))
+    (cons (##sys#->feature-id major)
+	  (cons (##sys#->feature-id 
+		 (string-append
+		  major "."
+		  (##sys#number->string (##sys#fudge 43))))
+		##sys#features))))
+
 (define (register-feature! . fs)
   (for-each
    (lambda (f)
diff --git a/runtime.c b/runtime.c
index 65e3960a..968e1aed 100644
--- a/runtime.c
+++ b/runtime.c
@@ -4169,6 +4169,9 @@ C_regparm C_word C_fcall C_fudge(C_word fudge_factor)
     return C_fix(0);
 #endif
 
+  case C_fix(43):
+    return C_fix(C_MINOR_VERSION);
+
   default: return C_SCHEME_UNDEFINED;
   }
 }
diff --git a/scripts/setversion b/scripts/setversion
index af580cde..5fa3e22f 100644
--- a/scripts/setversion
+++ b/scripts/setversion
@@ -39,24 +39,37 @@ exec csi -s "$0" "$@"
   (string-match (rx "(\\d+)\\.(\\d+)\\.(\\d+)(.*)") v) )
 
 (define (main args)
-  (cond ((member "-set" args) =>
-	 (lambda (a) (set! buildversion (cadr a))) )
-	((not (member "-noinc" args))
-	 (let* ((v (parse-version buildversion))
-		(maj (cadr v))
-		(min (caddr v))
-		(pl (cadddr v))
-		(huh (car (cddddr v))))
-	   (set! buildversion (conc maj "." min "." (add1 (string->number pl)) huh)) ) ) )
-  (with-output-to-file "buildversion" (cut display buildversion) binary:)
-  (with-output-to-file "version.scm" 
-    (lambda ()
-      (write `(define-constant +build-version+ ,buildversion))
-      (newline) )
-    binary:)
-  (system* "cat version.scm")
-  (let ([vstr (sprintf "version ~A" buildversion)])
-    (for-each (cut patch <> (rx "version [0-9][-.0-9a-zA-Z]+") vstr) files) )
-  0)
+  (let ((major #f)
+	(minor #f))
+    (cond ((member "-set" args) =>
+	   (lambda (a) (set! buildversion (cadr a))) )
+	  ((not (member "-noinc" args))
+	   (let* ((v (parse-version buildversion))
+		  (maj (cadr v))
+		  (min (caddr v))
+		  (pl (cadddr v))
+		  (huh (car (cddddr v))))
+	     (set! major maj)
+	     (set! minor min)
+	     (set! buildversion
+	       (conc maj "." min "." (add1 (string->number pl)) huh)) ) ) )
+    (with-output-to-file "buildversion" (cut display buildversion) binary:)
+    (with-output-to-file "version.scm" 
+      (lambda ()
+	(write `(define-constant +build-version+ ,buildversion))
+	(newline) )
+      binary:)
+    (system* "cat version.scm")
+    (let ([vstr (sprintf "version ~A" buildversion)])
+      (for-each (cut patch <> (rx "version [0-9][-.0-9a-zA-Z]+") vstr) files) )
+    (patch 
+     "chicken.h"
+     (rx "C_MAJOR_VERSION[ \\t]+[0-9]+")
+     (sprintf "C_MAJOR_VERSION   ~a" major))
+    (patch 
+     "chicken.h"
+     (rx "C_MINOR_VERSION[ \\t]+[0-9]+")
+     (sprintf "C_MINOR_VERSION   ~a" minor))
+    0))
 
 (main (command-line-arguments))
Trap