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

progress on self hosting

cvs
Slava Pestov 2004-07-30 06:44:12 +00:00
parent f7ed302b47
commit 62c6e5ac02
20 changed files with 351 additions and 251 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.FACTOR.txt
View File

@ -1,10 +1,8 @@
+ native:
- gc when memory is tight
- f >n: crashes
- typecases: type error reporting bad
- image output
- 64-bit "bignums"
- floats
- {...} vectors
- parsing should be parsing
@ -48,6 +46,7 @@
+ misc:
- compiled stack traces broken
- should i -i inf -inf be parsing words?
- namespace clone drops static var bindings
- ditch map

7
factor/FactorReader.java
View File

@ -331,12 +331,7 @@ public class FactorReader
if(interp.getVocabulary(name) == null)
error("Undefined vocabulary: " + name);
Cons use = getUse();
if(!Cons.contains(use,name))
use = new Cons(name,use);
setUse(use);
setUse(new Cons(name,getUse()));
} //}}}
//{{{ parse() method

178
library/cross-compiler.factor Normal file
View File

@ -0,0 +1,178 @@
! :folding=none: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: cross-compiler
USE: arithmetic
USE: kernel
USE: lists
USE: parser
USE: stack
USE: stdio
USE: streams
USE: strings
USE: vectors
USE: vectors
USE: vocabularies
USE: words
IN: kernel
DEFER: getenv
DEFER: setenv
DEFER: save-image
DEFER: handle?
DEFER: room
IN: strings
DEFER: str=
DEFER: str-hashcode
IN: io-internals
DEFER: open-file
DEFER: server-socket
DEFER: close-fd
DEFER: accept-fd
DEFER: read-line-fd-8
DEFER: write-fd-8
DEFER: flush-fd
DEFER: shutdown-fd
IN: words
DEFER: <word>
DEFER: word-primitive
DEFER: set-word-primitive
DEFER: word-parameter
DEFER: set-word-parameter
DEFER: word-plist
DEFER: set-word-plist
IN: cross-compiler
: primitives, ( -- )
1 [
execute
call
ifte
cons?
cons
car
cdr
rplaca
rplacd
vector?
<vector>
vector-length
set-vector-length
vector-nth
set-vector-nth
string?
str-length
str-nth
str-compare
str=
str-hashcode
index-of*
substring
sbuf?
<sbuf>
sbuf-length
set-sbuf-length
sbuf-nth
set-sbuf-nth
sbuf-append
sbuf>str
fixnum?
bignum?
+
-
*
/
mod
/mod
bitand
bitor
bitxor
bitnot
shift<
shift>
<
<=
>
>=
word?
<word>
word-primitive
set-word-primitive
word-parameter
set-word-parameter
word-plist
set-word-plist
drop
dup
swap
over
pick
nip
tuck
rot
>r
r>
eq?
getenv
setenv
open-file
garbage-collection
save-image
datastack
callstack
set-datastack
set-callstack
handle?
exit*
server-socket
close-fd
accept-fd
read-line-fd-8
write-fd-8
flush-fd
shutdown-fd
room
] [
swap succ tuck primitive,
] each drop ;
: version, ( -- )
"version" [ "kernel" ] search version unit compound, ;
: make-image ( -- )
#! Make an image for the C interpreter.
[
"/library/platform/native/boot.factor" run-resource
] with-image
! Uncomment this on sparc and powerpc.
! "big-endian" on
"factor.image" write-image ;

6
library/debugger.factor
View File

@ -54,6 +54,10 @@ USE: unparser
: in-parser? ( -- ? )
"line" get "pos" get and ;
: error-handler-hook
#! The game overrides this.
;
: default-error-handler ( error -- )
#! Print the error and return to the top level.
[
@ -63,6 +67,8 @@ USE: unparser
":s :r :n :c show stacks at time of error." print
java? [ ":j shows Java stack trace." print ] when
error-handler-hook
] when* ;
: :s ( -- ) "error-datastack" get . ;

