steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Factor jEdit plugin!

cvs
Slava Pestov 2004-08-06 06:51:32 +00:00
parent 2740c77a10
commit 0b73b1c864
27 changed files with 567 additions and 163 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
TODO.FACTOR.txt
View File

@ -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

2
build.sh
View File

@ -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

17
build.xml
View File

@ -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"/>

53
factor/jedit/FactorPlugin.java Normal file
View File

@ -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;
}
}

21
factor/jedit/FactorPlugin.props Normal file
View File

@ -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

123
factor/listener/FactorDesktop.java
View File

@ -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);
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
@ -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);
}
} //}}}
}

133
factor/listener/FactorListenerPanel.java Normal file
View File

@ -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);
}
} //}}}
}

5
library/cross-compiler.factor
View File

@ -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 ;

49
library/image.factor
View File

@ -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 ;
: 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
@ -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 ]

2
library/init.factor
View File

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

5
library/platform/jvm/arithmetic.factor
View File

@ -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 ;

1
library/platform/jvm/init.factor
View File

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

22
library/platform/jvm/listener.factor
View File

@ -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 ;

4
library/platform/native/arithmetic.factor
View File

@ -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

1
library/platform/native/errors.factor
View File

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

4
library/platform/native/init.factor
View File

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

4
library/platform/native/unparser.factor
View File

@ -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 ;

4
native/bignum.h
View File

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

191
native/complex.c Normal file
View File

@ -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;
}

34
native/complex.h Normal file
View File

@ -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);

1
native/error.h
View File

@ -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);

5
native/float.c
View File

@ -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

5
native/float.h
View File

@ -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);

5
native/primitives.c
View File

@ -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)

2
native/primitives.h
View File

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

15
native/types.c
View File

@ -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));
}

2
native/types.h
View File

@ -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);