From fa29a1cbadbace86bf969a70a5162c1bf7032d6f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 5 Sep 2004 04:06:09 +0000
Subject: [PATCH] shift now behaves correctly with large right shift'

---
 Makefile                  |  2 +-
 TODO.FACTOR.txt           |  3 ++-
 library/image.factor      | 12 ++++++------
 library/test/image.factor | 23 +++++++++++++++++++++++
 library/test/test.factor  |  1 +
 native/fixnum.c           |  7 ++++++-
 6 files changed, 39 insertions(+), 9 deletions(-)
 create mode 100644 library/test/image.factor

diff --git a/Makefile b/Makefile
index 95a2560c88..0b3a254adc 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
 CC = gcc
-CFLAGS = -Os -mpentiumpro -g -Wall
+CFLAGS = -Os -g -Wall
 LIBS = -lm
 STRIP = strip
 
diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index b1e6595789..14dc94dbfe 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -5,12 +5,13 @@
 - don't show listener on certain commands
 - plugin should not exit jEdit on fatal errors
 - wordpreview: don't show for string literals and comments
-- 64 bit support
 - alist -vs- assoc terminology
 - clean up listener's action popups
 - jedit ==> jedit-word, jedit takes a file name
 - introduce ifte* and ?str-head/?str-tail where appropriate
 - namespace clone drops static var bindings
+- solaris: -lsocket -lnsl
+- unparsing: \u000c
 
 + bignums:
 
diff --git a/library/image.factor b/library/image.factor
index c35934da7e..5a478d035a 100644
--- a/library/image.factor
+++ b/library/image.factor
@@ -125,11 +125,11 @@ USE: words
     object-tag here-as >r
     bignum-type >header emit
     dup 0 = 1 2 ? emit ( capacity )
-    dup 0 < [
-        1 emit neg emit
-    ] [
-        0 emit     emit
-    ] ifte r> ;
+    [
+        [ 0 = ] [ emit pad ]
+        [ 0 < ] [ 1 emit neg emit ]
+        [ 0 > ] [ 0 emit     emit ]
+    ] cond r> ;
 
 ( Special objects )
 
@@ -214,7 +214,7 @@ DEFER: '
 : (pack-string) ( n list -- )
     #! Emit bytes for a string, with n characters per word.
     [
-        2dup str-length > [ dupd .s align-string ] when
+        2dup str-length > [ dupd align-string ] when
         emit-string
     ] each drop ;
 
diff --git a/library/test/image.factor b/library/test/image.factor
new file mode 100644
index 0000000000..269ead768f
--- /dev/null
+++ b/library/test/image.factor
@@ -0,0 +1,23 @@
+USE: test
+USE: cross-compiler
+USE: namespaces
+USE: stdio
+
+[ "ab\0\0" ] [ 4 "ab" align-string ] unit-test
+
+[ { 0 } ] [
+    [ "\0\0\0\0" emit-string ] with-minimal-image
+] unit-test
+
+[ { 6815845 7077996 7274528 7798895 7471212 6553600 } ]
+[
+    [
+        "big-endian" on
+        [ "hello world" pack-string ] with-minimal-image
+    ] with-scope
+] unit-test
+
+[ "\0\0\0\0\u000f\u000e\r\u000c" ]
+[
+    [ image-magic write-big-endian-64 ] with-string
+] unit-test
diff --git a/library/test/test.factor b/library/test/test.factor
index 65ee9ada20..3304914651 100644
--- a/library/test/test.factor
+++ b/library/test/test.factor
@@ -78,6 +78,7 @@ USE: unparser
         "parser"
         "parse-number"
         "prettyprint"
+        "image"
         "inspector"
         "io/io"
         "vectors"
diff --git a/native/fixnum.c b/native/fixnum.c
index ac1e1468d2..da2b80c449 100644
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -170,7 +170,12 @@ CELL xor_fixnum(FIXNUM x, FIXNUM y)
 CELL shift_fixnum(FIXNUM x, FIXNUM y)
 {
 	if(y < 0)
-		return tag_fixnum(x >> -y);
+	{
+		if(y <= -WORD_SIZE)
+			return (x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
+		else
+			return tag_fixnum(x >> -y);
+	}
 	else if(y == 0)
 		return tag_fixnum(x);
 	else if(y < WORD_SIZE - TAG_BITS)