new bootstrap system; some other code cleanups
Slava Pestov
parent
6c5819af56
commit
d3b4726790
|
|
@ -12,8 +12,6 @@
|
|||
- <array> ( length initial )
|
||||
- <string> ( length initial )
|
||||
- remove repetitions
|
||||
- load-indirect cannot use a scratch register since its vop is basic-blockish
|
||||
- benchmark/fib out of memory on powerpc
|
||||
- need something like uncons but for arbitrary sequences
|
||||
- on win64: to_cell will break
|
||||
- .h .b .o for ratios and floats is broken
|
||||
|
|
@ -87,38 +85,22 @@ parsing word sections:
|
|||
+ compiler:
|
||||
|
||||
- declare slot types for built-ins
|
||||
- check that set-datastack and set-callstack compile correctly in the
|
||||
face of optimization
|
||||
- [ ] [ throw ] ifte ==> should raise 'unbalanced branches' error
|
||||
- remove dead code after a 'throw'
|
||||
- flushing optimization
|
||||
- [ [ dup call ] dup call ] infer hangs
|
||||
- compile continuations
|
||||
|
||||
+ sequences:
|
||||
|
||||
- split: return vectors
|
||||
- set-path: iterative
|
||||
- slice: if sequence or seq start is changed, abstraction violation
|
||||
- mutable strings simplifying string operarations
|
||||
|
||||
+ kernel:
|
||||
|
||||
- first-class methods:
|
||||
- methods outliner
|
||||
- annotations for methods
|
||||
- originating source file for methods
|
||||
- reader syntax for byte arrays, displaced aliens
|
||||
- slice: if sequence or seq start is changed, abstraction violation
|
||||
- annotations for methods
|
||||
- originating source file for methods
|
||||
- out of memory error when printing global namespace
|
||||
- merge timers with sleeping tasks
|
||||
- delegating generic words with a non-standard picker
|
||||
- code gc
|
||||
|
||||
+ i/o:
|
||||
|
||||
- i/o tasks hanging around
|
||||
- faster stream-copy
|
||||
- reading and writing byte arrays
|
||||
- stream server can hang because of exception handler limitations
|
||||
- better i/o scheduler
|
||||
- if two tasks write to a unix stream, the buffer can overflow
|
||||
|
|
|
|||
|
|
@ -101,6 +101,16 @@ presentation sequences strings styles words ;
|
|||
drop call
|
||||
] if ;
|
||||
|
||||
TUPLE: wrapper-stream scope ;
|
||||
|
||||
C: wrapper-stream ( stream -- stream )
|
||||
2dup set-delegate [
|
||||
>r stdio associate r> set-wrapper-stream-scope
|
||||
] keep ;
|
||||
|
||||
: with-wrapper ( stream quot -- )
|
||||
>r wrapper-stream-scope r> bind ; inline
|
||||
|
||||
TUPLE: html-stream ;
|
||||
|
||||
M: html-stream stream-write1 ( char stream -- )
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ SYMBOL: c-types
|
|||
>r <c-type> [ swap bind ] keep r> c-types get set-hash ;
|
||||
inline
|
||||
|
||||
: bytes>cells cell / ceiling ;
|
||||
: bytes>cells cell get / ceiling ;
|
||||
|
||||
: <c-object> ( size -- c-ptr ) bytes>cells <byte-array> ;
|
||||
|
||||
|
|
@ -91,5 +91,3 @@ SYMBOL: c-types
|
|||
|
||||
: typedef ( old new -- )
|
||||
over "*" append over "*" append (typedef) (typedef) ;
|
||||
|
||||
global [ c-types nest drop ] bind
|
||||
|
|
|
|||
|
|
@ -67,7 +67,7 @@ C: alien-node make-node ;
|
|||
|
||||
: parameters alien-node-parameters reverse ;
|
||||
|
||||
: c-aligned c-size cell align ;
|
||||
: c-aligned c-size cell get align ;
|
||||
|
||||
: stack-space ( parameters -- n )
|
||||
0 [ c-aligned + ] reduce ;
|
||||
|
|
|
|||
|
|
@ -6,8 +6,8 @@ math namespaces ;
|
|||
[
|
||||
>r >r alien-address r> r> set-alien-unsigned-cell
|
||||
] "setter" set
|
||||
cell "width" set
|
||||
cell "align" set
|
||||
cell get "width" set
|
||||
cell get "align" set
|
||||
"box_alien" "boxer" set
|
||||
"unbox_alien" "unboxer" set
|
||||
] "void*" define-primitive-type
|
||||
|
|
@ -33,8 +33,8 @@ math namespaces ;
|
|||
[
|
||||
[ alien-signed-cell ] "getter" set
|
||||
[ set-alien-signed-cell ] "setter" set
|
||||
cell "width" set
|
||||
cell "align" set
|
||||
cell get "width" set
|
||||
cell get "align" set
|
||||
"box_signed_cell" "boxer" set
|
||||
"unbox_signed_cell" "unboxer" set
|
||||
] "long" define-primitive-type
|
||||
|
|
@ -42,8 +42,8 @@ math namespaces ;
|
|||
[
|
||||
[ alien-unsigned-cell ] "getter" set
|
||||
[ set-alien-unsigned-cell ] "setter" set
|
||||
cell "width" set
|
||||
cell "align" set
|
||||
cell get "width" set
|
||||
cell get "align" set
|
||||
"box_unsigned_cell" "boxer" set
|
||||
"unbox_unsigned_cell" "unboxer" set
|
||||
] "ulong" define-primitive-type
|
||||
|
|
@ -108,8 +108,8 @@ math namespaces ;
|
|||
>r >r string>alien alien-address r> r>
|
||||
set-alien-unsigned-cell
|
||||
] "setter" set
|
||||
cell "width" set
|
||||
cell "align" set
|
||||
cell get "width" set
|
||||
cell get "align" set
|
||||
"box_c_string" "boxer" set
|
||||
"unbox_c_string" "unboxer" set
|
||||
] "char*" define-primitive-type
|
||||
|
|
@ -117,8 +117,8 @@ math namespaces ;
|
|||
[
|
||||
[ alien-unsigned-4 ] "getter" set
|
||||
[ set-alien-unsigned-4 ] "setter" set
|
||||
cell "width" set
|
||||
cell "align" set
|
||||
cell get "width" set
|
||||
cell get "align" set
|
||||
"box_utf16_string" "boxer" set
|
||||
"unbox_utf16_string" "unboxer" set
|
||||
] "ushort*" define-primitive-type
|
||||
|
|
@ -126,8 +126,8 @@ math namespaces ;
|
|||
[
|
||||
[ alien-unsigned-4 0 = not ] "getter" set
|
||||
[ 1 0 ? set-alien-unsigned-4 ] "setter" set
|
||||
cell "width" set
|
||||
cell "align" set
|
||||
cell get "width" set
|
||||
cell get "align" set
|
||||
"box_boolean" "boxer" set
|
||||
"unbox_boolean" "unboxer" set
|
||||
] "bool" define-primitive-type
|
||||
|
|
@ -135,8 +135,8 @@ math namespaces ;
|
|||
[
|
||||
[ alien-float ] "getter" set
|
||||
[ set-alien-float ] "setter" set
|
||||
cell "width" set
|
||||
cell "align" set
|
||||
cell get "width" set
|
||||
cell get "align" set
|
||||
"box_float" "boxer" set
|
||||
"unbox_float" "unboxer" set
|
||||
T{ float-regs f 4 } "reg-class" set
|
||||
|
|
@ -145,8 +145,8 @@ math namespaces ;
|
|||
[
|
||||
[ alien-double ] "getter" set
|
||||
[ set-alien-double ] "setter" set
|
||||
cell 2 * "width" set
|
||||
cell 2 * "align" set
|
||||
cell get 2 * "width" set
|
||||
cell get 2 * "align" set
|
||||
"box_double" "boxer" set
|
||||
"unbox_double" "unboxer" set
|
||||
T{ float-regs f 8 } "reg-class" set
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ sequences strings words ;
|
|||
#! type is exactly like void*.
|
||||
[
|
||||
"width" set
|
||||
cell "align" set
|
||||
cell get "align" set
|
||||
[ swap <displaced-alien> ] "getter" set
|
||||
] "struct-name" get define-c-type
|
||||
"struct-name" get "in" get init-c-type ;
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2005 Alex Chapman.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: alien
|
||||
USING: compiler kernel lists math namespaces parser
|
||||
sequences words ;
|
||||
IN: !syntax
|
||||
USING: alien compiler kernel lists math namespaces parser
|
||||
sequences syntax words ;
|
||||
|
||||
! usage of 'LIBRARY:' and 'FUNCTION:' :
|
||||
!
|
||||
|
|
|
|||
|
|
@ -79,9 +79,6 @@ vectors words ;
|
|||
"/library/generic/slots.factor"
|
||||
"/library/generic/math-combination.factor"
|
||||
"/library/generic/tuple.factor"
|
||||
|
||||
"/library/syntax/generic.factor"
|
||||
"/library/syntax/parse-syntax.factor"
|
||||
|
||||
"/library/alien/aliens.factor"
|
||||
|
||||
|
|
@ -136,16 +133,111 @@ vectors words ;
|
|||
"/library/compiler/compiler.factor"
|
||||
|
||||
"/library/alien/c-types.factor"
|
||||
"/library/alien/primitive-types.factor"
|
||||
"/library/alien/structs.factor"
|
||||
"/library/alien/compiler.factor"
|
||||
"/library/alien/syntax.factor"
|
||||
"/library/alien/malloc.factor"
|
||||
|
||||
"/library/io/buffer.factor"
|
||||
|
||||
"/library/syntax/generic.factor"
|
||||
|
||||
"/library/cli.factor"
|
||||
|
||||
"/library/bootstrap/init.factor"
|
||||
|
||||
"/library/sdl/sdl.factor"
|
||||
"/library/sdl/sdl-video.factor"
|
||||
"/library/sdl/sdl-event.factor"
|
||||
"/library/sdl/sdl-keysym.factor"
|
||||
"/library/sdl/sdl-keyboard.factor"
|
||||
"/library/sdl/sdl-utils.factor"
|
||||
|
||||
"/library/opengl/gl.factor"
|
||||
"/library/opengl/glu.factor"
|
||||
"/library/opengl/opengl-utils.factor"
|
||||
|
||||
"/library/freetype/freetype.factor"
|
||||
"/library/freetype/freetype-gl.factor"
|
||||
|
||||
"/library/ui/gadgets.factor"
|
||||
"/library/ui/layouts.factor"
|
||||
"/library/ui/hierarchy.factor"
|
||||
"/library/ui/paint.factor"
|
||||
"/library/ui/gestures.factor"
|
||||
"/library/ui/theme.factor"
|
||||
"/library/ui/hand.factor"
|
||||
"/library/ui/frames.factor"
|
||||
"/library/ui/world.factor"
|
||||
"/library/ui/events.factor"
|
||||
"/library/ui/borders.factor"
|
||||
"/library/ui/labels.factor"
|
||||
"/library/ui/buttons.factor"
|
||||
"/library/ui/line-editor.factor"
|
||||
"/library/ui/sliders.factor"
|
||||
"/library/ui/scrolling.factor"
|
||||
"/library/ui/menus.factor"
|
||||
"/library/ui/editors.factor"
|
||||
"/library/ui/splitters.factor"
|
||||
"/library/ui/incremental.factor"
|
||||
"/library/ui/panes.factor"
|
||||
"/library/ui/books.factor"
|
||||
"/library/ui/outliner.factor"
|
||||
"/library/ui/presentations.factor"
|
||||
"/library/ui/listener.factor"
|
||||
"/library/ui/ui.factor"
|
||||
|
||||
"/library/help/database.factor"
|
||||
"/library/help/markup.factor"
|
||||
"/library/help/help.factor"
|
||||
"/library/help/tutorial.factor"
|
||||
"/library/help/syntax.factor"
|
||||
|
||||
"/library/syntax/parse-syntax.factor"
|
||||
} [ parse-resource % ] each
|
||||
|
||||
architecture get {
|
||||
{
|
||||
[ dup "x86" = ] [
|
||||
{
|
||||
"/library/compiler/x86/assembler.factor"
|
||||
"/library/compiler/amd64/assembler.factor"
|
||||
"/library/compiler/amd64/architecture.factor"
|
||||
"/library/compiler/x86/generator.factor"
|
||||
"/library/compiler/x86/slots.factor"
|
||||
"/library/compiler/x86/stack.factor"
|
||||
"/library/compiler/x86/fixnum.factor"
|
||||
"/library/compiler/amd64/alien.factor"
|
||||
}
|
||||
]
|
||||
} {
|
||||
[ dup "ppc" = ] [
|
||||
{
|
||||
"/library/compiler/ppc/assembler.factor"
|
||||
"/library/compiler/ppc/architecture.factor"
|
||||
"/library/compiler/ppc/generator.factor"
|
||||
"/library/compiler/ppc/slots.factor"
|
||||
"/library/compiler/ppc/stack.factor"
|
||||
"/library/compiler/ppc/fixnum.factor"
|
||||
"/library/compiler/ppc/alien.factor"
|
||||
}
|
||||
]
|
||||
} {
|
||||
[ dup "amd64" = ] [
|
||||
{
|
||||
"/library/compiler/x86/assembler.factor"
|
||||
"/library/compiler/amd64/assembler.factor"
|
||||
"/library/compiler/amd64/architecture.factor"
|
||||
"/library/compiler/x86/generator.factor"
|
||||
"/library/compiler/x86/slots.factor"
|
||||
"/library/compiler/x86/stack.factor"
|
||||
"/library/compiler/x86/fixnum.factor"
|
||||
"/library/compiler/amd64/alien.factor"
|
||||
}
|
||||
]
|
||||
}
|
||||
} cond [ parse-resource % ] each
|
||||
|
||||
[
|
||||
"/library/bootstrap/boot-stage2.factor" run-resource
|
||||
[ print-error die ] recover
|
||||
|
|
@ -160,3 +252,6 @@ vocabularies get [
|
|||
] bind
|
||||
|
||||
"!syntax" vocabularies get remove-hash
|
||||
|
||||
H{ } clone crossref set
|
||||
recrossref
|
||||
|
|
|
|||
|
|
@ -1,43 +1,10 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
USING: alien assembler compiler compiler-backend
|
||||
errors generic hashtables io io-internals kernel
|
||||
USING: compiler compiler-backend io io-internals kernel
|
||||
kernel-internals lists math memory namespaces optimizer parser
|
||||
sequences sequences-internals words ;
|
||||
|
||||
"Loading compiler backend..." print
|
||||
|
||||
cpu "x86" = [
|
||||
"/library/compiler/x86/load.factor" run-resource
|
||||
] when
|
||||
|
||||
cpu "ppc" = [
|
||||
"/library/compiler/ppc/load.factor" run-resource
|
||||
] when
|
||||
|
||||
cpu "amd64" = [
|
||||
"/library/compiler/amd64/load.factor" run-resource
|
||||
] when
|
||||
|
||||
"Loading more library code..." print
|
||||
|
||||
[
|
||||
"/library/alien/malloc.factor"
|
||||
"/library/io/buffer.factor"
|
||||
|
||||
"/library/sdl/load.factor"
|
||||
"/library/opengl/load.factor"
|
||||
"/library/freetype/load.factor"
|
||||
"/library/ui/load.factor"
|
||||
"/library/help/load.factor"
|
||||
] [
|
||||
run-resource
|
||||
] each
|
||||
|
||||
! Handle -libraries:... overrides
|
||||
parse-command-line
|
||||
|
||||
"compile" get supported-cpu? and [
|
||||
"compile" get [
|
||||
"native-io" get [
|
||||
unix? [
|
||||
"/library/unix/load.factor" run-resource
|
||||
|
|
@ -72,13 +39,10 @@ parse-command-line
|
|||
[
|
||||
boot
|
||||
run-user-init
|
||||
"shell" get [ "shells" ] search execute
|
||||
"shell" get "shells" lookup execute
|
||||
0 exit
|
||||
] set-boot
|
||||
|
||||
"Building cross-reference database..." print
|
||||
recrossref
|
||||
|
||||
[ compiled? ] word-subset length
|
||||
number>string write " compiled words" print
|
||||
|
||||
|
|
|
|||
|
|
@ -22,7 +22,9 @@ SYMBOL: objects
|
|||
|
||||
! Image output format
|
||||
SYMBOL: big-endian
|
||||
SYMBOL: 64-bits
|
||||
|
||||
! Bootstrap architecture name
|
||||
SYMBOL: architecture
|
||||
|
||||
: emit ( cell -- ) image get push ;
|
||||
|
||||
|
|
@ -30,7 +32,7 @@ SYMBOL: 64-bits
|
|||
dup HEX: ffffffff bitand swap -32 shift HEX: ffffffff bitand ;
|
||||
|
||||
: emit-64 ( cell -- )
|
||||
64-bits get [
|
||||
cell get 8 = [
|
||||
emit
|
||||
] [
|
||||
d>w/w big-endian get [ swap ] unless emit emit
|
||||
|
|
@ -45,8 +47,7 @@ SYMBOL: 64-bits
|
|||
: image-magic HEX: 0f0e0d0c ;
|
||||
: image-version 0 ;
|
||||
|
||||
: cell 64-bits get 8 4 ? ;
|
||||
: char 64-bits get 4 2 ? ;
|
||||
: char cell get 2 /i ;
|
||||
|
||||
: untag ( cell tag -- ) tag-mask bitnot bitand ;
|
||||
: tag ( cell -- tag ) tag-mask bitand ;
|
||||
|
|
@ -93,7 +94,7 @@ GENERIC: ' ( obj -- ptr )
|
|||
( Allocator )
|
||||
|
||||
: here ( -- size )
|
||||
image get length header-size - cell * base + ;
|
||||
image get length header-size - cells base + ;
|
||||
|
||||
: here-as ( tag -- pointer )
|
||||
here swap bitor ;
|
||||
|
|
@ -109,7 +110,7 @@ M: fixnum ' ( n -- tagged ) fixnum-tag immediate ;
|
|||
|
||||
( Bignums )
|
||||
|
||||
: bignum-bits cell 8 * 2 - ;
|
||||
: bignum-bits cell-bits 2 - ;
|
||||
|
||||
: bignum-radix bignum-bits 1 swap shift 1- ;
|
||||
|
||||
|
|
@ -163,7 +164,7 @@ M: f ' ( obj -- ptr )
|
|||
! The image begins with the header, then T,
|
||||
! and the bignums 0, 1, and -1.
|
||||
|
||||
: begin ( -- ) header t, 0, 1, -1, ;
|
||||
: begin-image ( -- ) header t, 0, 1, -1, ;
|
||||
|
||||
( Words )
|
||||
|
||||
|
|
@ -296,9 +297,9 @@ M: hashtable ' ( hashtable -- pointer )
|
|||
|
||||
: boot, ( quot -- ) ' boot-quot-offset fixup ;
|
||||
|
||||
: heap-size image get length header-size - cell * ;
|
||||
: heap-size image get length header-size - cells ;
|
||||
|
||||
: end ( quot -- )
|
||||
: end-image ( quot -- )
|
||||
"Generating words..." print
|
||||
words,
|
||||
"Generating global namespace..." print
|
||||
|
|
@ -307,12 +308,15 @@ M: hashtable ' ( hashtable -- pointer )
|
|||
boot,
|
||||
"Performing some word fixups..." print
|
||||
fixup-words
|
||||
heap-size heap-size-offset fixup ;
|
||||
heap-size heap-size-offset fixup
|
||||
"Image length: " write image get length .
|
||||
"Object cache size: " write objects get hash-size .
|
||||
\ word global remove-hash ;
|
||||
|
||||
( Image output )
|
||||
|
||||
: (write-image) ( image -- )
|
||||
64-bits get 8 4 ? swap big-endian get [
|
||||
cell swap big-endian get [
|
||||
[ swap >be write ] each-with
|
||||
] [
|
||||
[ swap >le write ] each-with
|
||||
|
|
@ -322,33 +326,27 @@ M: hashtable ' ( hashtable -- pointer )
|
|||
"Writing image to " write dup write "..." print
|
||||
<file-writer> [ (write-image) ] with-stream ;
|
||||
|
||||
: with-image ( quot -- image )
|
||||
: prepare-profile ( arch -- )
|
||||
"/library/bootstrap/profile-" swap ".factor" append3
|
||||
run-resource ;
|
||||
|
||||
: prepare-image ( arch -- )
|
||||
bootstrapping? on dup architecture set prepare-profile
|
||||
800000 <vector> image set 20000 <hashtable> objects set ;
|
||||
|
||||
: <image> ( architecture -- image )
|
||||
[
|
||||
bootstrapping? on
|
||||
800000 <vector> image set
|
||||
20000 <hashtable> objects set
|
||||
call
|
||||
"Image length: " write image get length .
|
||||
"Object cache size: " write objects get hash-size .
|
||||
prepare-image
|
||||
begin-image
|
||||
"/library/bootstrap/boot-stage1.factor" run-resource
|
||||
end-image
|
||||
image get
|
||||
\ word global remove-hash
|
||||
] with-scope ;
|
||||
|
||||
: make-image ( name -- )
|
||||
#! Make a bootstrap image.
|
||||
[
|
||||
begin
|
||||
"/library/bootstrap/boot-stage1.factor" run-resource
|
||||
end
|
||||
] with-image
|
||||
|
||||
swap write-image ;
|
||||
: make-image ( architecture -- )
|
||||
#! Make a bootstrap image for the given architecture
|
||||
#! (x86, ppc, or amd64).
|
||||
dup <image> "boot.image." rot append write-image ;
|
||||
|
||||
: make-images ( -- )
|
||||
64-bits off
|
||||
big-endian off "boot.image.le32" make-image
|
||||
big-endian on "boot.image.be32" make-image
|
||||
64-bits on
|
||||
big-endian off "boot.image.le64" make-image
|
||||
big-endian on "boot.image.be64" make-image
|
||||
64-bits off ;
|
||||
"x86" make-image "ppc" make-image "amd64" make-image ;
|
||||
|
|
|
|||
|
|
@ -11,7 +11,8 @@ parser threads words ;
|
|||
init-threads
|
||||
init-io
|
||||
"HOME" os-env [ "." ] unless* "~" set
|
||||
17 getenv cell set
|
||||
init-error-handler
|
||||
default-cli-args
|
||||
parse-command-line
|
||||
"null-stdio" get [ T{ null-stream } stdio set ] when ;
|
||||
"null-stdio" get [ stdio off ] when ;
|
||||
|
|
|
|||
|
|
@ -1,18 +1,21 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: image
|
||||
USING: arrays alien generic hashtables io kernel
|
||||
kernel-internals lists math namespaces sequences strings vectors
|
||||
words ;
|
||||
USING: alien arrays generic hashtables io kernel
|
||||
kernel-internals lists math namespaces parser sequences strings
|
||||
vectors words ;
|
||||
|
||||
! Some very tricky code creating a bootstrap embryo in the
|
||||
! host image.
|
||||
|
||||
"Creating primitives and basic runtime structures..." print
|
||||
|
||||
H{ } clone c-types set
|
||||
"/library/alien/primitive-types.factor" parse-resource
|
||||
|
||||
! These symbols need the same hashcode in the target as in the
|
||||
! host.
|
||||
{ vocabularies typemap builtins }
|
||||
{ vocabularies typemap builtins c-types cell }
|
||||
|
||||
! Bring up a bare cross-compiling vocabulary.
|
||||
"syntax" vocab
|
||||
|
|
@ -22,6 +25,9 @@ crossref off
|
|||
|
||||
vocabularies get [ "syntax" set [ reveal ] each ] bind
|
||||
|
||||
! Call the quotation parsed from primitive-types.factor
|
||||
call
|
||||
|
||||
: make-primitive ( { vocab word } n -- )
|
||||
>r first2 create r> f define ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
USING: image kernel-internals namespaces ;
|
||||
|
||||
! Do not load this file into a running image, ever.
|
||||
|
||||
8 cell set
|
||||
big-endian off
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
USING: image kernel-internals namespaces ;
|
||||
|
||||
! Do not load this file into a running image, ever.
|
||||
|
||||
4 cell set
|
||||
big-endian on
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
USING: image kernel-internals namespaces ;
|
||||
|
||||
! Do not load this file into a running image, ever.
|
||||
|
||||
4 cell set
|
||||
big-endian off
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
USING: io kernel parser sequences ;
|
||||
|
||||
[
|
||||
"/library/compiler/x86/assembler.factor"
|
||||
"/library/compiler/amd64/assembler.factor"
|
||||
"/library/compiler/amd64/architecture.factor"
|
||||
"/library/compiler/x86/generator.factor"
|
||||
"/library/compiler/x86/slots.factor"
|
||||
"/library/compiler/x86/stack.factor"
|
||||
"/library/compiler/x86/fixnum.factor"
|
||||
"/library/compiler/amd64/alien.factor"
|
||||
] [
|
||||
run-resource
|
||||
] each
|
||||
|
|
@ -18,7 +18,7 @@ math memory namespaces ;
|
|||
|
||||
: add-literal ( obj -- lit# )
|
||||
address literal-top [ set-compiled-cell ] keep
|
||||
dup cell + set-literal-top ;
|
||||
dup cell get + set-literal-top ;
|
||||
|
||||
: assemble-1 ( n -- )
|
||||
compiled-offset set-compiled-1
|
||||
|
|
@ -30,7 +30,7 @@ math memory namespaces ;
|
|||
|
||||
: assemble-cell ( n -- )
|
||||
compiled-offset set-compiled-cell
|
||||
compiled-offset cell + set-compiled-offset ; inline
|
||||
compiled-offset cell get + set-compiled-offset ; inline
|
||||
|
||||
: begin-assembly ( -- code-len-fixup reloc-len-fixup )
|
||||
compiled-header assemble-cell
|
||||
|
|
|
|||
|
|
@ -4,9 +4,6 @@ USING: compiler-backend compiler-frontend errors inference io
|
|||
kernel lists math namespaces optimizer prettyprint sequences
|
||||
words ;
|
||||
|
||||
: supported-cpu? ( -- ? )
|
||||
cpu "unknown" = not ;
|
||||
|
||||
: precompile ( quotation -- basic-blocks )
|
||||
dataflow optimize linearize split-blocks simplify ;
|
||||
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ GENERIC: generate-node ( vop -- )
|
|||
: generate-reloc ( -- length )
|
||||
relocation-table get
|
||||
dup [ assemble-cell ] each
|
||||
length cell * ;
|
||||
length cells ;
|
||||
|
||||
: (generate) ( word linear -- )
|
||||
#! Compile a word definition from linear IR.
|
||||
|
|
@ -68,4 +68,4 @@ M: %parameters generate-node ( vop -- ) drop ;
|
|||
|
||||
: shift-add ( by -- n )
|
||||
#! Used in fixnum-shift overflow check.
|
||||
1 swap cell 8 * swap 1- - shift ;
|
||||
1 swap cell-bits * swap 1- - shift ;
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ namespaces sequences words ;
|
|||
: slot@ ( node -- n/f )
|
||||
#! Compute slot offset.
|
||||
dup node-in-d reverse-slice dup first dup literal? [
|
||||
literal-value cell * swap second
|
||||
literal-value cells swap second
|
||||
rot value-tag dup [ - ] [ 2drop f ] if
|
||||
] [
|
||||
3drop f
|
||||
|
|
@ -223,7 +223,7 @@ namespaces sequences words ;
|
|||
: negative-shift ( n -- )
|
||||
-1 %inc-d ,
|
||||
in-1
|
||||
dup cell -8 * <= [
|
||||
dup cell-bits neg * <= [
|
||||
drop 0 <vreg> 2 <vreg> %fixnum-sgn ,
|
||||
T{ vreg f 2 } 0 %replace-d ,
|
||||
] [
|
||||
|
|
@ -232,7 +232,7 @@ namespaces sequences words ;
|
|||
] if ;
|
||||
|
||||
: positive-shift ( n -- )
|
||||
dup cell 8 * tag-bits - <= [
|
||||
dup cell-bits * tag-bits - <= [
|
||||
-1 %inc-d ,
|
||||
in-1
|
||||
0 <vreg> 0 <vreg> %fixnum<< ,
|
||||
|
|
|
|||
|
|
@ -142,7 +142,7 @@ M: %fixnum>> generate-node ( vop -- )
|
|||
0 output-operand dup untag ;
|
||||
|
||||
M: %fixnum-sgn generate-node ( vop -- )
|
||||
drop dest/src cell 8 * 1- SRAWI 0 output-operand dup untag ;
|
||||
drop dest/src cell-bits 1- SRAWI 0 output-operand dup untag ;
|
||||
|
||||
: fixnum-jump ( -- label )
|
||||
1 input-operand 0 0 input-operand CMP label ;
|
||||
|
|
|
|||
|
|
@ -1,13 +0,0 @@
|
|||
USING: io kernel parser sequences ;
|
||||
|
||||
[
|
||||
"/library/compiler/ppc/assembler.factor"
|
||||
"/library/compiler/ppc/architecture.factor"
|
||||
"/library/compiler/ppc/generator.factor"
|
||||
"/library/compiler/ppc/slots.factor"
|
||||
"/library/compiler/ppc/stack.factor"
|
||||
"/library/compiler/ppc/fixnum.factor"
|
||||
"/library/compiler/ppc/alien.factor"
|
||||
] [
|
||||
run-resource
|
||||
] each
|
||||
|
|
@ -14,7 +14,7 @@ kernel-internals lists math memory namespaces sequences words ;
|
|||
0 output-operand dup r> call ; inline
|
||||
|
||||
M: %slot generate-node ( vop -- )
|
||||
drop cell log2 [ 0 LWZ ] generate-slot ;
|
||||
drop cell get log2 [ 0 LWZ ] generate-slot ;
|
||||
|
||||
M: %fast-slot generate-node ( vop -- )
|
||||
drop 0 output-operand dup 0 input LWZ ;
|
||||
|
|
@ -29,7 +29,7 @@ M: %fast-slot generate-node ( vop -- )
|
|||
0 input-operand 2 input-operand r> call ; inline
|
||||
|
||||
M: %set-slot generate-node ( vop -- )
|
||||
drop cell log2 [ 0 STW ] generate-set-slot ;
|
||||
drop cell get log2 [ 0 STW ] generate-set-slot ;
|
||||
|
||||
M: %fast-set-slot generate-node ( vop -- )
|
||||
drop 0 input-operand 1 input-operand 2 input STW ;
|
||||
|
|
@ -43,7 +43,7 @@ M: %write-barrier generate-node ( vop -- )
|
|||
0 scratch dup card-mark ORI
|
||||
0 scratch 0 input-operand 0 STB ;
|
||||
|
||||
: string-offset cell 3 * object-tag - ;
|
||||
: string-offset 3 cells object-tag - ;
|
||||
|
||||
M: %char-slot generate-node ( vop -- )
|
||||
drop 1 [ string-offset LHZ ] generate-slot
|
||||
|
|
@ -59,8 +59,8 @@ M: %set-char-slot generate-node ( vop -- )
|
|||
"userenv" f dlsym swap LOAD32 0 rel-2/2 rel-userenv ;
|
||||
|
||||
M: %getenv generate-node ( vop -- )
|
||||
drop 0 output-operand dup dup userenv 0 input cell * LWZ ;
|
||||
drop 0 output-operand dup dup userenv 0 input cells LWZ ;
|
||||
|
||||
M: %setenv generate-node ( vop -- )
|
||||
drop 0 scratch userenv
|
||||
0 input-operand 0 scratch 1 input cell * STW ;
|
||||
0 input-operand 0 scratch 1 input cells STW ;
|
||||
|
|
|
|||
|
|
@ -2,12 +2,12 @@
|
|||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: compiler-backend
|
||||
USING: assembler compiler errors kernel kernel-internals math
|
||||
memory words ;
|
||||
memory namespaces words ;
|
||||
|
||||
GENERIC: loc>operand
|
||||
|
||||
M: ds-loc loc>operand ds-loc-n cell * neg 14 swap ;
|
||||
M: cs-loc loc>operand cs-loc-n cell * neg 15 swap ;
|
||||
M: ds-loc loc>operand ds-loc-n cells neg 14 swap ;
|
||||
M: cs-loc loc>operand cs-loc-n cells neg 15 swap ;
|
||||
|
||||
M: %immediate generate-node ( vop -- )
|
||||
drop 0 input address 0 output-operand LOAD ;
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ M: %parameter generate-node
|
|||
GENERIC: reg-size ( reg-class -- n )
|
||||
GENERIC: push-reg ( reg-class -- )
|
||||
|
||||
M: int-regs reg-size drop cell ;
|
||||
M: int-regs reg-size drop cell get ;
|
||||
M: int-regs push-reg drop EAX PUSH ;
|
||||
|
||||
M: float-regs reg-size float-regs-size ;
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ GENERIC: operand-64? ( op -- ? )
|
|||
|
||||
M: object canonicalize ;
|
||||
M: object extended? drop f ;
|
||||
M: object operand-64? drop cell 8 = ;
|
||||
M: object operand-64? drop cell get 8 = ;
|
||||
|
||||
( Register operands -- eg, ECX )
|
||||
: REGISTER:
|
||||
|
|
|
|||
|
|
@ -1,13 +0,0 @@
|
|||
USING: io kernel parser sequences ;
|
||||
|
||||
[
|
||||
"/library/compiler/x86/assembler.factor"
|
||||
"/library/compiler/x86/architecture.factor"
|
||||
"/library/compiler/x86/generator.factor"
|
||||
"/library/compiler/x86/slots.factor"
|
||||
"/library/compiler/x86/stack.factor"
|
||||
"/library/compiler/x86/fixnum.factor"
|
||||
"/library/compiler/x86/alien.factor"
|
||||
] [
|
||||
run-resource
|
||||
] each
|
||||
|
|
@ -42,7 +42,7 @@ M: %set-slot generate-node ( vop -- )
|
|||
M: %fast-set-slot generate-node ( vop -- )
|
||||
drop 1 input-operand 2 input 2array 0 input-operand MOV ;
|
||||
|
||||
: userenv@ ( n -- addr ) cell * "userenv" f dlsym + ;
|
||||
: userenv@ ( n -- addr ) cells "userenv" f dlsym + ;
|
||||
|
||||
M: %getenv generate-node ( vop -- )
|
||||
drop
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ IN: compiler-backend
|
|||
USING: alien arrays assembler compiler inference kernel
|
||||
kernel-internals lists math memory sequences words ;
|
||||
|
||||
: reg-stack ( n reg -- op ) swap cell * neg 2array ;
|
||||
: reg-stack ( n reg -- op ) swap cells neg 2array ;
|
||||
|
||||
M: ds-loc v>operand ds-loc-n ds-reg reg-stack ;
|
||||
|
||||
|
|
@ -16,7 +16,7 @@ M: %peek generate-node ( vop -- )
|
|||
M: %replace generate-node ( vop -- )
|
||||
drop 0 output-operand 0 input-operand MOV ;
|
||||
|
||||
: (%inc) 0 input cell * dup 0 > [ ADD ] [ neg SUB ] if ;
|
||||
: (%inc) 0 input cells dup 0 > [ ADD ] [ neg SUB ] if ;
|
||||
|
||||
M: %inc-d generate-node ( vop -- ) drop ds-reg (%inc) ;
|
||||
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ SYMBOL: relocation-table
|
|||
|
||||
: rel, ( n -- ) relocation-table get push ;
|
||||
|
||||
: cell-just-compiled compiled-offset cell - ;
|
||||
: cell-just-compiled compiled-offset cell get - ;
|
||||
|
||||
: 4-just-compiled compiled-offset 4 - ;
|
||||
|
||||
|
|
@ -47,10 +47,11 @@ SYMBOL: relocation-table
|
|||
#! Write a relocation instruction for the runtime image
|
||||
#! loader.
|
||||
over >r >r >r 16 shift r> 8 shift bitor r> bitor rel,
|
||||
compiled-offset r> rel-absolute-cell = cell 4 ? - rel, ;
|
||||
compiled-offset r> rel-absolute-cell = cell get 4 ? - rel, ;
|
||||
|
||||
: rel-dlsym ( name dll class -- )
|
||||
>r cons add-literal compiled-base - cell / r> 1 rel-type, ;
|
||||
>r cons add-literal compiled-base - cell get / r>
|
||||
1 rel-type, ;
|
||||
|
||||
: rel-address ( class -- )
|
||||
#! Relocate address just compiled.
|
||||
|
|
|
|||
|
|
@ -10,31 +10,17 @@ USING: kernel kernel-internals ;
|
|||
IN: kernel
|
||||
USING: namespaces sequences ;
|
||||
|
||||
TUPLE: continuation data c call name catch ;
|
||||
|
||||
: c-stack ( -- c-stack )
|
||||
#! In the interpreter, this is a no-op. The compiler has an
|
||||
#! an intrinsic for this word.
|
||||
f ;
|
||||
|
||||
: set-c-stack ( c-stack -- )
|
||||
[ "not supported" throw ] when ;
|
||||
|
||||
: interpret ( quot -- )
|
||||
#! Call the quotation in the interpreter. When compiled,
|
||||
#! the quotation is ignored.
|
||||
call ;
|
||||
TUPLE: continuation data call name catch ;
|
||||
|
||||
: continuation ( -- interp )
|
||||
#! The continuation is reified from after the *caller* of
|
||||
#! this word returns. It must be declared inline for this
|
||||
#! invariant to be preserved in compiled code too.
|
||||
datastack c-stack callstack [ dup pop* dup pop* ] interpret
|
||||
datastack callstack dup pop* dup pop*
|
||||
namestack catchstack <continuation> ; inline
|
||||
|
||||
: >continuation< ( continuation -- data c call name catch )
|
||||
: >continuation< ( continuation -- data call name catch )
|
||||
[ continuation-data ] keep
|
||||
[ continuation-c ] keep
|
||||
[ continuation-call ] keep
|
||||
[ continuation-name ] keep
|
||||
continuation-catch ; inline
|
||||
|
|
@ -54,8 +40,9 @@ TUPLE: continuation data c call name catch ;
|
|||
|
||||
: continue ( continuation -- )
|
||||
#! Restore a continuation.
|
||||
>continuation< set-catchstack set-namestack set-callstack
|
||||
>r set-datastack r> set-c-stack ; inline
|
||||
>continuation<
|
||||
set-catchstack set-namestack set-callstack set-datastack ;
|
||||
inline
|
||||
|
||||
: (continue-with) 9 getenv ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,10 +1,16 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
USING: alien ;
|
||||
USING: alien kernel ;
|
||||
IN: freetype
|
||||
|
||||
! Some code to render TrueType fonts with OpenGL.
|
||||
|
||||
"freetype" {
|
||||
{ [ os "macosx" = ] [ "libfreetype.dylib" ] }
|
||||
{ [ os "win32" = ] [ "freetype6.dll" ] }
|
||||
{ [ t ] [ "libfreetype.so.6" ] }
|
||||
} cond "cdecl" add-library
|
||||
|
||||
LIBRARY: freetype
|
||||
|
||||
TYPEDEF: uchar FT_Byte
|
||||
|
|
|
|||
|
|
@ -1,14 +0,0 @@
|
|||
USING: alien io kernel parser sequences ;
|
||||
|
||||
"freetype" {
|
||||
{ [ os "macosx" = ] [ "libfreetype.dylib" ] }
|
||||
{ [ os "win32" = ] [ "freetype6.dll" ] }
|
||||
{ [ t ] [ "libfreetype.so.6" ] }
|
||||
} cond "cdecl" add-library
|
||||
|
||||
[
|
||||
"/library/freetype/freetype.factor"
|
||||
"/library/freetype/freetype-gl.factor"
|
||||
] [
|
||||
run-resource
|
||||
] each
|
||||
|
|
@ -10,15 +10,6 @@ namespaces parser sequences words ;
|
|||
|
||||
: glossary ( name -- ) <term> help ;
|
||||
|
||||
: HELP:
|
||||
scan-word [ >array "help" set-word-prop ] [ ] ; parsing
|
||||
|
||||
: ARTICLE:
|
||||
[ >array [ first2 2 ] keep tail add-article ] [ ] ; parsing
|
||||
|
||||
: GLOSSARY:
|
||||
[ >array [ first 1 ] keep tail add-term ] [ ] ; parsing
|
||||
|
||||
[ word? ] "Show word documentation" [ help ] define-command
|
||||
[ term? ] "Show term definition" [ help ] define-command
|
||||
[ link? ] "Show article" [ help ] define-command
|
||||
|
|
|
|||
|
|
@ -1,10 +0,0 @@
|
|||
USING: io kernel parser sequences ;
|
||||
|
||||
[
|
||||
"/library/help/database.factor"
|
||||
"/library/help/markup.factor"
|
||||
"/library/help/help.factor"
|
||||
"/library/help/tutorial.factor"
|
||||
] [
|
||||
run-resource
|
||||
] each
|
||||
|
|
@ -508,18 +508,4 @@ sequences strings vectors words prettyprint ;
|
|||
\ array>vector [ [ array ] [ vector ] ] "infer-effect" set-word-prop
|
||||
\ array>vector t "flushable" set-word-prop
|
||||
|
||||
\ datastack [ [ ] [ vector ] ] "infer-effect" set-word-prop
|
||||
\ set-datastack [ [ vector ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ callstack [ [ ] [ vector ] ] "infer-effect" set-word-prop
|
||||
\ set-callstack [ [ vector ] [ ] ] "infer-effect" set-word-prop
|
||||
|
||||
\ c-stack [
|
||||
"c-stack cannot be compiled (yet)" throw
|
||||
] "infer" set-word-prop
|
||||
|
||||
\ set-c-stack [
|
||||
"set-c-stack cannot be compiled (yet)" throw
|
||||
] "infer" set-word-prop
|
||||
|
||||
\ flush-icache [ [ ] [ ] ] "infer-effect" set-word-prop
|
||||
|
|
|
|||
|
|
@ -15,9 +15,6 @@ styles ;
|
|||
: terpri ( -- ) stdio get stream-terpri ;
|
||||
: close ( -- ) stdio get stream-close ;
|
||||
|
||||
: write-object ( string object -- )
|
||||
presented associate format ;
|
||||
|
||||
: write-outliner ( string object quot -- )
|
||||
[ outline set presented set ] make-hash format terpri ;
|
||||
|
||||
|
|
|
|||
|
|
@ -34,24 +34,11 @@ GENERIC: set-timeout ( timeout stream -- )
|
|||
[ 2dup (stream-copy) ] [ stream-close stream-close ] cleanup ;
|
||||
|
||||
! Think '/dev/null'.
|
||||
TUPLE: null-stream ;
|
||||
M: null-stream stream-flush drop ;
|
||||
M: null-stream stream-finish drop ;
|
||||
M: null-stream stream-readln drop f ;
|
||||
M: null-stream stream-read 2drop f ;
|
||||
M: null-stream stream-read1 drop f ;
|
||||
M: null-stream stream-write1 2drop ;
|
||||
M: null-stream stream-format 3drop ;
|
||||
M: null-stream stream-close drop ;
|
||||
|
||||
! Sometimes, we want to have a delegating stream that uses stdio
|
||||
! words.
|
||||
TUPLE: wrapper-stream scope ;
|
||||
|
||||
C: wrapper-stream ( stream -- stream )
|
||||
2dup set-delegate [
|
||||
>r stdio associate r> set-wrapper-stream-scope
|
||||
] keep ;
|
||||
|
||||
: with-wrapper ( stream quot -- )
|
||||
>r wrapper-stream-scope r> bind ; inline
|
||||
M: f stream-flush drop ;
|
||||
M: f stream-finish drop ;
|
||||
M: f stream-readln drop f ;
|
||||
M: f stream-read 2drop f ;
|
||||
M: f stream-read1 drop f ;
|
||||
M: f stream-write1 2drop ;
|
||||
M: f stream-format 3drop ;
|
||||
M: f stream-close drop ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,11 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: kernel-internals
|
||||
USING: namespaces math ;
|
||||
|
||||
: cells cell get * ; inline
|
||||
: cell-bits 8 cells ; inline
|
||||
|
||||
IN: math
|
||||
|
||||
: i C{ 0 1 } ; inline
|
||||
|
|
@ -9,3 +15,6 @@ IN: math
|
|||
: e 2.7182818284590452354 ; inline
|
||||
: pi 3.14159265358979323846 ; inline
|
||||
: epsilon 2.2204460492503131e-16 ; inline
|
||||
: first-bignum 1 cell-bits tag-bits - 1- shift ; inline
|
||||
: most-positive-fixnum first-bignum 1- >fixnum ; inline
|
||||
: most-negative-fixnum first-bignum neg >fixnum ; inline
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: math
|
||||
USING: errors generic kernel kernel-internals math sequences
|
||||
USING: errors generic kernel kernel-internals sequences
|
||||
sequences-internals ;
|
||||
|
||||
UNION: integer fixnum bignum ;
|
||||
|
|
@ -32,15 +32,6 @@ UNION: integer fixnum bignum ;
|
|||
: next-power-of-2 ( n -- n )
|
||||
1 swap (next-power-of-2) ;
|
||||
|
||||
: first-bignum ( -- n )
|
||||
1 cell 8 * tag-bits - 1- shift ; inline
|
||||
|
||||
: most-positive-fixnum ( -- n )
|
||||
first-bignum 1- >fixnum ; inline
|
||||
|
||||
: most-negative-fixnum ( -- n )
|
||||
first-bignum neg >fixnum ; inline
|
||||
|
||||
IN: math-internals
|
||||
|
||||
: fraction> ( a b -- a/b )
|
||||
|
|
|
|||
|
|
@ -4,7 +4,19 @@
|
|||
! This file is based on the gl.h that comes with xorg-x11 6.8.2
|
||||
|
||||
IN: opengl
|
||||
USING: alien ;
|
||||
USING: alien kernel ;
|
||||
|
||||
{
|
||||
{ [ os "macosx" = ] [ ] }
|
||||
{ [ os "win32" = ] [
|
||||
"gl" "opengl32.dll" "stdcall" add-library
|
||||
"glu" "glu32.dll" "stdcall" add-library
|
||||
] }
|
||||
{ [ t ] [
|
||||
"gl" "libGL.so.1" "cdecl" add-library
|
||||
"glu" "libGLU.so.1" "cdecl" add-library
|
||||
] }
|
||||
} cond
|
||||
|
||||
TYPEDEF: uint GLenum
|
||||
TYPEDEF: uchar GLboolean
|
||||
|
|
|
|||
|
|
@ -1,21 +0,0 @@
|
|||
USING: alien io kernel parser sequences ;
|
||||
|
||||
{
|
||||
{ [ os "macosx" = ] [ ] }
|
||||
{ [ os "win32" = ] [
|
||||
"gl" "opengl32.dll" "stdcall" add-library
|
||||
"glu" "glu32.dll" "stdcall" add-library
|
||||
] }
|
||||
{ [ t ] [
|
||||
"gl" "libGL.so.1" "cdecl" add-library
|
||||
"glu" "libGLU.so.1" "cdecl" add-library
|
||||
] }
|
||||
} cond
|
||||
|
||||
[
|
||||
"/library/opengl/gl.factor"
|
||||
"/library/opengl/glu.factor"
|
||||
"/library/opengl/opengl-utils.factor"
|
||||
] [
|
||||
run-resource
|
||||
] each
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
USING: alien io kernel parser sequences ;
|
||||
|
||||
{
|
||||
{ [ os "macosx" = ] [ ] }
|
||||
{ [ os "win32" = ] [ "sdl" "sdl.dll" "cdecl" add-library ] }
|
||||
{ [ t ] [ "sdl" "libSDL.so" "cdecl" add-library ] }
|
||||
} cond
|
||||
|
||||
[
|
||||
"/library/sdl/sdl.factor"
|
||||
"/library/sdl/sdl-video.factor"
|
||||
"/library/sdl/sdl-event.factor"
|
||||
"/library/sdl/sdl-keysym.factor"
|
||||
"/library/sdl/sdl-keyboard.factor"
|
||||
"/library/sdl/sdl-utils.factor"
|
||||
] [
|
||||
run-resource
|
||||
] each
|
||||
|
|
@ -1,6 +1,13 @@
|
|||
! Copyright (C) 2004, 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
IN: sdl USING: alien ;
|
||||
IN: sdl
|
||||
USING: alien kernel ;
|
||||
|
||||
{
|
||||
{ [ os "macosx" = ] [ ] }
|
||||
{ [ os "win32" = ] [ "sdl" "sdl.dll" "cdecl" add-library ] }
|
||||
{ [ t ] [ "sdl" "libSDL.so" "cdecl" add-library ] }
|
||||
} cond
|
||||
|
||||
: SDL_INIT_TIMER HEX: 00000001 ;
|
||||
: SDL_INIT_AUDIO HEX: 00000010 ;
|
||||
|
|
|
|||
|
|
@ -30,12 +30,10 @@ SYMBOL: meta-executing
|
|||
meta-cf get [ meta-cf [ uncons ] change ] [ up next ] if ;
|
||||
|
||||
: meta-interp ( -- interp )
|
||||
meta-d get f meta-r get meta-n get meta-c get
|
||||
<continuation> ;
|
||||
meta-d get meta-r get meta-n get meta-c get <continuation> ;
|
||||
|
||||
: set-meta-interp ( interp -- )
|
||||
>continuation<
|
||||
meta-c set meta-n set meta-r set drop meta-d set ;
|
||||
>continuation< meta-c set meta-n set meta-r set meta-d set ;
|
||||
|
||||
: host-word ( word -- )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -1,31 +0,0 @@
|
|||
USING: kernel parser sequences io ;
|
||||
[
|
||||
"/library/ui/gadgets.factor"
|
||||
"/library/ui/layouts.factor"
|
||||
"/library/ui/hierarchy.factor"
|
||||
"/library/ui/paint.factor"
|
||||
"/library/ui/gestures.factor"
|
||||
"/library/ui/theme.factor"
|
||||
"/library/ui/hand.factor"
|
||||
"/library/ui/frames.factor"
|
||||
"/library/ui/world.factor"
|
||||
"/library/ui/events.factor"
|
||||
"/library/ui/borders.factor"
|
||||
"/library/ui/labels.factor"
|
||||
"/library/ui/buttons.factor"
|
||||
"/library/ui/line-editor.factor"
|
||||
"/library/ui/sliders.factor"
|
||||
"/library/ui/scrolling.factor"
|
||||
"/library/ui/menus.factor"
|
||||
"/library/ui/editors.factor"
|
||||
"/library/ui/splitters.factor"
|
||||
"/library/ui/incremental.factor"
|
||||
"/library/ui/panes.factor"
|
||||
"/library/ui/books.factor"
|
||||
"/library/ui/outliner.factor"
|
||||
"/library/ui/presentations.factor"
|
||||
"/library/ui/listener.factor"
|
||||
"/library/ui/ui.factor"
|
||||
] [
|
||||
run-resource
|
||||
] each
|
||||
|
|
@ -41,8 +41,7 @@ SYMBOL: vocabularies
|
|||
|
||||
: recrossref ( -- )
|
||||
#! Update word cross referencing information.
|
||||
H{ } clone crossref global set-hash
|
||||
[ add-crossref ] each-word ;
|
||||
crossref get clear-hash [ add-crossref ] each-word ;
|
||||
|
||||
: lookup ( name vocab -- word ) vocab ?hash ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue