1. Add unsigned fixnum comparisons, needed to compile runtime-check.

2. C back end:
   Eliminate use of the 'system' primitive and use run-shell-command
   from option synchronous-subprocess.

diff --git a/v7/src/compiler/machines/C/ctop.scm b/v7/src/compiler/machines/C/ctop.scm
index 080bab934181606be8472abb92199251b38d87fa..509b7314db3059cda313c29c1e472305021bbc79 100644 (file)
--- a/v7/src/compiler/machines/C/ctop.scm
+++ b/v7/src/compiler/machines/C/ctop.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ctop.scm,v 1.16 2006/09/16 11:19:09 gjr Exp $
+$Id: ctop.scm,v 1.17 2006/09/17 12:10:04 gjr Exp $
 
 Copyright (c) 1992-1999, 2006 Massachusetts Institute of Technology
 
@@ -143,8 +143,8 @@ USA.
                   (write-string ";Executing \"")
                   (write-string command-line)
                   (write-string "\"")))
-            (let ((result ((ucode-primitive system) command-line)))
-                                       #|
+            (let ((result (run-shell-command command-line)))
+              #|
               ;; Some C compilers always fail
               (if (not (zero? result))
                   (error "compiler: C compiler/linker failed"))

diff --git a/v7/src/compiler/machines/C/lapgen.scm b/v7/src/compiler/machines/C/lapgen.scm
index f9354e3bcbd8de13401657fca90406b0c9f50f06..6c3ce422f1e2e35b0bbb8d21f451e5babc9b0e15 100644 (file)
--- a/v7/src/compiler/machines/C/lapgen.scm
+++ b/v7/src/compiler/machines/C/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.18 2006/09/16 11:19:09 gjr Exp $
+$Id: lapgen.scm,v 1.19 2006/09/17 12:10:04 gjr Exp $
 
 Copyright 1993,1998,2001,2002,2004,2006 Massachusetts Institute of Technology
 
@@ -565,6 +565,16 @@ USA.
    (lambda (label)
      (LAP "if (!(" ,val1 ,cc ,val2 "))\n\t  goto " ,label ";\n\t")))
   (LAP))
+
+(define (compare/unsigned cc val1 val2)
+  (set-current-branches!
+   (lambda (label)
+     (LAP "if (((unsigned long) " ,val1 ")"
+         ,cc "((unsigned long) " ,val2 "))\n\t  goto " ,label ";\n\t"))
+   (lambda (label)
+     (LAP "if (!(((unsigned long) " ,val1 ")"
+         ,cc "((unsigned long) " ,val2 ")))\n\t  goto " ,label ";\n\t")))
+  (LAP))
 \f
 (define (define-arithmetic-method operator methods method)
   (let ((entry (assq operator (cdr methods))))

diff --git a/v7/src/compiler/machines/C/make.scm b/v7/src/compiler/machines/C/make.scm
index a8446c8c5521d977df27d4684c26ea3bdeeb23b6..49c39f0acdfd3fd1567092db5f52dd1c729069f2 100644 (file)
--- a/v7/src/compiler/machines/C/make.scm
+++ b/v7/src/compiler/machines/C/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 1.6 2006/09/16 11:19:09 gjr Exp $
+$Id: make.scm,v 1.7 2006/09/17 12:10:04 gjr Exp $
 
 Copyright (c) 1992, 1999, 2006 Massachusetts Institute of Technology
 
@@ -27,6 +27,8 @@ USA.
 
 (declare (usual-integrations))
 
+(load-option 'synchronous-subprocess)
+
 (begin
   (declare-shared-library "sf+compiler" (lambda () true))
   (let ((value ((load "base/make")

diff --git a/v7/src/compiler/machines/C/rulfix.scm b/v7/src/compiler/machines/C/rulfix.scm
index dc809b51dc7a4d580dbc8b56d4faceeac0b71ad9..c9d0c813d144d3e8238eacf1353909c863cdff45 100644 (file)
--- a/v7/src/compiler/machines/C/rulfix.scm
+++ b/v7/src/compiler/machines/C/rulfix.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rulfix.scm,v 1.7 2003/02/14 18:28:02 cph Exp $
+$Id: rulfix.scm,v 1.8 2006/09/17 12:10:04 gjr Exp $
 
-Copyright (c) 1992-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright (c) 1992-1999, 2001, 2002, 2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -466,31 +466,40 @@ USA.
   (FIXNUM-PRED-2-ARGS (? predicate)
                      (REGISTER (? source1))
                      (REGISTER (? source2)))
-  (compare (fixnum-pred-2->cc predicate)
-          (standard-source! source1 'LONG)
-          (standard-source! source2 'LONG)))
+  ((comparator predicate)
+   (fixnum-pred-2->cc predicate)
+   (standard-source! source1 'LONG)
+   (standard-source! source2 'LONG)))
 
 (define-rule predicate
   (FIXNUM-PRED-2-ARGS (? predicate)
                      (REGISTER (? source))
                      (OBJECT->FIXNUM (CONSTANT (? constant))))
-  (compare (fixnum-pred-2->cc predicate)
-          (standard-source! source 'LONG)
-          (longify constant)))
+  ((comparator predicate)
+   (fixnum-pred-2->cc predicate)
+   (standard-source! source 'LONG)
+   (longify constant)))
 
 (define-rule predicate
   (FIXNUM-PRED-2-ARGS (? predicate)
                      (OBJECT->FIXNUM (CONSTANT (? constant)))
                      (REGISTER (? source)))
-  (compare (fixnum-pred-2->cc predicate)
-          (longify constant)
-          (standard-source! source 'LONG)))
+  ((comparator predicate)
+   (fixnum-pred-2->cc predicate)
+   (longify constant)
+   (standard-source! source 'LONG)))
  
+(define-integrable (comparator predicate)
+  (if (memq predicate '(UNSIGNED-LESS-THAN-FIXNUM?
+                       UNSIGNED-GREATER-THAN-FIXNUM?))
+      compare/unsigned
+      compare))
+
 (define (fixnum-pred-2->cc predicate)
   (case predicate
     ((EQUAL-FIXNUM?) " == ")
-    ((LESS-THAN-FIXNUM?) " < ")
-    ((GREATER-THAN-FIXNUM?) " > ")
+    ((LESS-THAN-FIXNUM? UNSIGNED-LESS-THAN-FIXNUM?) " < ")
+    ((GREATER-THAN-FIXNUM? UNSIGNED-GREATER-THAN-FIXNUM?) " > ")
     (else
      (error "unknown fixnum predicate" predicate))))