-CC = gcc
+CC = gcc34
# On FreeBSD, to use SDL and other libc_r libs:
-CFLAGS = -g -Wall -export-dynamic -pthread
+# CFLAGS = -g -Wall -export-dynamic -pthread
# On PowerPC G5:
# CFLAGS = -mcpu=970 -mtune=970 -mpowerpc64 -ffast-math -O3
# On Pentium 4:
-# CFLAGS = -march=pentium4 -ffast-math -O3 -fomit-frame-pointer -export-dynamic
+CFLAGS = -march=pentium4 -ffast-math -Os -fomit-frame-pointer -export-dynamic -pthread
# Add -fomit-frame-pointer if you don't care about debugging
# CFLAGS = -Os -g -Wall
\r
- BIN: 2: bad\r
\r
-- symbols are not primitives\r
+- compile word twice; no more 'cannot compile' error!\r
+\r
- compiled? messy\r
- compiler: drop literal peephole optimization\r
-- compiler: type-of { ... } call\r
- type-of { ... } execute\r
- arithmetic-type { ... } call\r
- arithmetic-type { ... } execute\r
-- ditch ds/cs envs, just use dlsym instead\r
+- compiler: arithmetic-type { ... } execute\r
- getenv/setenv: if literal arg, compile as a load/store\r
- inline words\r
-- raise an error when compiling something we can't\r
- call, datastack/callstack, set-datastack/callstack,\r
- execute\r
\r
[error] SideKick$BufferChangeHandler: We have cplusplus.xml (/home/slava/jEdit/modes/) but got event for DefaultInputHandler.java (/home/slava/jEdit/org/gjt/sp/jedit/gui/)\r
[error] SideKick$BufferChangeHandler: We have cplusplus.xml (/home/slava/jEdit/modes/) but got event for DefaultInputHandler.java (/home/slava/jEdit/org/gjt/sp/jedit/gui/)\r
#! Call named C function in Factor interpreter executable.
dlsym-self CALL JUMP-FIXUP ;
-: TYPE-OF ( -- )
+: TYPE ( -- )
#! Peek datastack, store type # in EAX.
PEEK-DS
EAX PUSH-[R]
"type_of" SELF-CALL
4 ESP R+I ;
+
+: ARITHMETIC-TYPE ( -- )
+ #! Peek top two on datastack, store arithmetic type # in EAX.
+ PEEK-DS
+ EAX PUSH-[R]
+ 4 EAX R-I
+ EAX PUSH-[R]
+ "arithmetic_type" SELF-CALL
+ 8 ESP R+I ;
USE: lists
USE: vectors
+: begin-jump-table ( -- start-fixup end-fixup )
+ 2 EAX R<<I
+ EAX+/PARTIAL
+ tail? [ 0 ] [ 0 PUSH-I compiled-offset 4 - ] ifte ;
+
: compile-table-jump ( start-fixup -- end-fixup )
+ #! Compile a piece of code that jumps to an offset in a
+ #! jump table indexed by the type of the Factor object in
+ #! EAX.
#! The 32-bit address of the code after the jump table
#! should be written to end-fixup.
#! The jump table must immediately follow this macro.
- tail? [ 0 ] [ 0 PUSH-I compiled-offset 4 - ] ifte >r
- ( start-fixup r:end-fixup )
EAX JUMP-[R]
cell compile-aligned
- compiled-offset swap set-compiled-cell ( update the ADD )
- r> ;
-
-: begin-jump-table ( -- end-fixup )
- #! Compile a piece of code that jumps to an offset in a
- #! jump table indexed by the type of the Factor object in
- #! EAX.
- TYPE-OF
- 2 EAX R<<I
- EAX+/PARTIAL
- compile-table-jump ;
+ compiled-offset swap set-compiled-cell ( update the ADD ) ;
: jump-table-entry ( word -- )
#! Jump table entries are absolute addresses.
dup postpone-word
compiled-offset 0 compile-cell 0 fixup-deferred-xt ;
-: compile-jump-table ( vtable -- )
- #! Compile a table of words as a word-array of XTs.
- num-types [
- over ?vector-nth jump-table-entry
- ] times* drop ;
-
: end-jump-table ( end-fixup -- )
#! update the PUSH.
dup 0 = [
compiled-offset swap set-compiled-cell
] ifte ;
+: (compile-jump-table) ( vtable -- )
+ num-types [
+ over ?vector-nth jump-table-entry
+ ] times* drop ;
+
+: compile-jump-table ( vtable -- )
+ #! Compile a table of words as a word-array of XTs.
+ begin-jump-table >r
+ compile-table-jump
+ (compile-jump-table)
+ r> end-jump-table ;
+
: compile-generic ( compile-time: vtable -- )
#! Compile a faster alternative to
#! : generic ( obj vtable -- )
#! >r dup type r> vector-nth execute ;
- begin-jump-table
- pop-literal compile-jump-table
- end-jump-table ;
+ pop-literal commit-literals
+ TYPE compile-jump-table ;
+
+: compile-2generic ( compile-time: vtable -- )
+ #! Compile a faster alternative to
+ #! : 2generic ( obj vtable -- )
+ #! >r 2dup arithmetic-type r> vector-nth execute ;
+ pop-literal commit-literals
+ ARITHMETIC-TYPE compile-jump-table ;
[ compile-generic ] \ generic "compiling" set-word-property
+[ compile-2generic ] \ 2generic "compiling" set-word-property
"compiling" set-word-property ;
\ call word-interpret-only
+\ execute word-interpret-only
\ datastack word-interpret-only
\ callstack word-interpret-only
\ set-datastack word-interpret-only
\ set-callstack word-interpret-only
-\ 2generic word-interpret-only
USE: combinators
USE: words
-: generic-test ( obj -- hash )
+: generic-test
{
drop
drop
[ 2 3 ] [ 2 3 4 generic-test ] unit-test
[ 2 f ] [ 2 3 f generic-test ] unit-test
-: generic-test-alt ( obj -- hash )
+: generic-literal-test
+ 4 {
+ drop
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ nip
+ } generic ; compiled
+
+[ ] [ generic-literal-test ] unit-test
+
+: generic-test-alt
{
drop
drop
#include "factor.h"
-void primitive_arithmetic_type(void)
+CELL arithmetic_type(CELL obj1, CELL obj2)
{
- CELL type2 = type_of(dpop());
- CELL type1 = type_of(dpop());
+ CELL type1 = type_of(obj1);
+ CELL type2 = type_of(obj2);
CELL type;
switch(type1)
type = type1;
break;
}
- dpush(tag_fixnum(type));
+
+ return type;
+}
+
+void primitive_arithmetic_type(void)
+{
+ CELL obj2 = dpop();
+ CELL obj1 = dpop();
+ dpush(tag_fixnum(arithmetic_type(obj1,obj2)));
}
bool realp(CELL tagged)
#include "factor.h"
+CELL arithmetic_type(CELL obj1, CELL obj2);
void primitive_arithmetic_type(void);
bool realp(CELL tagged);
projects / factor.git / commitdiff