Factor jEdit plugin!

TODO.FACTOR.txt

@@ -1,5 +1,16 @@
+- java factor memory leak
+- tail call optimization broken again
+
++ listener:
+
+- link style lingers
+- back space then type: input style gone
+- fedit broken with listener
+- press enter in the middle of a line
+
 + native:
 
+- native float>bits
 - printing floats: append .0 always
 - vector=
 - make-image: take a parameter, include le & be images in dist
@@ -32,17 +43,8 @@ ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable
 - FactorLib.equal() not very good
 - IN: format base: work with all types of numbers
 
-+ listener:
-
-- link style lingers
-- back space then type: input style gone
-- fedit broken with listener
-- press enter in the middle of a line
-- new-listener shouldn't suspend continuation in current listener
-
 + compiler:
 
-- tail call optimization broken again
 - don't compile inline words
 - recursive words with code after ifte
 - less unnecessary args to auxiliary methods

build.sh

@@ -1,5 +1,5 @@
 export CC=gcc34
-export CFLAGS="-pedantic -Wall -Winline -Os -march=pentium4 -fomit-frame-pointer"
+export CFLAGS="-pedantic -Wall -Winline -O3 -march=pentium4 -fomit-frame-pointer"
 
 $CC $CFLAGS -o f native/*.c
 

build.xml

@@ -12,9 +12,22 @@
 			optimize="true"
 		>
 		<include name="**/*.java"/>
+		<exclude name="factor/jedit/*.java"/>
 		</javac>
 	</target>
-	<target name="dist" depends="compile">
+	<target name="compile-jedit">
+		<javac
+			srcdir="."
+			destdir="."
+			deprecation="on"
+			includeJavaRuntime="yes"
+			debug="true"
+			optimize="true"
+		>
+		<include name="factor/jedit/*.java"/>
+		</javac>
+	</target>
+	<target name="dist" depends="compile,compile-jedit">
 		<jar
 			jarfile="Factor.jar"
 			manifest="Factor.manifest"
@@ -23,6 +36,8 @@
 			<fileset dir=".">
 				<include name="factor/*.class"/>
 				<include name="factor/**/*.class"/>
+				<include name="factor/**/*.props"/>
+				<include name="*.xml"/>
 				<include name="library/**/*.factor"/>
 				<include name="org/**/*.class"/>
 				<include name="*.factor"/>

factor/jedit/FactorPlugin.java

@@ -0,0 +1,53 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.jedit;
+
+import factor.listener.FactorListenerPanel;
+import factor.FactorInterpreter;
+import org.gjt.sp.jedit.*;
+import java.util.WeakHashMap;
+
+public class FactorPlugin extends EditPlugin
+{
+	private static WeakHashMap views = new WeakHashMap();
+
+	public static FactorInterpreter getInterpreter(View view)
+	{
+		FactorInterpreter interp = (FactorInterpreter)
+			views.get(view);
+		if(interp == null)
+		{
+			interp = FactorListenerPanel.newInterpreter(
+				new String[] { "-jedit" });
+			views.put(view,interp);
+		}
+		return interp;
+	}
+}

factor/jedit/FactorPlugin.props

@@ -0,0 +1,21 @@
+### Plugin properties
+
+plugin.factor.jedit.FactorPlugin.activate=defer
+
+plugin.factor.jedit.FactorPlugin.name=Factor
+plugin.factor.jedit.FactorPlugin.version=0.60.10
+plugin.factor.jedit.FactorPlugin.author=Slava Pestov
+plugin.factor.jedit.FactorPlugin.docs=index.html
+
+plugin.factor.jedit.FactorPlugin.depend.0=jedit 04.02.15.00
+
+plugin.factor.jedit.FactorPlugin.menu=factor \
+	- \
+	factor-run-file \
+	factor-eval-selection
+
+factor.label=Factor Listener
+factor-run-file.label=Run Current File
+factor-eval-selection.label=Evaluate Selection
+
+factor.title=Factor

factor/listener/FactorDesktop.java

