shift now behaves correctly with large right shift'

Makefile

@@ -1,5 +1,5 @@
 CC = gcc
-CFLAGS = -Os -mpentiumpro -g -Wall
+CFLAGS = -Os -g -Wall
 LIBS = -lm
 STRIP = strip
 

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:
 

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 pad ]
-    ] [
+        [ 0 < ] [ 1 emit neg emit ]
-        0 emit     emit
+        [ 0 > ] [ 0 emit     emit ]
-    ] ifte r> ;
+    ] 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 ;
 

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

library/test/test.factor

@@ -78,6 +78,7 @@ USE: unparser
         "parser"
         "parse-number"
         "prettyprint"
+        "image"
         "inspector"
         "io/io"
         "vectors"

native/fixnum.c

@@ -170,7 +170,12 @@ CELL xor_fixnum(FIXNUM x, FIXNUM y)
 CELL shift_fixnum(FIXNUM x, FIXNUM y)
 {
 	if(y < 0)
+	{
+		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)