From 34ff4e2c27db00f5109ccabff8241bf9a2c9cb67 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Tue, 20 Sep 2005 05:59:38 +0000
Subject: [PATCH] more preliminary work for callcc compilation

---
 library/bootstrap/image.factor     | 11 +++++++----
 library/inference/branches.factor  | 24 ++++++++++++++++--------
 library/inference/inference.factor |  2 +-
 library/math/matrices.factor       |  2 --
 library/tools/inspector.factor     |  2 +-
 library/unix/io.factor             |  1 -
 native/float.h                     |  6 +++++-
 7 files changed, 30 insertions(+), 18 deletions(-)

diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index 39e609f420..a70cd632e0 100644
--- a/library/bootstrap/image.factor
+++ b/library/bootstrap/image.factor
@@ -26,14 +26,17 @@ SYMBOL: 64-bits
 
 : emit ( cell -- ) image get push ;
 
+: d>w/w ( d -- w w )
+    #! I cannot use bignum literals here because of bootstrap
+    #! deficencies.
+    dup 1 32 shift 1- bitand
+    swap -32 shift 1 32 shift 1- bitand ;
+
 : emit-64 ( cell -- )
     64-bits get [
         emit
     ] [
-        dup 1 32 shift 1- bitand
-        swap -32 shift 1 32 shift 1- bitand
-        big-endian get [ swap ] when
-        emit emit
+        d>w/w big-endian get [ swap ] unless emit emit
     ] ifte ;
 
 : emit-seq ( seq -- ) image get swap nappend ;
diff --git a/library/inference/branches.factor b/library/inference/branches.factor
index 748bc1f51e..a9ac192b35 100644
--- a/library/inference/branches.factor
+++ b/library/inference/branches.factor
@@ -7,7 +7,7 @@ namespaces parser prettyprint sequences strings vectors words ;
 : unify-lengths ( seq -- seq )
     #! Pad all vectors to the same length. If one vector is
     #! shorter, pad it with unknown results at the bottom.
-    dup [ length ] map supremum swap [ add-inputs ] map-with ;
+    dup 0 [ length max ] reduce swap [ add-inputs ] map-with ;
 
 : unify-length ( seq seq -- seq )
     2array unify-lengths first2 ;
@@ -27,15 +27,23 @@ namespaces parser prettyprint sequences strings vectors words ;
     [ dup [ length - ] [ 2drop f ] ifte ] 2map
     [ ] subset all-equal? ;
 
+: unify-in-d ( seq -- n )
+    #! Input is a sequence of positive integers or f.
+    #! Output is the maximum or 0.
+    0 [ [ max ] when* ] reduce ;
+
+: unbalanced-branches ( in out -- )
+    { "Unbalanced branches:" } -rot [
+        swap number>string " " rot length number>string
+        append3
+    ] 2map append "\n" join inference-error ;
+
 : unify-effect ( in out -- in out )
     #! In is a sequence of integers; out is a sequence of stacks.
-    2dup balanced?
-    [ unify-stacks >r supremum r> ]
-    [
-        { "Unbalanced branches:" } -rot [
-            swap number>string " " rot length number>string
-            append3
-        ] 2map append "\n" join inference-error
+    2dup balanced? [
+        unify-stacks >r unify-in-d r>
+    ] [
+        unbalanced-branches
     ] ifte ;
 
 : datastack-effect ( seq -- )
diff --git a/library/inference/inference.factor b/library/inference/inference.factor
index 856a14175a..e5dcf9b817 100644
--- a/library/inference/inference.factor
+++ b/library/inference/inference.factor
@@ -84,7 +84,7 @@ M: wrapper apply-object wrapped apply-literal ;
 
 : terminate ( -- )
     #! Ignore this branch's stack effect.
-    meta-d off meta-r off #terminate node, ;
+    d-in off meta-d off meta-r off #terminate node, ;
 
 : infer-quot ( quot -- )
     #! Recursive calls to this word are made for nested
diff --git a/library/math/matrices.factor b/library/math/matrices.factor
index 36a1fc824c..0236cd89ce 100644
--- a/library/math/matrices.factor
+++ b/library/math/matrices.factor
@@ -28,8 +28,6 @@ USING: arrays generic kernel sequences ;
 
 : sum ( v -- n ) 0 [ + ] reduce ;
 : product ( v -- n ) 1 [ * ] reduce ;
-: infimum ( v -- n ) dup first [ min ] reduce ;
-: supremum ( v -- n ) dup first [ max ] reduce ;
 
 : set-axis ( x y axis -- v )
     2dup v* >r >r drop dup r> v* v- r> v+ ;
diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor
index a5b5e01fb1..3cbdd365c9 100644
--- a/library/tools/inspector.factor
+++ b/library/tools/inspector.factor
@@ -23,7 +23,7 @@ M: hashtable sheet dup hash-keys swap hash-values 2array ;
 
 : format-column ( list -- list )
     [ unparse-short ] map
-    [ [ length ] map supremum ] keep
+    [ 0 [ length ] reduce ] keep
     [ swap CHAR: \s pad-right ] map-with ;
 
 : sheet-numbers ( sheet -- sheet )
diff --git a/library/unix/io.factor b/library/unix/io.factor
index 3b481dfb94..137d0d9017 100644
--- a/library/unix/io.factor
+++ b/library/unix/io.factor
@@ -74,7 +74,6 @@ C: port ( handle buffer -- port )
     80 <sbuf> over set-port-sbuf ;
 
 : touch-port ( port -- )
-    ! "touch-port called\n" 14 getenv fwrite 14 getenv fflush
     dup port-timeout dup 0 =
     [ 2drop ] [ millis + swap set-port-cutoff ] ifte ;
 
diff --git a/native/float.h b/native/float.h
index d3d19b99a6..10e292b69d 100644
--- a/native/float.h
+++ b/native/float.h
@@ -1,5 +1,9 @@
 typedef struct {
-	CELL header;
+/* C sucks. */
+	union {
+		CELL header;
+		long long padding;
+	};
 	double n;
 } F_FLOAT;