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

new assembler; wrote a new asm primitives

cvs
Slava Pestov 2005-01-07 00:10:02 +00:00
parent 70bf36080e
commit 26f120adb8
25 changed files with 224 additions and 731 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
TODO.FACTOR.txt
View File

@ -1,8 +1,9 @@
+ compiler:
- type inference fails with some assembler words
- optimize away dispatch
- getenv/setenv: if literal arg, compile as a load/store
- assembler opcodes dispatch on operand types
- update compiler for new assembler
+ oop:
@ -33,6 +34,7 @@
+ kernel:
- ppc register decls
- do partial objects cause problems?
- better i/o scheduler
- remove sbufs

8
factor/DefaultVocabularyLookup.java
View File

@ -91,7 +91,7 @@ public class DefaultVocabularyLookup implements VocabularyLookup
FactorWord ine = define("syntax",";");
ine.parsing = new Ine(def,ine);
FactorWord symbol = define("syntax","SYMBOL:");
symbol.parsing = new Symbol(symbol);
symbol.parsing = new Definer(symbol);
/* reading numbers with another base */
FactorWord bin = define("syntax","BIN:");
@ -105,7 +105,7 @@ public class DefaultVocabularyLookup implements VocabularyLookup
FactorWord noParsing = define("syntax","POSTPONE:");
noParsing.parsing = new NoParsing(noParsing);
FactorWord defer = define("syntax","DEFER:");
defer.parsing = new Defer(defer);
defer.parsing = new Definer(defer);
FactorWord in = define("syntax","IN:");
in.parsing = new In(in);
FactorWord use = define("syntax","USE:");
@ -116,9 +116,9 @@ public class DefaultVocabularyLookup implements VocabularyLookup
/* OOP */
FactorWord generic = define("generic","GENERIC:");
generic.parsing = new Generic(generic);
generic.parsing = new Definer(generic);
FactorWord traits = define("generic","TRAITS:");
traits.parsing = new Traits(traits);
traits.parsing = new Definer(traits);
FactorWord beginMethod = define("generic","M:");
beginMethod.parsing = new BeginMethod(beginMethod,def);
FactorWord beginConstructor = define("generic","C:");

3
factor/ExternalFactor.java
View File