@@ -39,11 +39,6 @@ import javax.swing.text.html.*;
 
 public class FactorDesktop extends JFrame
 {
-	private JTabbedPane tabs;
-	private FactorInterpreter interp;
-	private boolean standalone;
-	private Map listeners;
-
 	//{{{ main() method
 	public static void main(String[] args)
 	{
@@ -54,26 +49,10 @@ public class FactorDesktop extends JFrame
 	public FactorDesktop(String[] args, boolean standalone)
 	{
 		super("Factor");
-		tabs = new JTabbedPane();
-		this.standalone = standalone;
-		listeners = new HashMap();
 
-		getContentPane().add(BorderLayout.CENTER,tabs);
+		getContentPane().add(BorderLayout.CENTER,
-
+			new FactorListenerPanel(
-		try
+			FactorListenerPanel.newInterpreter(args)));
-		{
-			interp = new FactorInterpreter();
-			interp.interactive = false;
-			interp.init(args,null);
-			interp.global.setVariable("desktop",this);
-		}
-		catch(Exception e)
-		{
-			System.err.println("Failed to initialize interpreter:");
-			e.printStackTrace();
-		}
-
-		newListener();
 
 		setSize(640,480);
 		setDefaultCloseOperation(standalone
@@ -81,100 +60,4 @@ public class FactorDesktop extends JFrame
 			: DISPOSE_ON_CLOSE);
 		show();
 	} //}}}
-
-	//{{{ newListener() method
-	public FactorListener newListener()
-	{
-		final FactorListener listener = new FactorListener();
-		listener.addEvalListener(new EvalHandler());
-
-		try
-		{
-			interp.call(new Cons(listener,
-				new Cons(interp.searchVocabulary(
-					"listener","new-listener-hook"),
-				null)));
-			interp.run();
-		}
-		catch(Exception e)
-		{
-			System.err.println("Failed to initialize listener:");
-			e.printStackTrace();
-		}
-
-		JScrollPane scroller = new JScrollPane(listener);
-		listeners.put(listener,scroller);
-		tabs.addTab("Listener",scroller);
-
-		SwingUtilities.invokeLater(new Runnable()
-		{
-			public void run()
-			{
-				listener.requestFocus();
-			}
-		});
-
-		return listener;
-	} //}}}
-
-	//{{{ closeListener() method
-	public void closeListener(FactorListener listener)
-	{
-		// remove tab containing the listener
-		tabs.remove((Component)listeners.get(listener));
-		if(tabs.getTabCount() == 0)
-		{
-			if(standalone)
-				System.exit(0);
-			else
-				dispose();
-		}
-	} //}}}
-
-	//{{{ getInterpreter() method
-	public FactorInterpreter getInterpreter()
-	{
-		return interp;
-	} //}}}
-
-	//{{{ eval() method
-	public void eval(Cons cmd)
-	{
-		try
-		{
-			interp.call(cmd);
-			interp.run();
-		}
-		catch(Exception e)
-		{
-			System.err.println("Failed to eval " + cmd + ":");
-			e.printStackTrace();
-		}
-	} //}}}
-
-	//{{{ EvalHandler class
-	class EvalHandler implements EvalListener
-	{
-		public void eval(Cons cmd)
-		{
-			FactorDesktop.this.eval(cmd);
-		}
-	} //}}}
-
-	//{{{ EvalAction class
-	class EvalAction extends AbstractAction
-	{
-		private Cons code;
-
-		public EvalAction(String label, Cons code)
-		{
-			super(label);
-			this.code = code;
-		}
-
-		public void actionPerformed(ActionEvent evt)
-		{
-			FactorDesktop.this.eval(code);
-		}
-	} //}}}
 }

factor/listener/FactorListenerPanel.java

@@ -0,0 +1,133 @@
+/* :folding=explicit:collapseFolds=1: */
+
+/*
+ * $Id$
+ *
+ * Copyright (C) 2004 Slava Pestov.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+package factor.listener;
+
+import factor.*;
+import java.awt.*;
+import java.awt.event.*;
+import java.util.*;
+import javax.swing.*;
+import javax.swing.text.*;
+import javax.swing.text.html.*;
+
+public class FactorListenerPanel extends JPanel
+{
+	private FactorInterpreter interp;
+	private FactorListener listener;
+
+	//{{{ newInterpreter() method
+	public static FactorInterpreter newInterpreter(String[] args)
+	{
+		try
+		{
+			FactorInterpreter interp = new FactorInterpreter();
+			interp.interactive = false;
+			interp.init(args,null);
+			return interp;
+		}
+		catch(Exception e)
+		{
+			System.err.println("Failed to initialize interpreter:");
+			e.printStackTrace();
+			return null;
+		}
+	} //}}}
+
+	//{{{ FactorListenerPanel constructor
+	public FactorListenerPanel(FactorInterpreter interp)
+	{
+		setLayout(new BorderLayout());
+
+		this.interp = interp;
+
+		add(BorderLayout.CENTER,new JScrollPane(
+			listener = newListener()));
+	} //}}}
+
+	//{{{ newListener() method
+	private FactorListener newListener()
+	{
+		final FactorListener listener = new FactorListener();
+		listener.addEvalListener(new EvalHandler());
+
+		try
+		{
+			interp.call(new Cons(listener,
+				new Cons(interp.searchVocabulary(
+					"listener","new-listener-hook"),
+				null)));
+			interp.run();
+		}
+		catch(Exception e)
+		{
+			System.err.println("Failed to initialize listener:");
+			e.printStackTrace();
+		}
+
+		return listener;
+	} //}}}
+
+	//{{{ requestDefaultFocus() method
+	public boolean requestDefaultFocus()
+	{
+		listener.requestFocus();
+		return true;
+	} //}}}
+
+	//{{{ getInterpreter() method
+	public FactorInterpreter getInterpreter()
+	{
+		return interp;
+	} //}}}
+
+	//{{{ eval() method
+	public void eval(Cons cmd)
+	{
+		try
+		{
+			interp.call(cmd);
+			interp.run();
+		}
+		catch(Exception e)
+		{
+			System.err.println("Failed to eval " + cmd + ":");
+			e.printStackTrace();
+		}
+	} //}}}
+
+	//{{{ EvalHandler class
+	class EvalHandler implements EvalListener
+	{
+		public void eval(Cons cmd)
+		{
+			FactorListenerPanel.this.eval(cmd);
+		}
+	} //}}}
+}

library/cross-compiler.factor

@@ -51,6 +51,8 @@ DEFER: save-image
 DEFER: handle?
 DEFER: room
 DEFER: os-env
+DEFER: type-of
+DEFER: size-of
 
 IN: strings
 DEFER: str=
@@ -134,6 +136,7 @@ IN: cross-compiler
         float?
         str>float
         unparse-float
+        float>bits
         complex?
         real
         imaginary
@@ -199,6 +202,8 @@ IN: cross-compiler
         millis
         init-random
         (random-int)
+        type-of
+        size-of
     ] [
         swap succ tuck primitive,
     ] each drop ;

library/image.factor

@@ -48,6 +48,12 @@ USE: words
 
 : image "image" get ;
 : emit ( cell -- ) image vector-push ;
+
+: emit64 ( bignum -- )
+    #! Little endian byte order
+    dup HEX: ffffffff bitand emit
+    32 shift> HEX: ffffffff bitand emit ;
+
 : fixup ( value offset -- ) image set-vector-nth ;
 
 ( Object memory )
@@ -72,6 +78,17 @@ USE: words
 : header-tag   BIN: 110 ;
 : gc-fwd-ptr   BIN: 111 ; ( we don't output these )
 
+: f-type      6 ;
+: t-type      7 ;
+: empty-type  8 ;
+: array-type  9 ;
+: vector-type 10 ;
+: string-type 11 ;
+: sbuf-type   12 ;
+: handle-type 13 ;
+: bignum-type 14 ;
+: float-type  15 ;
+
 : immediate ( x tag -- tagged ) swap tag-bits shift< bitor ;
 : >header ( id -- tagged ) header-tag immediate ;
 
@@ -108,13 +125,31 @@ USE: words
 
 : 'fixnum ( n -- tagged ) fixnum-tag immediate ;
 
+( Floats )
+
+: 'float ( f -- tagged )
+    object-tag here-as
+    float-type >header emit
+    0 emit ( alignment -- FIXME 64-bit arch )
+    float>bits emit64 ;
+
+( Bignums )
+
+: 'bignum ( bignum -- tagged )
+    dup .
+    #! Very bad!
+    object-tag here-as
+    bignum-type >header emit
+    0 emit ( alignment -- FIXME 64-bit arch )
+    ( bignum -- ) emit64 ;
+
 ( Special objects )
 
 ! Padded with fixnums for 8-byte alignment
 
-: f, object-tag here-as "f" set 6 >header emit 0 'fixnum emit ;
+: f, object-tag here-as "f" set f-type >header emit 0 'fixnum emit ;
-: t, object-tag here-as "t" set 7 >header emit 0 'fixnum emit ;
+: t, object-tag here-as "t" set t-type >header emit 0 'fixnum emit ;
-: empty, 8 >header emit 0 'fixnum emit ;
+: empty, empty-type >header emit 0 'fixnum emit ;
 
 ( Beginning of the image )
 ! The image proper begins with the header, then EMPTY, F, T
@@ -184,7 +219,7 @@ DEFER: '
 
 : string, ( string -- )
     object-tag here-as swap
-    11 >header emit
+    string-type >header emit
     dup str-length emit
     dup hashcode emit
     pack-string
@@ -247,7 +282,7 @@ IN: cross-compiler
 : 'array ( list -- untagged )
     [ ' ] inject
     here >r
-    9 >header emit
+    array-type >header emit
     dup length emit
     ( elements -- ) [ emit ] each
     pad r> ;
@@ -255,7 +290,7 @@ IN: cross-compiler
 : 'vector ( vector -- pointer )
     dup vector>list 'array swap vector-length
     object-tag here-as >r
-    10 >header emit
+    vector-type >header emit
     emit ( length )
     emit ( array ptr )
     pad r> ;
@@ -265,6 +300,8 @@ IN: cross-compiler
 : ' ( obj -- pointer )
     [
         [ fixnum? ] [ 'fixnum      ]
+        [ bignum? ] [ 'bignum      ]
+        [ float?  ] [ 'float       ]
         [ word?   ] [ 'word        ]
         [ cons?   ] [ 'cons        ]
         [ char?   ] [ 'fixnum      ]

library/init.factor

@@ -134,6 +134,8 @@ USE: strings
         init-toplevel
 
         [
+            print-banner
+            room.
             interpreter-loop
         ] [
             [ default-error-handler suspend ] when*

library/platform/jvm/arithmetic.factor

@@ -143,3 +143,8 @@ USE: stack
 : gcd ( a b -- c )
     [ "java.lang.Number" "java.lang.Number" ]
     "factor.math.FactorMath" "gcd" jinvoke-static ;
+
+: float>bits ( f -- bignum )
+    [ "double" ]
+    "java.lang.Double" "doubleToRawLongBits"
+    jinvoke-static >bignum ;

library/platform/jvm/init.factor

@@ -77,5 +77,4 @@ USE: strings
 
     t "startup-done" set
     
-    print-banner
     init-interpreter ;

library/platform/jvm/listener.factor

@@ -143,28 +143,12 @@ USE: unparser
         [ this fwrite "\n" this fwrite ] "fprint" set
     ] extend ;
 
-: close-listener ( listener -- )
-    #! Closes the listener. If no more listeners remain, the
-    #! desktop exits.
-    "desktop" get
-    [ "factor.listener.FactorListener" ]
-    "factor.listener.FactorDesktop" "closeListener"
-    jinvoke ;
-
 : new-listener-hook ( listener -- )
-    #! Called when user opens a new listener in the desktop.
+    #! Called when user opens a new listener
     <namespace> [
         dup "listener" set
         <listener-stream> "stdio" set
+        print-banner
+        room.
         interpreter-loop
-        "listener" get close-listener
     ] bind ;
-
-: new-listener ( -- )
-    #! Opens a new listener.
-    "desktop" get
-    [ ] "factor.listener.FactorDesktop" "newListener"
-    jinvoke ;
-
-: running-desktop? ( -- )
-    this "factor.listener.FactorDesktop" is ;

library/platform/native/arithmetic.factor

@@ -22,3 +22,7 @@ USE: stack
 : succ 1 + ; inline
 
 : neg 0 swap - ; inline
+    
+!: e 2.7182818284590452354 ; inline
+!: pi 3.14159265358979323846 ; inline
+!: pi/2 1.5707963267948966 ; inline

library/platform/native/errors.factor

@@ -64,6 +64,7 @@ USE: vectors
         "Incompatible handle: "
         "I/O error: "
         "Overflow"
+        "Incomparable types: "
     ] ?nth ;
 
 : ?kernel-error ( cons -- error# param )

library/platform/native/init.factor

@@ -75,10 +75,6 @@ USE: unparser
     init-styles
     init-vocab-styles
 
-    print-banner
-
     run-user-init
 
-    room.
-
     init-interpreter ;

library/platform/native/unparser.factor

@@ -60,6 +60,9 @@ USE: vocabularies
     denominator integer- integer%
     %> ;
 
+: unparse-complex ( num -- str )
+    >rect <% "#{ " % swap unparse % " " % unparse % " }" % %> ;
+
 : >base ( num radix -- string )
     #! Convert a number to a string in a certain base.
     <namespace> [ "base" set unparse-integer ] bind ;
@@ -113,6 +116,7 @@ USE: vocabularies
         [ integer? ] [ unparse-integer ]
         [ ratio?   ] [ unparse-ratio ]
         [ float?   ] [ unparse-float ]
+        [ complex? ] [ unparse-complex ]
         [ string?  ] [ unparse-str ]
         [ drop t   ] [ <% "#<" % class-of % ">" % %> ]
     ] cond ;

native/bignum.h

@@ -2,6 +2,10 @@ typedef long long BIGNUM_2;
 
 typedef struct {
 	CELL header;
+/* FIXME */
+#ifndef FACTOR_64
+	CELL alignment;
+#endif
 	BIGNUM_2 n;
 } BIGNUM;
 

