+- java factor memory leak\r
+- tail call optimization broken again\r
+\r
++ listener:\r
+\r
+- link style lingers\r
+- back space then type: input style gone\r
+- fedit broken with listener\r
+- press enter in the middle of a line\r
+\r
+ native:\r
\r
+- native float>bits\r
- printing floats: append .0 always\r
- vector=\r
- make-image: take a parameter, include le & be images in dist\r
- FactorLib.equal() not very good\r
- IN: format base: work with all types of numbers\r
\r
-+ listener:\r
-\r
-- link style lingers\r
-- back space then type: input style gone\r
-- fedit broken with listener\r
-- press enter in the middle of a line\r
-- new-listener shouldn't suspend continuation in current listener\r
-\r
+ compiler:\r
\r
-- tail call optimization broken again\r
- don't compile inline words\r
- recursive words with code after ifte\r
- less unnecessary args to auxiliary methods\r
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
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"
<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"/>
--- /dev/null
+/* :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;
+ }
+}
--- /dev/null
+### 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
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)
{
public FactorDesktop(String[] args, boolean standalone)
{
super("Factor");
- tabs = new JTabbedPane();
- this.standalone = standalone;
- listeners = new HashMap();
-
- getContentPane().add(BorderLayout.CENTER,tabs);
- try
- {
- 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();
+ getContentPane().add(BorderLayout.CENTER,
+ new FactorListenerPanel(
+ FactorListenerPanel.newInterpreter(args)));
setSize(640,480);
setDefaultCloseOperation(standalone
: 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);
- }
- } //}}}
}
--- /dev/null
+/* :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);
+ }
+ } //}}}
+}
DEFER: handle?
DEFER: room
DEFER: os-env
+DEFER: type-of
+DEFER: size-of
IN: strings
DEFER: str=
float?
str>float
unparse-float
+ float>bits
complex?
real
imaginary
millis
init-random
(random-int)
+ type-of
+ size-of
] [
swap succ tuck primitive,
] each drop ;
: 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 )
: 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 ;
: '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 ;
-: t, object-tag here-as "t" set 7 >header emit 0 'fixnum emit ;
-: empty, 8 >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 t-type >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
: string, ( string -- )
object-tag here-as swap
- 11 >header emit
+ string-type >header emit
dup str-length emit
dup hashcode emit
pack-string
: 'array ( list -- untagged )
[ ' ] inject
here >r
- 9 >header emit
+ array-type >header emit
dup length emit
( elements -- ) [ emit ] each
pad r> ;
: '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> ;
: ' ( obj -- pointer )
[
[ fixnum? ] [ 'fixnum ]
+ [ bignum? ] [ 'bignum ]
+ [ float? ] [ 'float ]
[ word? ] [ 'word ]
[ cons? ] [ 'cons ]
[ char? ] [ 'fixnum ]
init-toplevel
[
+ print-banner
+ room.
interpreter-loop
] [
[ default-error-handler suspend ] when*
: 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 ;
t "startup-done" set
- print-banner
init-interpreter ;
[ 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 ;
: succ 1 + ; inline
: neg 0 swap - ; inline
+
+!: e 2.7182818284590452354 ; inline
+!: pi 3.14159265358979323846 ; inline
+!: pi/2 1.5707963267948966 ; inline
"Incompatible handle: "
"I/O error: "
"Overflow"
+ "Incomparable types: "
] ?nth ;
: ?kernel-error ( cons -- error# param )
init-styles
init-vocab-styles
- print-banner
-
run-user-init
- room.
-
init-interpreter ;
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 ;
[ integer? ] [ unparse-integer ]
[ ratio? ] [ unparse-ratio ]
[ float? ] [ unparse-float ]
+ [ complex? ] [ unparse-complex ]
[ string? ] [ unparse-str ]
[ drop t ] [ <% "#<" % class-of % ">" % %> ]
] cond ;
typedef struct {
CELL header;
+/* FIXME */
+#ifndef FACTOR_64
+ CELL alignment;
+#endif
BIGNUM_2 n;
} BIGNUM;
--- /dev/null
+#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;
+}
--- /dev/null
+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);
#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);
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
typedef struct {
CELL header;
+/* FIXME */
+#ifndef FACTOR_64
+ CELL alignment;
+#endif
double n;
} FLOAT;
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);
primitive_floatp,
primitive_str_to_float,
primitive_float_to_str,
+ primitive_float_to_bits,
primitive_complexp,
primitive_real,
primitive_imaginary,
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)
extern XT primitives[];
-#define PRIMITIVE_COUNT 112
+#define PRIMITIVE_COUNT 115
CELL primitive_to_xt(CELL primitive);
switch(TAG(pointer))
{
+ case FIXNUM_TYPE:
+ size = 0;
+ break;
case CONS_TYPE:
size = sizeof(CONS);
break;
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));
+}
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);
projects / factor.git / commitdiff