4
library/httpd/http-common.factor
View File

@ -53,9 +53,7 @@ USE: url-encoding
: httpd-error ( error -- )
dup log-error
[ "text/html" response ] [ error-body ] cleave
cat2
print ;
<% dup "text/html" response % error-body % %> print ;
: read-header-iter ( alist -- alist )
read dup "" = [

2
library/httpd/responder.factor
View File

@ -1,4 +1,4 @@
! :folding=indent:collapseFolds=0:
! :folding=indent:collapseFolds=1:
! $Id$
!

4
library/platform/native/image.factor → library/image.factor
View File

@ -184,7 +184,7 @@ DEFER: '
object-tag here-as swap
11 >header emit
dup str-length emit
dup hashcode fixnum-mask bitand emit
dup hashcode ( fixnum-mask bitand ) emit
pack-string
pad ;
@ -224,7 +224,7 @@ IN: cross-compiler
dup word-name "name" swons ,
dup word-vocabulary "vocabulary" swons ,
[ "parsing" get >boolean ] bind "parsing" swons ,
"parsing" swap word-property >boolean "parsing" swons ,
,] ' ;

14
library/init.factor
View File

@ -44,9 +44,13 @@ USE: strings
! on all other words already being defined.
: init-search-path ( -- )
#! Sets up the default vocabularies.
! For files
"user" "file-in" set
[ "user" "builtins" ] "file-use" set
! For interactive
"user" "in" set
[
"user" ! This is first
"user"
"arithmetic"
"builtins"
"combinators"
@ -72,10 +76,8 @@ USE: strings
"vectors"
"vocabularies"
"words"
"scratchpad" ! This is last
] "use" set
! New words go in 'user' vocabulary.
"user" "in" set ;
"scratchpad"
] "use" set ;
: init-scratchpad ( -- )
#! The contents of the scratchpad vocabulary is not saved

72
library/lists.factor
View File

@ -94,10 +94,6 @@ USE: stack
2drop f
] ifte ;
: count ( n -- [ 1 2 3 ... n ] )
#! If n <= 0, pushes the empty list.
[ [ ] times* ] cons expand ;
: nth ( n list -- list[n] )
#! Gets the nth element of a proper list by successively
#! iterating down the cdr pointer.
@ -165,32 +161,20 @@ USE: stack
#! DESTRUCTIVE. Reverse the given list, without consing.
f swap nreverse-iter ;
~<< partition-iterI
R1 R2 A D C -- A C r:R1 r:R2 r:A r:D r:C >>~
: partition-add ( obj ? ret1 ret2 -- ret1 ret2 )
>r >r [ r> cons r> ] [ r> r> swapd cons ] ifte ; inline
~<< partition-iterT{
r:R1 r:R2 r:A r:D r:C -- A R1 r:R1 r:R2 r:D r:C >>~
: partition-step ( ret1 ret2 ref combinator car -- ret1 ret2 )
>r 2swap r> -rot >r >r dup >r swap call r> swap r> r>
partition-add ; inline
~<< }partition-iterT
R1 r:R1X r:R2 r:D r:C -- R1 R2 D C >>~
~<< partition-iterF{
r:R1 r:R2 r:A r:D r:C -- A R2 r:R1 r:R2 r:D r:C >>~
~<< }partition-iterF
R2 r:R1 r:R2X r:D r:C -- R1 R2 D C >>~
: partition-iter ( ref ret1 ret2 list combinator -- ref ret1 ret2 )
#! Helper word for 'partition'.
over [
! Note this ifte must be in tail position!
>r uncons r> partition-iterI >r >r dup r> r> call [
partition-iterT{ cons }partition-iterT partition-iter
] [
partition-iterF{ cons }partition-iterF partition-iter
] ifte
: partition-iter ( ret1 ret2 ref combinator list -- ret1 ret2 )
dup [
3dup cdr >r >r >r
car partition-step
r> r> r> partition-iter
] [
2drop
3drop
] ifte ; inline interpret-only
: partition ( ref list combinator -- list1 list2 )
@ -200,19 +184,8 @@ USE: stack
#! the first or second list.
#! The combinator must have stack effect:
#! ( ref element -- ? )
[ ] [ ] 2swap partition-iter rot drop ; inline interpret-only
: remove ( obj list -- list )
#! Remove all occurrences of the object from the list.
dup [
2dup car = [
cdr remove
] [
uncons swapd remove cons
] ifte
] [
nip
] ifte ;
swap >r >r >r [ ] [ ] r> r> r> partition-iter ;
inline interpret-only
: sort ( list comparator -- sorted )
#! Sort the elements in a proper list using a comparator.
@ -235,6 +208,18 @@ USE: stack
#! Sorts the list into ascending numerical order.
[ > ] sort ;
: remove ( obj list -- list )
#! Remove all occurrences of the object from the list.
dup [
2dup car = [
cdr remove
] [
uncons swapd remove cons
] ifte
] [
nip
] ifte ;
! Redefined below
DEFER: tree-contains?
@ -293,13 +278,6 @@ DEFER: tree-contains?
transp over >r >r call r> cons r>
] each drop nreverse ; inline interpret-only
: map ( [ items ] [ code ] -- [ mapping ] )
#! Applies the code to each item, returns a list that
#! contains the result of each application.
#!
#! This combinator will not compile.
2list restack each unstack ; inline interpret-only
: subset-add ( car pred accum -- accum )
>r over >r call r> r> rot [ cons ] [ nip ] ifte ;

6
library/math/arithmetic.factor
View File

@ -57,14 +57,14 @@ USE: stack
>=< call ; inline interpret-only
: max ( x y -- z )
2dup > -rot ? ;
2dup > [ drop ] [ nip ] ifte ;
: min ( x y -- z )
2dup < -rot ? ;
2dup < [ drop ] [ nip ] ifte ;
: between? ( x min max -- ? )
#! Push if min <= x <= max.
[ [ dup ] dip max ] dip min = ;
>r dupd max r> min = ;
: sq dup * ; inline

5
library/platform/jvm/boot-sumo.factor
View File

@ -99,8 +99,9 @@ USE: parser
"/library/telnetd.factor" run-resource ! telnetd
!!! Java -> native VM image cross-compiler.
"/library/platform/native/image.factor" run-resource ! cross-compiler
"/library/platform/native/cross-compiler.factor" run-resource ! cross-compiler
"/library/image.factor" run-resource ! cross-compiler
"/library/cross-compiler.factor" run-resource ! cross-compiler
"/library/platform/jvm/cross-compiler.factor" run-resource ! cross-compiler
!!! HTTPD.
"/library/httpd/url-encoding.factor" run-resource ! url-encoding

7
library/platform/jvm/combinators.factor
View File

@ -39,3 +39,10 @@ USE: stack
restack
call
unstack ; interpret-only
: map ( [ items ] [ code ] -- [ mapping ] )
#! Applies the code to each item, returns a list that
#! contains the result of each application.
#!
#! This combinator will not compile.
2list restack each unstack ; inline interpret-only

53
library/platform/jvm/cross-compiler.factor Normal file
View File

@ -0,0 +1,53 @@
! :folding=none: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: cross-compiler
USE: arithmetic
USE: kernel
USE: lists
USE: parser
USE: stack
USE: stdio
USE: streams
USE: strings
USE: vectors
USE: vectors
USE: vocabularies
USE: words
: worddef, ( word -- )
dup compound-or-compiled? [
dup word-of-worddef swap compound>list compound,
] [
drop
] ifte ;
: cross-compile ( quot -- )
[ dup worddef? [ worddef, ] [ drop ] ifte ] each ;
: cross-compile-resource ( resource -- )
parse-resource cross-compile ;