native/complex.c

@@ -0,0 +1,191 @@
+#include "factor.h"
+
+COMPLEX* complex(CELL real, CELL imaginary)
+{
+	COMPLEX* complex = allot(sizeof(COMPLEX));
+	complex->real = real;
+	complex->imaginary = imaginary;
+	return complex;
+}
+
+CELL possibly_complex(CELL real, CELL imaginary)
+{
+	if(zerop(imaginary))
+		return real;
+	else
+		return tag_complex(complex(real,imaginary));
+}
+
+void primitive_complexp(void)
+{
+	check_non_empty(env.dt);
+	env.dt = tag_boolean(typep(COMPLEX_TYPE,env.dt));
+}
+
+void primitive_real(void)
+{
+	switch(type_of(env.dt))
+	{
+	case FIXNUM_TYPE:
+	case BIGNUM_TYPE:
+	case FLOAT_TYPE:
+	case RATIO_TYPE:
+		/* No op */
+		break;
+	case COMPLEX_TYPE:
+		env.dt = untag_complex(env.dt)->real;
+		break;
+	default:
+		type_error(COMPLEX_TYPE,env.dt);
+		break;
+	}
+}
+
+void primitive_imaginary(void)
+{
+	switch(type_of(env.dt))
+	{
+	case FIXNUM_TYPE:
+	case BIGNUM_TYPE:
+	case FLOAT_TYPE:
+	case RATIO_TYPE:
+		env.dt = tag_fixnum(0);
+		break;
+	case COMPLEX_TYPE:
+		env.dt = untag_complex(env.dt)->imaginary;
+		break;
+	default:
+		type_error(COMPLEX_TYPE,env.dt);
+		break;
+	}
+}
+
+void primitive_to_rect(void)
+{
+	COMPLEX* c;
+	switch(type_of(env.dt))
+	{
+	case FIXNUM_TYPE:
+	case BIGNUM_TYPE:
+	case FLOAT_TYPE:
+	case RATIO_TYPE:
+		dpush(env.dt);
+		env.dt = tag_fixnum(0);
+		break;
+	case COMPLEX_TYPE:
+		c = untag_complex(env.dt);
+		env.dt = c->imaginary;
+		dpush(c->real);
+		break;
+	default:
+		type_error(COMPLEX_TYPE,env.dt);
+		break;
+	}
+}
+
+void primitive_from_rect(void)
+{
+	CELL imaginary = env.dt;
+	CELL real = dpop();
+	check_non_empty(imaginary);
+	check_non_empty(real);
+
+	if(!realp(imaginary))
+		type_error(REAL_TYPE,imaginary);
+
+	if(!realp(real))
+		type_error(REAL_TYPE,real);
+
+	env.dt = possibly_complex(real,imaginary);
+}
+
+CELL number_eq_complex(CELL x, CELL y)
+{
+	COMPLEX* cx = (COMPLEX*)UNTAG(x);
+	COMPLEX* cy = (COMPLEX*)UNTAG(y);
+	return tag_boolean(
+		untag_boolean(number_eq(cx->real,cy->real)) &&
+		untag_boolean(number_eq(cx->imaginary,cy->imaginary)));
+}
+
+CELL add_complex(CELL x, CELL y)
+{
+	COMPLEX* cx = (COMPLEX*)UNTAG(x);
+	COMPLEX* cy = (COMPLEX*)UNTAG(y);
+	return possibly_complex(
+		add(cx->real,cy->real),
+		add(cx->imaginary,cy->real));
+}
+
+CELL subtract_complex(CELL x, CELL y)
+{
+	COMPLEX* cx = (COMPLEX*)UNTAG(x);
+	COMPLEX* cy = (COMPLEX*)UNTAG(y);
+	return possibly_complex(
+		subtract(cx->real,cy->real),
+		subtract(cx->imaginary,cy->real));
+}
+
+CELL multiply_complex(CELL x, CELL y)
+{
+	COMPLEX* cx = (COMPLEX*)UNTAG(x);
+	COMPLEX* cy = (COMPLEX*)UNTAG(y);
+	return possibly_complex(
+		subtract(
+			multiply(cx->real,cy->real),
+			multiply(cx->imaginary,cy->imaginary)),
+		add(
+			multiply(cx->real,cy->imaginary),
+			multiply(cx->imaginary,cy->real)));
+}
+
+#define COMPLEX_DIVIDE(x,y) \
+	COMPLEX* cx = (COMPLEX*)UNTAG(x); \
+	COMPLEX* cy = (COMPLEX*)UNTAG(y); \
+\
+	CELL mag = add( \
+		multiply(cy->real,cy->real), \
+		multiply(cy->imaginary,cy->imaginary)); \
+\
+	CELL r = add( \
+		multiply(cx->real,cy->real), \
+		multiply(cx->imaginary,cy->imaginary)); \
+	CELL i = subtract( \
+		multiply(cx->imaginary,cy->real), \
+		multiply(cx->real,cy->imaginary));
+
+CELL divide_complex(CELL x, CELL y)
+{
+	COMPLEX_DIVIDE(x,y);
+	return possibly_complex(divide(r,mag),divide(i,mag));
+}
+
+CELL divfloat_complex(CELL x, CELL y)
+{
+	COMPLEX_DIVIDE(x,y);
+	return possibly_complex(divfloat(r,mag),divfloat(i,mag));
+}
+
+CELL less_complex(CELL x, CELL y)
+{
+	general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y)));
+	return F;
+}
+
+CELL lesseq_complex(CELL x, CELL y)
+{
+	general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y)));
+	return F;
+}
+
+CELL greater_complex(CELL x, CELL y)
+{
+	general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y)));
+	return F;
+}
+
+CELL greatereq_complex(CELL x, CELL y)
+{
+	general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y)));
+	return F;
+}

native/complex.h

@@ -0,0 +1,34 @@
+typedef struct {
+	CELL real;
+	CELL imaginary;
+} COMPLEX;
+
+INLINE COMPLEX* untag_complex(CELL tagged)
+{
+	type_check(COMPLEX_TYPE,tagged);
+	return (COMPLEX*)UNTAG(tagged);
+}
+
+INLINE CELL tag_complex(RATIO* ratio)
+{
+	return RETAG(ratio,COMPLEX_TYPE);
+}
+
+COMPLEX* complex(CELL real, CELL imaginary);
+CELL possibly_complex(CELL real, CELL imaginary);
+
+void primitive_complexp(void);
+void primitive_real(void);
+void primitive_imaginary(void);
+void primitive_to_rect(void);
+void primitive_from_rect(void);
+CELL number_eq_complex(CELL x, CELL y);
+CELL add_complex(CELL x, CELL y);
+CELL subtract_complex(CELL x, CELL y);
+CELL multiply_complex(CELL x, CELL y);
+CELL divide_complex(CELL x, CELL y);
+CELL divfloat_complex(CELL x, CELL y);
+CELL less_complex(CELL x, CELL y);
+CELL lesseq_complex(CELL x, CELL y);
+CELL greater_complex(CELL x, CELL y);
+CELL greatereq_complex(CELL x, CELL y);

