diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 8b03dcee74..9e68303c09 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -12,8 +12,6 @@ - ( length initial ) - ( 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 diff --git a/contrib/httpd/html.factor b/contrib/httpd/html.factor index 4bc1c29b86..294bbc73b2 100644 --- a/contrib/httpd/html.factor +++ b/contrib/httpd/html.factor @@ -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 -- ) diff --git a/library/alien/c-types.factor b/library/alien/c-types.factor index 58ee471264..4b7f21c47e 100644 --- a/library/alien/c-types.factor +++ b/library/alien/c-types.factor @@ -31,7 +31,7 @@ SYMBOL: c-types >r [ swap bind ] keep r> c-types get set-hash ; inline -: bytes>cells cell / ceiling ; +: bytes>cells cell get / ceiling ; : ( size -- c-ptr ) bytes>cells ; @@ -91,5 +91,3 @@ SYMBOL: c-types : typedef ( old new -- ) over "*" append over "*" append (typedef) (typedef) ; - -global [ c-types nest drop ] bind diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index 2f7896e870..f8f0996c88 100644 --- a/library/alien/compiler.factor +++ b/library/alien/compiler.factor @@ -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 ; diff --git a/library/alien/primitive-types.factor b/library/alien/primitive-types.factor index c9cf7424a8..442afb9163 100644 --- a/library/alien/primitive-types.factor +++ b/library/alien/primitive-types.factor @@ -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 diff --git a/library/alien/structs.factor b/library/alien/structs.factor index d17f92ea39..fe623fb557 100644 --- a/library/alien/structs.factor +++ b/library/alien/structs.factor @@ -35,7 +35,7 @@ sequences strings words ; #! type is exactly like void*. [ "width" set - cell "align" set + cell get "align" set [ swap ] "getter" set ] "struct-name" get define-c-type "struct-name" get "in" get init-c-type ; diff --git a/library/alien/syntax.factor b/library/alien/syntax.factor index 2b4541e133..976665a4ec 100644 --- a/library/alien/syntax.factor +++ b/library/alien/syntax.factor @@ -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:' : ! diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 99a6b3d4cd..51324e904a 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -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 diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index 64143fbbe9..fd18c9ffe8 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -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 diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 5cc8aff2bf..711b46fa55 100644 --- a/library/bootstrap/image.factor +++ b/library/bootstrap/image.factor @@ -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 [ (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 image set 20000 objects set ; + +: ( architecture -- image ) [ - bootstrapping? on - 800000 image set - 20000 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 "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 ; diff --git a/library/bootstrap/init.factor b/library/bootstrap/init.factor index ce5eaf2cf9..0944e28b14 100644 --- a/library/bootstrap/init.factor +++ b/library/bootstrap/init.factor @@ -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 ; diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index bdebbb7f07..c9519e4a70 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -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 ; diff --git a/library/bootstrap/profile-amd64.factor b/library/bootstrap/profile-amd64.factor new file mode 100644 index 0000000000..c324d95442 --- /dev/null +++ b/library/bootstrap/profile-amd64.factor @@ -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 diff --git a/library/bootstrap/profile-ppc.factor b/library/bootstrap/profile-ppc.factor new file mode 100644 index 0000000000..6e6c389c75 --- /dev/null +++ b/library/bootstrap/profile-ppc.factor @@ -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 diff --git a/library/bootstrap/profile-x86.factor b/library/bootstrap/profile-x86.factor new file mode 100644 index 0000000000..6a72029cce --- /dev/null +++ b/library/bootstrap/profile-x86.factor @@ -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 diff --git a/library/compiler/amd64/load.factor b/library/compiler/amd64/load.factor deleted file mode 100644 index f605fb2bb0..0000000000 --- a/library/compiler/amd64/load.factor +++ /dev/null @@ -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 diff --git a/library/compiler/assembler.factor b/library/compiler/assembler.factor index fcd6a91cb5..5d41fe1273 100644 --- a/library/compiler/assembler.factor +++ b/library/compiler/assembler.factor @@ -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 diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor index 825a256bd1..88ed191c4a 100644 --- a/library/compiler/compiler.factor +++ b/library/compiler/compiler.factor @@ -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 ; diff --git a/library/compiler/generator.factor b/library/compiler/generator.factor index fa8f6bac78..5f270be4a7 100644 --- a/library/compiler/generator.factor +++ b/library/compiler/generator.factor @@ -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 ; diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor index 6844c6505b..3f4c2df6ee 100644 --- a/library/compiler/intrinsics.factor +++ b/library/compiler/intrinsics.factor @@ -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 2 %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 0 %fixnum<< , diff --git a/library/compiler/ppc/fixnum.factor b/library/compiler/ppc/fixnum.factor index 3f1b5cd41f..dcf840bb5c 100644 --- a/library/compiler/ppc/fixnum.factor +++ b/library/compiler/ppc/fixnum.factor @@ -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 ; diff --git a/library/compiler/ppc/load.factor b/library/compiler/ppc/load.factor deleted file mode 100644 index 07e213ce37..0000000000 --- a/library/compiler/ppc/load.factor +++ /dev/null @@ -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 diff --git a/library/compiler/ppc/slots.factor b/library/compiler/ppc/slots.factor index 1fb08f27ed..4a26ba50a3 100644 --- a/library/compiler/ppc/slots.factor +++ b/library/compiler/ppc/slots.factor @@ -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 ; diff --git a/library/compiler/ppc/stack.factor b/library/compiler/ppc/stack.factor index 5768ef7e4c..e069f7685b 100644 --- a/library/compiler/ppc/stack.factor +++ b/library/compiler/ppc/stack.factor @@ -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 ; diff --git a/library/compiler/x86/alien.factor b/library/compiler/x86/alien.factor index 7947b75ccc..f5c5372ea6 100644 --- a/library/compiler/x86/alien.factor +++ b/library/compiler/x86/alien.factor @@ -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 ; diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor index bf1aa6ce29..1734b6e63f 100644 --- a/library/compiler/x86/assembler.factor +++ b/library/compiler/x86/assembler.factor @@ -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: diff --git a/library/compiler/x86/load.factor b/library/compiler/x86/load.factor deleted file mode 100644 index c4ed7b583f..0000000000 --- a/library/compiler/x86/load.factor +++ /dev/null @@ -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 diff --git a/library/compiler/x86/slots.factor b/library/compiler/x86/slots.factor index 8579c8388f..bb7b771c89 100644 --- a/library/compiler/x86/slots.factor +++ b/library/compiler/x86/slots.factor @@ -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 diff --git a/library/compiler/x86/stack.factor b/library/compiler/x86/stack.factor index fa37e21935..c1578990af 100644 --- a/library/compiler/x86/stack.factor +++ b/library/compiler/x86/stack.factor @@ -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) ; diff --git a/library/compiler/xt.factor b/library/compiler/xt.factor index 66991f8958..10b38f7446 100644 --- a/library/compiler/xt.factor +++ b/library/compiler/xt.factor @@ -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. diff --git a/library/continuations.factor b/library/continuations.factor index 2d22e07de3..3debb642e4 100644 --- a/library/continuations.factor +++ b/library/continuations.factor @@ -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 ; 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 ; diff --git a/library/freetype/freetype.factor b/library/freetype/freetype.factor index 779bb231d6..cf3b1b8275 100644 --- a/library/freetype/freetype.factor +++ b/library/freetype/freetype.factor @@ -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 diff --git a/library/freetype/load.factor b/library/freetype/load.factor deleted file mode 100644 index 1241967cfb..0000000000 --- a/library/freetype/load.factor +++ /dev/null @@ -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 diff --git a/library/help/help.factor b/library/help/help.factor index a7c04425a1..69f2e7209c 100644 --- a/library/help/help.factor +++ b/library/help/help.factor @@ -10,15 +10,6 @@ namespaces parser sequences words ; : glossary ( name -- ) 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 diff --git a/library/help/load.factor b/library/help/load.factor deleted file mode 100644 index 24ba3d590a..0000000000 --- a/library/help/load.factor +++ /dev/null @@ -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 diff --git a/library/inference/known-words.factor b/library/inference/known-words.factor index 26d82b3c59..92cd01f095 100644 --- a/library/inference/known-words.factor +++ b/library/inference/known-words.factor @@ -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 diff --git a/library/io/stdio.factor b/library/io/stdio.factor index 1031156430..c90d0928be 100644 --- a/library/io/stdio.factor +++ b/library/io/stdio.factor @@ -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 ; diff --git a/library/io/stream.factor b/library/io/stream.factor index 49acf0484d..2a9c5cb44e 100644 --- a/library/io/stream.factor +++ b/library/io/stream.factor @@ -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 ; diff --git a/library/math/constants.factor b/library/math/constants.factor index 840ab2e5e3..13d938ce19 100644 --- a/library/math/constants.factor +++ b/library/math/constants.factor @@ -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 diff --git a/library/math/integer.factor b/library/math/integer.factor index 96c8d2124a..20f50ecf44 100644 --- a/library/math/integer.factor +++ b/library/math/integer.factor @@ -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 ) diff --git a/library/opengl/gl.factor b/library/opengl/gl.factor index c4adcc2126..7bcbe503ec 100644 --- a/library/opengl/gl.factor +++ b/library/opengl/gl.factor @@ -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 diff --git a/library/opengl/load.factor b/library/opengl/load.factor deleted file mode 100644 index fa2f4fafd1..0000000000 --- a/library/opengl/load.factor +++ /dev/null @@ -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 diff --git a/library/sdl/load.factor b/library/sdl/load.factor deleted file mode 100644 index 64b2fc3095..0000000000 --- a/library/sdl/load.factor +++ /dev/null @@ -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 diff --git a/library/sdl/sdl.factor b/library/sdl/sdl.factor index 3d6756d79d..85a48e2a45 100644 --- a/library/sdl/sdl.factor +++ b/library/sdl/sdl.factor @@ -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 ; diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor index 84b0595ca2..117c2ad970 100644 --- a/library/tools/interpreter.factor +++ b/library/tools/interpreter.factor @@ -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 - ; + meta-d get meta-r get meta-n get meta-c get ; : 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 -- ) [ diff --git a/library/ui/load.factor b/library/ui/load.factor deleted file mode 100644 index 1822c615a3..0000000000 --- a/library/ui/load.factor +++ /dev/null @@ -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 diff --git a/library/vocabularies.factor b/library/vocabularies.factor index ee73531241..700cd4c0ca 100644 --- a/library/vocabularies.factor +++ b/library/vocabularies.factor @@ -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 ;