@ -123,6 +123,9 @@ public class ExternalFactor extends DefaultVocabularyLookup
*/
public synchronized String eval(String cmd) throws IOException
{
if(isClosed)
throw new IOException("ExternalFactor stream closed");
try
{
waitForAck();

5
factor/FactorMethodDefinition.java
View File

@ -32,15 +32,16 @@ package factor;
/**
* M: type generic ... ;M
*/
public class FactorMethodDefinition extends FactorWordDefinition
public class FactorMethodDefinition
{
private FactorWord type;
private FactorWord generic;
private Cons def;
public FactorMethodDefinition(FactorWord type,
FactorWord generic, Cons def)
{
super(generic);
this.generic = generic;
this.type = type;
this.def = def;
}

41
factor/FactorTraitsDefinition.java
View File

@ -1,41 +0,0 @@
/* :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;
/**
* TRAITS: type
*/
public class FactorTraitsDefinition extends FactorSymbolDefinition
{
public FactorTraitsDefinition(FactorWord word)
{
super(word,word);
}
}

19
factor/FactorWord.java
View File

@ -42,9 +42,9 @@ public class FactorWord implements FactorExternalizable
public FactorParsingDefinition parsing;
/**
* Stub for interpreter definition.
* For browsing, the parsing word that was used to define this word.
*/
public FactorWordDefinition def;
private FactorWord definer;
/**
* Should the parser keep doc comments?
@ -70,4 +70,19 @@ public class FactorWord implements FactorExternalizable
{
return name == null ? "#<unnamed>" : name;
} //}}}
//{{{ getDefiner() method
public FactorWord getDefiner()
{
if(definer == null)
return new FactorWord(null,"DEFER:");
else
return definer;
} //}}}
//{{{ setDefiner() method
public void setDefiner(FactorWord definer)
{
this.definer = definer;
} //}}}
}

62
factor/FactorWordDefinition.java
View File

@ -1,62 +0,0 @@
/* :folding=explicit:collapseFolds=1: */
/*
* $Id$
*
* Copyright (C) 2003, 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;
import java.io.*;
import java.util.*;
/**
* A word definition.
*/
public abstract class FactorWordDefinition
{
public FactorWord word;
//{{{ FactorWordDefinition constructor
/**
* A new definition.
*/
public FactorWordDefinition(FactorWord word)
{
this.word = word;
} //}}}
//{{{ toList() method
public Cons toList()
{
return null;
} //}}}
//{{{ toString() method
public String toString()
{
return getClass().getName() + ": " + word;
} //}}}
}

1
factor/jedit/FactorAsset.java
View File

@ -30,7 +30,6 @@
package factor.jedit;
import factor.FactorWord;
import factor.FactorWordDefinition;
import javax.swing.Icon;
import javax.swing.text.Position;
import org.gjt.sp.jedit.Buffer;

5
factor/jedit/FactorPlugin.props
View File

@ -48,10 +48,7 @@ sidekick.parser.factor.label=Factor
mode.factor.sidekick.parser=factor
factor.completion.in=<font color="#a0a0a0">IN: {0}</font>\
factor.completion.colon=: <b>{0}</b>
factor.completion.defer=DEFER: <b>{0}</b>
factor.completion.parsing=PARSING: <b>{0}</b>
factor.completion.symbol=SYMBOL: <b>{0}</b>
factor.completion.def={0} <b>{1}</b>
factor.completion.stack={0} ( {1})
# Dialog boxes

19
factor/jedit/FactorSideKickParser.java
View File

@ -130,12 +130,12 @@ public class FactorSideKickParser extends SideKickParser
errorSource);
r = new FactorReader(scanner,false,FactorPlugin.getExternalInstance());
Cons parsed = r.parse();
r.parse();
d.in = r.getIn();
d.use = r.getUse();
addWordDefNodes(d,parsed,buffer);
addWordDefNodes(d,r.getDefinedWords(),buffer);
}
catch(FactorParseException pe)
{
@ -172,19 +172,13 @@ public class FactorSideKickParser extends SideKickParser
} //}}}
//{{{ addWordDefNodes() method
private void addWordDefNodes(FactorParsedData d, Cons parsed, Buffer buffer)
private void addWordDefNodes(FactorParsedData d, Cons words, Buffer buffer)
{
FactorAsset last = null;
while(parsed != null)
while(words != null)
{
if(parsed.car instanceof FactorWordDefinition)
{
FactorWordDefinition def
= (FactorWordDefinition)
parsed.car;
FactorWord word = def.word;
FactorWord word = (FactorWord)words.car;
/* word lines are indexed from 1 */
int startLine = Math.max(0,Math.min(
@ -201,9 +195,8 @@ public class FactorSideKickParser extends SideKickParser
last = new FactorAsset(word,buffer.createPosition(start));
d.root.add(new DefaultMutableTreeNode(last));
}
parsed = parsed.next();
words = words.next();
}
if(last != null)

23
factor/jedit/FactorWordRenderer.java
View File

@ -39,19 +39,12 @@ public class FactorWordRenderer extends DefaultListCellRenderer
//{{{ getWordHTMLString() method
public static String getWordHTMLString(FactorWord word, boolean showIn)
{
String prop = "factor.completion.colon";
/* if(def == null)
{
if(word.parsing != null)
prop = "factor.completion.parsing";
else
prop = "factor.completion.defer";
}
else if(def instanceof FactorSymbolDefinition)
{
prop = "factor.completion.symbol";
} */
String defStr = jEdit.getProperty(
"factor.completion.def",
new String[] {
MiscUtilities.charsToEntities(word.getDefiner().name),
MiscUtilities.charsToEntities(word.name)
});
String in;
if(showIn)
@ -64,8 +57,8 @@ public class FactorWordRenderer extends DefaultListCellRenderer
else
in = "";
String html = "<html>" + in + jEdit.getProperty(prop,
new Object[] { MiscUtilities.charsToEntities(word.name) });
String html = "<html>" + in + defStr;
if(word.stackEffect != null)
{
html = jEdit.getProperty("factor.completion.stack",

50
factor/parser/Defer.java
View File

@ -1,50 +0,0 @@
/* :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.parser;
import factor.*;
public class Defer extends FactorParsingDefinition
{
//{{{ Defer constructor
/**
* A new definition.
*/
public Defer(FactorWord word)
{
super(word);
} //}}}
public void eval(FactorReader reader)
throws Exception
{
reader.nextWord(true);
}
}

14
factor/parser/Symbol.java → factor/parser/Definer.java
View File

@ -31,9 +31,13 @@ package factor.parser;
import factor.*;
public class Symbol extends FactorParsingDefinition
/**
* A definer where the word name to be defined follows the parsing word.
* Eg, DEFER: SYMBOL: GENERIC: etc.
*/
public class Definer extends FactorParsingDefinition
{
public Symbol(FactorWord word)
public Definer(FactorWord word)
{
super(word);
}
@ -42,7 +46,9 @@ public class Symbol extends FactorParsingDefinition
throws Exception
{
FactorWord w = reader.nextWord(true);
w.def = new FactorSymbolDefinition(w,w);
reader.append(w.def);
/* Only ever null with restartable scanner;
error already logged, so give up */
if(w != null)
w.setDefiner(word);
}
}

48
factor/parser/Generic.java
View File

@ -1,48 +0,0 @@
/* :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.parser;
import factor.*;
public class Generic extends FactorParsingDefinition
{
public Generic(FactorWord word)
{
super(word);
}
public void eval(FactorReader reader)
throws Exception
{
FactorWord w = reader.nextWord(true);
w.def = new FactorGenericDefinition(w);
reader.append(w.def);
}
}

7
factor/parser/Ine.java
View File

@ -48,10 +48,7 @@ public class Ine extends FactorParsingDefinition
FactorWord w = state.defining;
/* Only ever null with restartable scanner;
error already logged, so give up */
if(w == null)
return;
w.def = new FactorCompoundDefinition(w,state.first);
reader.append(w.def);
if(w != null)
w.setDefiner(start);
}
}

5
library/bootstrap/boot-stage2.factor
View File

@ -181,8 +181,9 @@ os "win32" = [
cpu "x86" = [
[
"/library/compiler/assembly-x86.factor"
"/library/compiler/generator-x86.factor"
"/library/compiler/x86/assembler.factor"
"/library/compiler/x86/generator.factor"
"/library/compiler/x86/fixnum.factor"
] [
dup print
run-resource

229
library/compiler/assembly-x86.factor
View File

@ -1,229 +0,0 @@
! :folding=indent: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.
IN: compiler
USE: kernel
USE: compiler
USE: math
: EAX 0 ;
: ECX 1 ;
: EDX 2 ;
: EBX 3 ;
: ESP 4 ;
: EBP 5 ;
: ESI 6 ;
: EDI 7 ;
: byte? -128 127 between? ;
: eax/other ( reg quot quot -- )
#! Execute first quotation if reg is EAX, second quotation
#! otherwise, leaving reg on the stack.
pick EAX = [ drop nip call ] [ nip call ] ifte ; inline
: byte/eax/cell ( imm reg byte eax cell -- )
#! Assemble an instruction with 3 forms; byte operand, any
#! register; eax register, cell operand; other register,
#! cell operand.
>r >r >r >r dup byte? [
r> r> call r> drop r> drop compile-byte
] [
r> dup EAX = [
drop r> drop r> call r> drop compile-cell
] [
r> drop r> drop r> call compile-cell
] ifte
] ifte ; inline
: MOD-R/M ( r/m reg/opcode mod -- )
#! MOD-R/M is MOD REG/OPCODE R/M
6 shift swap 3 shift bitor bitor compile-byte ;
: PUSH-R ( reg -- )
HEX: 50 + compile-byte ;
: PUSH-[R] ( reg -- )
HEX: ff compile-byte BIN: 110 0 MOD-R/M ;
: PUSH-I ( imm -- )
HEX: 68 compile-byte compile-cell ;
: PUSH-I/PARTIAL ( -- fixup )
#! This is potentially bad. In the compilation of
#! #return-to, we need to push something which is
#! only known later.
#!
#! Returns address of 32-bit immediate.
HEX: 68 compile-byte compiled-offset 0 compile-cell ;
: POP-R ( reg -- )
HEX: 58 + compile-byte ;
: LEAVE ( -- )
HEX: c9 compile-byte ;
: I>R ( imm reg -- )
#! MOV <imm> TO <reg>
HEX: b8 + compile-byte compile-cell ;
: [I]>R ( imm reg -- )
#! MOV INDIRECT <imm> TO <reg>
[
HEX: a1 compile-byte
] [
HEX: 8b compile-byte
BIN: 101 swap 0 MOD-R/M
] eax/other compile-cell ;
: I>[R] ( imm reg -- )
#! MOV <imm> TO INDIRECT <reg>
HEX: c7 compile-byte compile-byte compile-cell ;
: R>[I] ( reg imm -- )
#! MOV <reg> TO INDIRECT <imm>.
swap [
HEX: a3 compile-byte
] [
HEX: 89 compile-byte
BIN: 101 swap 0 MOD-R/M
] eax/other compile-cell ;
: R>R ( reg reg -- )
#! MOV <reg> TO <reg>.
HEX: 89 compile-byte swap BIN: 11 MOD-R/M ;
: [R]>R ( reg reg -- )
#! MOV INDIRECT <reg> TO <reg>.
HEX: 8b compile-byte 0 MOD-R/M ;
: D[R]>R ( disp reg reg -- )
#! MOV INDIRECT DISPLACED <reg> TO <reg>.
HEX: 8b compile-byte 1 MOD-R/M compile-byte ;
: R>[R] ( reg reg -- )
#! MOV <reg> TO INDIRECT <reg>.
HEX: 89 compile-byte swap 0 MOD-R/M ;
: I+[I] ( imm addr -- )
#! ADD <imm> TO ADDRESS <addr>
HEX: 81 compile-byte
BIN: 101 0 0 MOD-R/M
compile-cell
compile-cell ;
: EAX+/PARTIAL ( -- fixup )
#! This is potentially bad. In the compilation of
#! generic and 2generic, we need to add something which is
#! only known later.
#!
#! Returns address of 32-bit immediate.
HEX: 05 compile-byte compiled-offset 0 compile-cell ;
: R+I ( imm reg -- )
#! ADD <imm> TO <reg>, STORE RESULT IN <reg>
[
HEX: 83 compile-byte
0 BIN: 11 MOD-R/M
] [
HEX: 05 compile-byte
] [
HEX: 81 compile-byte
0 BIN: 11 MOD-R/M
] byte/eax/cell ;
: R-I ( imm reg -- )
#! SUBTRACT <imm> FROM <reg>, STORE RESULT IN <reg>
[
HEX: 83 compile-byte
BIN: 101 BIN: 11 MOD-R/M
] [
HEX: 2d compile-byte
] [
HEX: 81 compile-byte
BIN: 101 BIN: 11 MOD-R/M
] byte/eax/cell ;
: R<<I ( imm reg -- )
#! SHIFT <reg> BY <imm>, STORE RESULT IN <reg>
HEX: c1 compile-byte
BIN: 100 BIN: 11 MOD-R/M
compile-byte ;
: R>>I ( imm reg -- )
#! SHIFT <reg> BY <imm>, STORE RESULT IN <reg>
HEX: c1 compile-byte
BIN: 111 BIN: 11 MOD-R/M
compile-byte ;
: CMP-I-R ( imm reg -- )
#! There are three forms of CMP we assemble
#! 83 f8 03 cmpl $0x3,%eax
#! 81 fa 33 33 33 00 cmpl $0x333333,%edx
#! 3d 33 33 33 00 cmpl $0x333333,%eax
[
HEX: 83 compile-byte
BIN: 111 BIN: 11 MOD-R/M
] [
HEX: 3d compile-byte
] [
HEX: 81 compile-byte
BIN: 111 BIN: 11 MOD-R/M
] byte/eax/cell ;
: JUMP-FIXUP ( addr where -- )
#! Encode a relative offset to addr from where at where.
#! Add 4 because addr is relative to *after* insn.
dup >r 4 + - r> set-compiled-cell ;
: (JUMP) ( xt -- fixup )
#! addr is relative to *after* insn
compiled-offset 0 compile-cell ;
: JUMP ( -- fixup )
#! Push address of branch for fixup
HEX: e9 compile-byte (JUMP) ;
: JUMP-[R] ( reg -- )
#! JUMP TO INDIRECT <reg>.
HEX: ff compile-byte BIN: 100 0 MOD-R/M ;
: CALL ( -- fixup )
HEX: e8 compile-byte (JUMP) ;
: CALL-[R] ( reg -- )
#! CALL INDIRECT <reg>.
HEX: ff compile-byte BIN: 10 0 MOD-R/M ;
: JE ( -- fixup )
HEX: 0f compile-byte HEX: 84 compile-byte (JUMP) ;
: JNE ( -- fixup )
HEX: 0f compile-byte HEX: 85 compile-byte (JUMP) ;
: RET ( -- )
HEX: c3 compile-byte ;

6
library/compiler/compiler.factor
View File

@ -102,3 +102,9 @@ M: compound (compile) ( word -- )
] [
"Unsupported CPU" print
] ifte ;
: decompile ( word -- )
[ word-primitive ] keep set-word-primitive ;
: recompile ( word -- )
dup decompile compile ;

175
library/compiler/generator-x86.factor
View File

@ -1,175 +0,0 @@
! :folding=indent: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.
IN: compiler
USE: alien
USE: inference
USE: kernel
USE: namespaces
USE: words
USE: lists
USE: math
: DS ( -- address ) "ds" f dlsym ;
: absolute-ds ( -- )
#! Add an entry to the relocation table for the 32-bit
#! immediate just compiled.
"ds" f f rel-dlsym ;
: PEEK-DS ( -- )
#! Peek datastack to EAX.
DS ECX [I]>R absolute-ds
ECX EAX [R]>R ;
: POP-DS ( -- )
#! Pop datastack to EAX.
PEEK-DS
4 ECX R-I
ECX DS R>[I] absolute-ds ;
#push-immediate [
DS ECX [I]>R absolute-ds
4 ECX R+I
address ECX I>[R]
ECX DS R>[I] absolute-ds
] "generator" set-word-property
#push-indirect [
DS ECX [I]>R absolute-ds
4 ECX R+I
intern-literal EAX [I]>R rel-address
EAX ECX R>[R]
ECX DS R>[I] absolute-ds
] "generator" set-word-property
#replace-immediate [
DS ECX [I]>R absolute-ds
address ECX I>[R]
ECX DS R>[I] absolute-ds
] "generator" set-word-property
#replace-indirect [
DS ECX [I]>R absolute-ds
intern-literal EAX [I]>R rel-address
EAX ECX R>[R]
ECX DS R>[I] absolute-ds
] "generator" set-word-property
#slot [
PEEK-DS
2unlist type-tag >r cell * r> - EAX EAX D[R]>R
DS ECX [I]>R absolute-ds
EAX ECX R>[R]
] "generator" set-word-property
#call [
dup dup postpone-word
CALL compiled-offset defer-xt
t rel-word
] "generator" set-word-property
#jump [
dup dup postpone-word
JUMP compiled-offset defer-xt
t rel-word
] "generator" set-word-property
#call-label [
CALL compiled-offset defer-xt
] "generator" set-word-property
#jump-label [
JUMP compiled-offset defer-xt
] "generator" set-word-property
#jump-t [
POP-DS
! condition is now in EAX
f address EAX CMP-I-R
! jump w/ address added later
JNE compiled-offset defer-xt
] "generator" set-word-property
#return-to [
PUSH-I/PARTIAL 0 defer-xt rel-address
] "generator" set-word-property
#return [ drop RET ] "generator" set-word-property
#dispatch [
#! Compile a piece of code that jumps to an offset in a
#! jump table indexed by the fixnum at the top of the stack.
#! The jump table must immediately follow this macro.
drop
POP-DS
1 EAX R>>I
EAX+/PARTIAL ( -- fixup ) rel-address
EAX JUMP-[R]
compile-aligned
compiled-offset swap set-compiled-cell ( fixup -- )
] "generator" set-word-property
#target [
#! Jump table entries are absolute addresses.
compiled-offset 0 compile-cell 0 defer-xt rel-address
] "generator" set-word-property
#c-call [
uncons load-dll 2dup dlsym CALL JUMP-FIXUP t rel-dlsym
] "generator" set-word-property
#unbox [
dup f dlsym CALL JUMP-FIXUP f t rel-dlsym
EAX PUSH-R
] "generator" set-word-property
#box [
EAX PUSH-R
dup f dlsym CALL JUMP-FIXUP f t rel-dlsym
4 ESP R+I
] "generator" set-word-property
#cleanup [
dup 0 = [ drop ] [ ESP R+I ] ifte
] "generator" set-word-property
[
[ #drop drop ]
[ #dup dup ]
[ #swap swap ]
[ #over over ]
[ #pick pick ]
[ #>r >r ]
[ #r> r> ]
] [
uncons
[
car dup CALL compiled-offset defer-xt t rel-word drop
] cons
"generator" set-word-property
] each

5
library/compiler/simplifier.factor
View File

@ -42,9 +42,6 @@ USE: unparser
USE: vectors
USE: words
! <LittleDan> peephole?
! <LittleDan> "whose peephole are we optimizing" "your mom's"
: labels ( linear -- list )
#! Make a list of all labels defined in the linear IR.
[ [ unswons #label = [ , ] [ drop ] ifte ] each ] make-list ;
@ -80,7 +77,7 @@ USE: words
dup [ uncons simplify-node drop (simplify) ] [ drop ] ifte ;
: simplify ( linear -- linear )
purge-labels [ (simplify) ] make-list ;
( purge-labels ) [ (simplify) ] make-list ;
: follow ( linear -- linear )
dup car car "follow" [ ] singleton ;

113
library/compiler/x86/fixnum.factor Normal file
View File

@ -0,0 +1,113 @@
! :folding=indent: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.
USE: compiler
IN: math-internals
USE: assembler
USE: inference
USE: math
USE: words
USE: kernel
USE: alien
USE: lists
! This file provides compiling definitions for fixnum words
! that are faster than what C gives us.
#drop [
drop
ECX DS>
ECX 4 SUB
ECX >DS
] "generator" set-word-property
#dup [
drop
ECX DS>
EAX [ ECX ] MOV
ECX 4 ADD
[ ECX ] EAX MOV
ECX >DS
] "generator" set-word-property
#swap [
drop
ECX DS>
EAX [ ECX ] MOV
EDX [ ECX -4 ] MOV
[ ECX ] EDX MOV
[ ECX -4 ] EAX MOV
] "generator" set-word-property
#over [
drop
ECX DS>
EAX [ ECX -4 ] MOV
ECX 4 ADD
[ ECX ] EAX MOV
ECX >DS
] "generator" set-word-property
#pick [
drop
ECX DS>
EAX [ ECX -8 ] MOV
ECX 4 ADD
[ ECX ] EAX MOV
ECX >DS
] "generator" set-word-property
\ #dup f "linearize" set-word-property
: self ( word -- )
f swap dup "infer-effect" word-property (consume/produce) ;
\ fixnum- [ \ fixnum- self ] "infer" set-word-property
\ fixnum+ [ \ fixnum+ self ] "infer" set-word-property
: fixnum-insn ( overflow opcode -- )
#! This needs to be factored.
ECX DS>
EAX [ ECX -4 ] MOV
EAX [ ECX ] rot execute
0 JNO fixup
swap compile-call
0 JMP fixup >r
compiled-offset swap patch
ECX 4 SUB
[ ECX ] EAX MOV
ECX >DS
r> compiled-offset swap patch ;
\ fixnum+ [
drop \ fixnum+ \ ADD fixnum-insn
] "generator" set-word-property
\ fixnum- [
drop \ fixnum- \ SUB fixnum-insn
] "generator" set-word-property

11
library/test/benchmark/fib.factor
View File

@ -3,6 +3,17 @@ USE: compiler
USE: kernel
USE: math
USE: test
USE: math-internals
: fixnum-fib ( n -- nth fibonacci number )
dup 1 fixnum<= [
drop 1
] [
1 fixnum- dup fixnum-fib swap 1 fixnum- fixnum-fib fixnum+
] ifte ;
compiled
[ 9227465 ] [ 34 fixnum-fib ] unit-test
: fib ( n -- nth fibonacci number )
dup 1 <= [ drop 1 ] [ 1 - dup fib swap 1 - fib + ] ifte ;

46
library/test/compiler/asm-test.factor
View File

@ -1,46 +0,0 @@
IN: scratchpad
USE: compiler
0 EAX I>R
0 ECX I>R
0 EAX [I]>R
0 ECX [I]>R
0 EAX I>[R]
0 ECX I>[R]
EAX 0 R>[I]
ECX 0 R>[I]
EAX EAX [R]>R
EAX ECX [R]>R
ECX EAX [R]>R
ECX ECX [R]>R
EAX EAX R>[R]
EAX ECX R>[R]
ECX EAX R>[R]
ECX ECX R>[R]
4 0 I+[I]
0 4 I+[I]
4 EAX R+I
4 ECX R+I
65535 EAX R+I
65535 ECX R+I
4 EAX R-I
4 ECX R-I
65535 EAX R-I
65535 ECX R-I
EAX PUSH-R
ECX PUSH-R
EAX PUSH-[R]
ECX PUSH-[R]
65535 PUSH-I
EAX JUMP-[R]
ECX JUMP-[R]

6
library/test/compiler/generic.factor
View File

@ -73,10 +73,10 @@ USE: words
[ drop ]
[ drop ]
[ drop ]
} single-combination + ; compiled
} single-combination ; compiled
[ 5 ] [ 2 3 4 single-combination-test-alt ] unit-test
[ 7/2 ] [ 2 3 3/2 single-combination-test-alt ] unit-test
[ 5 ] [ 2 3 4 single-combination-test-alt + ] unit-test
[ 7/2 ] [ 2 3 3/2 single-combination-test-alt + ] unit-test
DEFER: single-combination-test-2

26
library/test/compiler/stack.factor
View File

@ -7,16 +7,26 @@ USE: math
USE: kernel
! Make sure that stack ops compile to correct code.
: compile-call ( quot -- word )
: compile-1 ( quot -- word )
gensym [ swap define-compound ] keep dup compile execute ;
[ ] [ 1 [ drop ] compile-call ] unit-test
[ ] [ [ 1 drop ] compile-call ] unit-test
[ ] [ [ 1 2 2drop ] compile-call ] unit-test
[ ] [ 1 [ 2 2drop ] compile-call ] unit-test
[ ] [ 1 2 [ 2drop ] compile-call ] unit-test
[ 1 1 ] [ 1 [ dup ] compile-call ] unit-test
[ 1 1 ] [ [ 1 dup ] compile-call ] unit-test
[ ] [ 1 [ drop ] compile-1 ] unit-test
[ ] [ [ 1 drop ] compile-1 ] unit-test
[ ] [ [ 1 2 2drop ] compile-1 ] unit-test
[ ] [ 1 [ 2 2drop ] compile-1 ] unit-test
[ ] [ 1 2 [ 2drop ] compile-1 ] unit-test
[ 2 1 ] [ [ 1 2 swap ] compile-1 ] unit-test
[ 2 1 ] [ 1 [ 2 swap ] compile-1 ] unit-test
[ 2 1 ] [ 1 2 [ swap ] compile-1 ] unit-test
[ 1 1 ] [ 1 [ dup ] compile-1 ] unit-test
[ 1 1 ] [ [ 1 dup ] compile-1 ] unit-test
[ 1 2 1 ] [ [ 1 2 over ] compile-1 ] unit-test
[ 1 2 1 ] [ 1 [ 2 over ] compile-1 ] unit-test
[ 1 2 1 ] [ 1 2 [ over ] compile-1 ] unit-test
[ 1 2 3 1 ] [ [ 1 2 3 pick ] compile-1 ] unit-test
[ 1 2 3 1 ] [ 1 [ 2 3 pick ] compile-1 ] unit-test
[ 1 2 3 1 ] [ 1 2 [ 3 pick ] compile-1 ] unit-test
[ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-1 ] unit-test
! Test various kill combinations