native/error.h

@@ -7,6 +7,7 @@
 #define ERROR_HANDLE_INCOMPAT (6<<3)
 #define ERROR_IO (7<<3)
 #define ERROR_OVERFLOW (8<<3)
+#define ERROR_INCOMPARABLE (9<<3)
 
 void fatal_error(char* msg, CELL tagged);
 void critical_error(char* msg, CELL tagged);

native/float.c

@@ -43,6 +43,11 @@ void primitive_float_to_str(void)
 	env.dt = tag_object(from_c_string(tmp));
 }
 
+void primitive_float_to_bits(void)
+{
+	/* FIXME */
+}
+
 CELL number_eq_float(CELL x, CELL y)
 {
 	return tag_boolean(((FLOAT*)UNTAG(x))->n

native/float.h

@@ -1,5 +1,9 @@
 typedef struct {
 	CELL header;
+/* FIXME */
+#ifndef FACTOR_64
+	CELL alignment;
+#endif
 	double n;
 } FLOAT;
 
@@ -21,6 +25,7 @@ FLOAT* to_float(CELL tagged);
 void primitive_to_float(void);
 void primitive_str_to_float(void);
 void primitive_float_to_str(void);
+void primitive_float_to_bits(void);
 CELL number_eq_float(CELL x, CELL y);
 CELL add_float(CELL x, CELL y);
 CELL subtract_float(CELL x, CELL y);

native/primitives.c

@@ -48,6 +48,7 @@ XT primitives[] = {
 	primitive_floatp,
 	primitive_str_to_float,
 	primitive_float_to_str,
+	primitive_float_to_bits,
 	primitive_complexp,
 	primitive_real,
 	primitive_imaginary,
@@ -112,7 +113,9 @@ XT primitives[] = {
 	primitive_os_env,
 	primitive_millis,
 	primitive_init_random,
-	primitive_random_int
+	primitive_random_int,
+	primitive_type_of,
+	primitive_size_of
 };
 
 CELL primitive_to_xt(CELL primitive)

native/primitives.h

@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 112
+#define PRIMITIVE_COUNT 115
 
 CELL primitive_to_xt(CELL primitive);

native/types.c

@@ -64,6 +64,9 @@ CELL object_size(CELL pointer)
 
 	switch(TAG(pointer))
 	{
+	case FIXNUM_TYPE:
+		size = 0;
+		break;
 	case CONS_TYPE:
 		size = sizeof(CONS);
 		break;
@@ -130,3 +133,15 @@ CELL untagged_object_size(CELL pointer)
 
 	return align8(size);
 }
+
+void primitive_type_of(void)
+{
+	check_non_empty(env.dt);
+	env.dt = tag_fixnum(type_of(env.dt));
+}
+
+void primitive_size_of(void)
+{
+	check_non_empty(env.dt);
+	env.dt = tag_fixnum(object_size(env.dt));
+}

native/types.h

@@ -87,3 +87,5 @@ INLINE CELL object_type(CELL tagged)
 void* allot_object(CELL type, CELL length);
 CELL untagged_object_size(CELL pointer);
 CELL object_size(CELL pointer);
+void primitive_type_of(void);
+void primitive_size_of(void);