6
library/platform/jvm/stack2.factor
View File

@ -65,7 +65,7 @@ USE: vectors
clone set-callstack* ; interpret-only
: clear ( -- )
#! Clear the datastack. For interactive use only; invoking this from a
#! word definition will clobber any values left on the data stack by the
#! caller.
#! Clear the datastack. For interactive use only; invoking
#! this from a word definition will clobber any values left
#! on the data stack by the caller.
datastack* vector-clear ;

24
library/platform/native/arithmetic.factor Normal file
View File

@ -0,0 +1,24 @@
! This file will go away very shortly!
IN: arithmetic
USE: combinators
USE: kernel
USE: logic
USE: stack
: integer? dup fixnum? swap bignum? or ;
: max ( x y -- z )
2dup > [ drop ] [ nip ] ifte ;
: min ( x y -- z )
2dup < [ drop ] [ nip ] ifte ;
: between? ( x min max -- ? )
#! Push if min <= x <= max.
>r dupd max r> min = ;
: pred 1 - ; inline
: succ 1 + ; inline
: neg 0 swap - ; inline

17
library/platform/native/boot.factor
View File

@ -47,6 +47,7 @@ primitives,
[
"/library/ansi.factor"
"/library/assoc.factor"
"/library/cross-compiler.factor"
"/library/combinators.factor"
"/library/cons.factor"
"/library/continuations.factor"
@ -54,10 +55,12 @@ primitives,
"/library/errors.factor"
"/library/format.factor"
"/library/hashtables.factor"
"/library/image.factor"
"/library/init.factor"
"/library/inspector.factor"
"/library/inspect-vocabularies.factor"
"/library/interpreter.factor"
"/library/lists.factor"
"/library/list-namespaces.factor"
"/library/logging.factor"
"/library/logic.factor"
@ -76,11 +79,12 @@ primitives,
"/library/words.factor"
"/library/math/math-combinators.factor"
"/library/math/namespace-math.factor"
"/library/platform/native/arithmetic.factor"
"/library/platform/native/cross-compiler.factor"
"/library/platform/native/errors.factor"
"/library/platform/native/io-internals.factor"
"/library/platform/native/stream.factor"
"/library/platform/native/kernel.factor"
"/library/platform/native/image.factor"
"/library/platform/native/namespaces.factor"
"/library/platform/native/parse-numbers.factor"
"/library/platform/native/parser.factor"
@ -96,17 +100,6 @@ primitives,
] [
cross-compile-resource
] each
[
! We don't include all of 'lists' or 'math' yet...
between? min max
append add remove contains unique
pred succ neg fib each nreverse nreverse-iter
max 2list length reverse nth list? 2rlist
all? clone-list clone-list-iter subset subset-iter
subset-add car= cdr= cons= cons-hashcode
tree-contains? =-or-contains?
last* last inject integer?
] [ worddef worddef, ] each
version,

173
library/platform/native/cross-compiler.factor
View File

@ -26,169 +26,22 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: cross-compiler
USE: arithmetic
USE: kernel
USE: lists
USE: namespaces
USE: parser
USE: stack
USE: stdio
USE: streams
USE: strings
USE: vectors
USE: vectors
USE: vocabularies
USE: words
IN: kernel
DEFER: getenv
DEFER: setenv
DEFER: save-image
DEFER: handle?
DEFER: room
IN: strings
DEFER: str=
DEFER: str-hashcode
IN: io-internals
DEFER: open-file
DEFER: server-socket
DEFER: close-fd
DEFER: accept-fd
DEFER: read-line-fd-8
DEFER: write-fd-8
DEFER: flush-fd
DEFER: shutdown-fd
IN: words
DEFER: <word>
DEFER: word-primitive
DEFER: set-word-primitive
DEFER: word-parameter
DEFER: set-word-parameter
DEFER: word-plist
DEFER: set-word-plist
IN: cross-compiler
: primitives, ( -- )
1 [
execute
call
ifte
cons?
cons
car
cdr
rplaca
rplacd
vector?
<vector>
vector-length
set-vector-length
vector-nth
set-vector-nth
string?
str-length
str-nth
str-compare
str=
str-hashcode
index-of*
substring
sbuf?
<sbuf>
sbuf-length
set-sbuf-length
sbuf-nth
set-sbuf-nth
sbuf-append
sbuf>str
fixnum?
bignum?
+
-
*
/
mod
/mod
bitand
bitor
bitxor
bitnot
shift<
shift>
<
<=
>
>=
word?
<word>
word-primitive
set-word-primitive
word-parameter
set-word-parameter
word-plist
set-word-plist
drop
dup
swap
over
pick
nip
tuck
rot
>r
r>
eq?
getenv
setenv
open-file
garbage-collection
save-image
datastack
callstack
set-datastack
set-callstack
handle?
exit*
server-socket
close-fd
accept-fd
read-line-fd-8
write-fd-8
flush-fd
shutdown-fd
room
] [
swap succ tuck primitive,
] each drop ;
: worddef, ( word -- )
dup compound-or-compiled? [
dup word-of-worddef swap compound>list compound,
] [
drop
] ifte ;
: version, ( -- )
"version" [ "kernel" ] search
version unit
<compound>
worddef, ;
: cross-compile ( quot -- )
[ dup worddef? [ worddef, ] [ drop ] ifte ] each ;
: cross-compile-resource ( resource -- )
parse-resource cross-compile ;
<namespace> [
! Replace ; with our own
"file-use" get
"cross-compiler-syntax" swons
"file-use" set
run-resource
] bind ;
: make-image ( -- )
#! Make an image for the C interpreter.
[
"/library/platform/native/boot.factor" run-resource
] with-image
IN: cross-compiler-syntax
USE: builtins
! Uncomment this on sparc and powerpc.
! "big-endian" on
"factor.image" write-image ;
: ; ( -- )
#! Cross-compile the just-read definition.
nreverse compound, ; parsing

2
library/platform/native/kernel.factor
View File

@ -110,5 +110,3 @@ IN: strings
: >char ;
: >upper ;
: >lower ;
IN: lists
: sort ;

11
library/platform/native/parse-stream.factor
View File

@ -35,6 +35,7 @@ USE: namespaces
USE: stack
USE: stdio
USE: streams
USE: strings
: next-line ( -- str )
"parse-stream" get freadln
@ -58,8 +59,8 @@ USE: streams
: init-parser ( name -- seed )
"parse-name" set
"user" "in" set
[ "builtins" "user" ] "use" set
"file-in" get "in" set
"file-use" get "use" set
f ;
: parse-stream ( name stream -- code )
@ -72,3 +73,9 @@ USE: streams
: run-file ( file -- )
parse-file call ;
: resource-path ( -- path )
"resource-path" get [ "." ] unless* ;
: run-resource ( file -- )
resource-path swap cat2 run-file ;

8
library/platform/native/stack.factor
View File

@ -26,12 +26,20 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: stack
USE: vectors
: 2drop ( x x -- ) drop drop ;
: 3drop ( x x x -- ) drop drop drop ;
: 2dup ( x y -- x y x y ) over over ;
: 3dup ( x y z -- x y z x y z ) pick pick pick ;
: 2swap ( x y z t -- z t x y ) rot >r rot r> ;
: -rot ( x y z -- z x y ) rot rot ;
: dupd ( x y -- x x y ) >r dup r> ;
: swapd ( x y z -- y x z ) >r swap r> ;
: transp ( x y z -- z y x ) swap rot ;
: clear ( -- )
#! Clear the datastack. For interactive use only; invoking
#! this from a word definition will clobber any values left
#! on the data stack by the caller.
0 <vector> set-datastack ;