From 194e0d00c72f981b4b9c5f7c3c71162b81ebba5c Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 27 Feb 2008 18:15:18 -0600 Subject: [PATCH 01/10] unix: start removing the factored out types --- extra/unix/types/linux/linux.factor | 4 +-- extra/unix/unix.factor | 40 ++++++++++++++--------------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/extra/unix/types/linux/linux.factor b/extra/unix/types/linux/linux.factor index 9be9756edd..8822366a3a 100644 --- a/extra/unix/types/linux/linux.factor +++ b/extra/unix/types/linux/linux.factor @@ -7,9 +7,9 @@ IN: unix.types TYPEDEF: ulonglong __uquad_type TYPEDEF: ulong __ulongword_type -TYPEDEF: uint __uword_type +TYPEDEF: long __sword_type +TYPEDEF: ulong __uword_type TYPEDEF: long __slongword_type -TYPEDEF: int __sword_type TYPEDEF: uint __u32_type TYPEDEF: int __s32_type diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index e8716ee074..68e46eb2ae 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -2,36 +2,36 @@ ! See http://factorcode.org/license.txt for BSD license. IN: unix USING: alien alien.c-types alien.syntax kernel libc structs -math namespaces system combinators vocabs.loader ; +math namespaces system combinators vocabs.loader unix.types ; ! ! ! Unix types -TYPEDEF: long word -TYPEDEF: ulong uword +! TYPEDEF: long word +! TYPEDEF: ulong uword -TYPEDEF: long longword -TYPEDEF: ulong ulongword +! TYPEDEF: long longword +! TYPEDEF: ulong ulongword -TYPEDEF: long ssize_t -TYPEDEF: longword blksize_t -TYPEDEF: longword blkcnt_t -TYPEDEF: longlong quad_t -TYPEDEF: ulonglong dev_t -TYPEDEF: uint gid_t +! TYPEDEF: long ssize_t +! TYPEDEF: longword blksize_t +! TYPEDEF: longword blkcnt_t +! TYPEDEF: longlong quad_t +! TYPEDEF: ulonglong dev_t +! TYPEDEF: uint gid_t TYPEDEF: uint in_addr_t -TYPEDEF: ulong ino_t -TYPEDEF: int pid_t +! TYPEDEF: ulong ino_t +! TYPEDEF: int pid_t TYPEDEF: uint socklen_t TYPEDEF: uint time_t -TYPEDEF: uint uid_t +! TYPEDEF: uint uid_t TYPEDEF: ulong size_t -TYPEDEF: ulong u_long -TYPEDEF: uint mode_t -TYPEDEF: uword nlink_t -TYPEDEF: void* caddr_t +! TYPEDEF: ulong u_long +! TYPEDEF: uint mode_t +! TYPEDEF: uword nlink_t +! TYPEDEF: void* caddr_t -TYPEDEF: ulong off_t -TYPEDEF-IF: bsd? ulonglong off_t +! TYPEDEF: ulong off_t +! TYPEDEF-IF: bsd? ulonglong off_t C-STRUCT: tm { "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?) From bef1d40964998c2784f208f3df93bcb9dc174791 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 27 Feb 2008 19:01:55 -0600 Subject: [PATCH 02/10] unix.types.macosx: fix using --- extra/unix/types/macosx/macosx.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/unix/types/macosx/macosx.factor b/extra/unix/types/macosx/macosx.factor index 822e32251a..8f9c5082df 100644 --- a/extra/unix/types/macosx/macosx.factor +++ b/extra/unix/types/macosx/macosx.factor @@ -1,4 +1,6 @@ +USING: alien.syntax ; + IN: unix.types ! Darwin 9.1.0 ppc From 7c24a782815e2278194e111f63415258c4b314c6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 28 Feb 2008 01:20:27 -0600 Subject: [PATCH 03/10] Fix init-hook regression --- core/debugger/debugger.factor | 31 +++++++++++++++++++------------ core/io/files/files.factor | 1 - core/libc/libc.factor | 8 +------- 3 files changed, 20 insertions(+), 20 deletions(-) mode change 100644 => 100755 core/libc/libc.factor diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index 378491e141..40bcbe78b1 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -6,7 +6,7 @@ strings io.styles vectors words system splitting math.parser tuples continuations continuations.private combinators generic.math io.streams.duplex classes compiler.units generic.standard vocabs threads threads.private init -kernel.private ; +kernel.private libc ; IN: debugger GENERIC: error. ( error -- ) @@ -63,20 +63,9 @@ M: string error. print ; [ global [ "Error in print-error!" print drop ] bind ] recover ; -: error-in-thread. ( -- ) - error-thread get-global - "Error in thread " write - [ - dup thread-id # - " (" % dup thread-name % - ", " % dup thread-quot unparse-short % ")" % - ] "" make - swap write-object ":" print nl ; - SYMBOL: error-hook [ - error-in-thread. print-error restarts. nl @@ -265,6 +254,24 @@ M: no-compilation-unit error. M: no-vocab summary drop "Vocabulary does not exist" ; +M: check-ptr summary + drop "Memory allocation failed" ; + +M: double-free summary + drop "Free failed since memory is not allocated" ; + +M: realloc-error summary + drop "Memory reallocation failed" ; + +: error-in-thread. ( -- ) + error-thread get-global + "Error in thread " write + [ + dup thread-id # + " (" % dup thread-name % + ", " % dup thread-quot unparse-short % ")" % + ] "" make swap write-object ":" print nl ; + ! Hooks M: thread error-in-thread ( error thread -- ) initial-thread get-global eq? [ diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 64e4f0f49a..85f0621443 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -142,7 +142,6 @@ DEFER: copy-tree-to : copy-tree ( from to -- ) over directory? [ - dup make-directories >r dup directory swap r> [ >r swap first path+ r> copy-tree-to ] 2curry each diff --git a/core/libc/libc.factor b/core/libc/libc.factor old mode 100644 new mode 100755 index a28c5c0a98..e82b244d6d --- a/core/libc/libc.factor +++ b/core/libc/libc.factor @@ -2,7 +2,7 @@ ! Copyright (C) 2007 Slava Pestov ! Copyright (C) 2007 Doug Coleman ! See http://factorcode.org/license.txt for BSD license. -USING: alien assocs continuations init inspector kernel namespaces ; +USING: alien assocs continuations init kernel namespaces ; IN: libc TUPLE: check-ptr ; -M: check-ptr summary drop "Memory allocation failed" ; - : check-ptr ( c-ptr -- c-ptr ) [ \ check-ptr construct-boa throw ] unless* ; TUPLE: double-free ; -M: double-free summary drop "Free failed since memory is not allocated" ; - : double-free ( -- * ) \ double-free construct-empty throw ; TUPLE: realloc-error ptr size ; -M: realloc-error summary drop "Memory reallocation failed" ; - : realloc-error ( alien size -- * ) \ realloc-error construct-boa throw ; From e47a9cface6fabba2527bedbbc9b2d694bb1b543 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 28 Feb 2008 01:20:44 -0600 Subject: [PATCH 04/10] Add timeout support to simple-monitors (untested) --- extra/io/monitors/monitors.factor | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/extra/io/monitors/monitors.factor b/extra/io/monitors/monitors.factor index 8c2c9cb9d8..34065203f8 100755 --- a/extra/io/monitors/monitors.factor +++ b/extra/io/monitors/monitors.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.backend kernel continuations namespaces sequences -assocs hashtables sorting arrays threads boxes ; +assocs hashtables sorting arrays threads boxes io.timeouts ; IN: io.monitors ( handle -- simple-monitor ) f (monitor) { @@ -47,9 +51,14 @@ TUPLE: simple-monitor handle callback ; : notify-callback ( simple-monitor -- ) simple-monitor-callback ?box [ resume ] [ drop ] if ; +M: simple-monitor timed-out + notify-callback ; + M: simple-monitor fill-queue ( monitor -- ) - [ swap simple-monitor-callback >box ] - "monitor" suspend drop + [ + [ swap simple-monitor-callback >box ] + "monitor" suspend drop + ] with-timeout check-monitor ; M: simple-monitor dispose ( monitor -- ) From 609e6eaa5a45002a2a4e0048f70d97f8f77769a9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 28 Feb 2008 01:21:30 -0600 Subject: [PATCH 05/10] Deployment fixes; add unit test which ensures deploy images are not too large --- extra/tools/deploy/config/config-docs.factor | 5 +++++ extra/tools/deploy/config/config.factor | 2 ++ extra/tools/deploy/deploy-tests.factor | 22 +++++++++++++++++++ extra/tools/deploy/shaker/shaker.factor | 13 +++++++++-- .../tools/deploy/shaker/strip-debugger.factor | 4 +++- extra/tools/deploy/windows/windows.factor | 19 ++++++++-------- 6 files changed, 53 insertions(+), 12 deletions(-) create mode 100755 extra/tools/deploy/deploy-tests.factor diff --git a/extra/tools/deploy/config/config-docs.factor b/extra/tools/deploy/config/config-docs.factor index c1b9755cd6..846bb5c274 100755 --- a/extra/tools/deploy/config/config-docs.factor +++ b/extra/tools/deploy/config/config-docs.factor @@ -66,6 +66,11 @@ HELP: deploy-math? $nl "On by default. Often the programmer will use rationals without realizing it. A small amount of space can be saved by stripping these features out, but some code may require changes to work properly." } ; +HELP: deploy-threads? +{ $description "Deploy flag. If set, the deployed image will contain support for threads." +$nl +"On by default. Often the programmer will use threads without realizing it. A small amount of space can be saved by stripping this feature out, but some code may require changes to work properly." } ; + HELP: deploy-compiler? { $description "Deploy flag. If set, words in the deployed image will be compiled with the optimizing compiler when possible." $nl diff --git a/extra/tools/deploy/config/config.factor b/extra/tools/deploy/config/config.factor index 1f34e68f29..64f863b730 100755 --- a/extra/tools/deploy/config/config.factor +++ b/extra/tools/deploy/config/config.factor @@ -10,6 +10,7 @@ SYMBOL: deploy-name SYMBOL: deploy-ui? SYMBOL: deploy-compiler? SYMBOL: deploy-math? +SYMBOL: deploy-threads? SYMBOL: deploy-io @@ -55,6 +56,7 @@ SYMBOL: deploy-image { deploy-io 2 } { deploy-reflection 1 } { deploy-compiler? t } + { deploy-threads? t } { deploy-math? t } { deploy-word-props? f } { deploy-word-defs? f } diff --git a/extra/tools/deploy/deploy-tests.factor b/extra/tools/deploy/deploy-tests.factor new file mode 100755 index 0000000000..2f79669497 --- /dev/null +++ b/extra/tools/deploy/deploy-tests.factor @@ -0,0 +1,22 @@ +IN: temporary +USING: tools.test system io.files kernel tools.deploy.config +tools.deploy.backend math ; + +: shake-and-bake + "." resource-path [ + vm + "hello.image" temp-file + rot dup deploy-config make-deploy-image + ] with-directory ; + +[ ] [ "hello-world" shake-and-bake ] unit-test + +[ t ] [ + "hello.image" temp-file file-length 500000 <= +] unit-test + +[ ] [ "hello-ui" shake-and-bake ] unit-test + +[ t ] [ + "hello.image" temp-file file-length 2000000 <= +] unit-test diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index 16507232ae..0ddc2d5707 100755 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -11,8 +11,16 @@ IN: tools.deploy.shaker : strip-init-hooks ( -- ) "Stripping startup hooks" show "command-line" init-hooks get delete-at - "mallocs" init-hooks get delete-at - strip-io? [ "io.backend" init-hooks get delete-at ] when ; + "libc" init-hooks get delete-at + deploy-threads? get [ + "threads" init-hooks get delete-at + ] unless + native-io? [ + "io.thread" init-hooks get delete-at + ] unless + strip-io? [ + "io.backend" init-hooks get delete-at + ] when ; : strip-debugger ( -- ) strip-debugger? [ @@ -85,6 +93,7 @@ IN: tools.deploy.shaker { } set-retainstack V{ } set-namestack V{ } set-catchstack + "Saving final image" show [ save-image-and-exit ] call-clear ; diff --git a/extra/tools/deploy/shaker/strip-debugger.factor b/extra/tools/deploy/shaker/strip-debugger.factor index 38f5268c80..5caab02e69 100755 --- a/extra/tools/deploy/shaker/strip-debugger.factor +++ b/extra/tools/deploy/shaker/strip-debugger.factor @@ -1,6 +1,8 @@ -USING: kernel ; +USING: kernel threads threads.private ; IN: debugger : print-error die ; : error. die ; + +M: thread error-in-thread ( error thread -- ) die 2drop ; diff --git a/extra/tools/deploy/windows/windows.factor b/extra/tools/deploy/windows/windows.factor index b8a1def3a4..fb9e0f815a 100755 --- a/extra/tools/deploy/windows/windows.factor +++ b/extra/tools/deploy/windows/windows.factor @@ -10,10 +10,10 @@ IN: tools.deploy.windows vm over copy-file ; : copy-fonts ( bundle-name -- ) - "fonts/" resource-path swap copy-tree ; + "fonts/" resource-path swap copy-tree-to ; : copy-dlls ( bundle-name -- ) - { "freetype6.dll" "zlib1.dll" "factor-nt.dll" } + { "freetype6.dll" "zlib1.dll" "factor.dll" } [ resource-path ] map swap copy-files-to ; @@ -30,10 +30,11 @@ TUPLE: windows-deploy-implementation ; T{ windows-deploy-implementation } deploy-implementation set-global M: windows-deploy-implementation deploy* - "." resource-path cd - dup deploy-config [ - [ deploy-name get create-exe-dir ] keep - [ deploy-name get image-name ] keep - [ namespace make-deploy-image ] keep - open-in-explorer - ] bind ; + "." resource-path [ + dup deploy-config [ + [ deploy-name get create-exe-dir ] keep + [ deploy-name get image-name ] keep + [ namespace make-deploy-image ] keep + open-in-explorer + ] bind + ] with-directory ; From 9d05d814918482a64c6c681ef4da5343d337705c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 28 Feb 2008 01:22:53 -0600 Subject: [PATCH 06/10] Fix deploy size regression --- vm/image.c | 3 +++ vm/run.h | 1 + 2 files changed, 4 insertions(+) diff --git a/vm/image.c b/vm/image.c index 70eceeafdc..d9f8ac2461 100755 --- a/vm/image.c +++ b/vm/image.c @@ -161,6 +161,9 @@ DEFINE_PRIMITIVE(save_image_and_exit) for(i = 0; i < FIRST_SAVE_ENV; i++) userenv[i] = F; + for(i = LAST_SAVE_ENV + 1; i < USER_ENV; i++) + userenv[i] = F; + /* do a full GC + code heap compaction */ compact_code_heap(); diff --git a/vm/run.h b/vm/run.h index 3835c374ed..f9b8057069 100755 --- a/vm/run.h +++ b/vm/run.h @@ -64,6 +64,7 @@ typedef enum { } F_ENVTYPE; #define FIRST_SAVE_ENV BOOT_ENV +#define LAST_SAVE_ENV STAGE2_ENV /* TAGGED user environment data; see getenv/setenv prims */ DLLEXPORT CELL userenv[USER_ENV]; From d28117e3e71bec61bc68d1e51013dff01ca0e1ff Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 28 Feb 2008 01:32:49 -0600 Subject: [PATCH 07/10] Make hello-world smaller --- extra/hello-world/deploy.factor | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/extra/hello-world/deploy.factor b/extra/hello-world/deploy.factor index 6dee7d4be3..45d19cb891 100755 --- a/extra/hello-world/deploy.factor +++ b/extra/hello-world/deploy.factor @@ -1,13 +1,14 @@ USING: tools.deploy.config ; H{ - { deploy-c-types? f } - { deploy-ui? f } - { deploy-reflection 1 } + { deploy-io 2 } { deploy-math? f } + { deploy-threads? f } + { deploy-compiler? f } { deploy-word-props? f } { deploy-word-defs? f } { deploy-name "Hello world (console)" } + { deploy-reflection 2 } + { deploy-c-types? f } + { deploy-ui? f } { "stop-after-last-window?" t } - { deploy-compiler? f } - { deploy-io 2 } } From 4fcc3d4c1a9876a48486cbdb2ddd2fddf6c02731 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 28 Feb 2008 01:32:58 -0600 Subject: [PATCH 08/10] Use temp-file --- extra/tools/disassembler/disassembler.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor index 801e5b6d54..8a0cd495cf 100755 --- a/extra/tools/disassembler/disassembler.factor +++ b/extra/tools/disassembler/disassembler.factor @@ -27,7 +27,7 @@ M: pair make-disassemble-cmd +closed+ +stdin+ set out-file +stdout+ set [ "gdb" , "-x" , in-file , "-batch" , ] { } make +arguments+ set - ] { } make-assoc run-process drop + ] { } make-assoc try-process out-file file-lines ; : tabs>spaces ( str -- str' ) From 1c959d0ccad2454891a23b1483904e6b04e551e8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 28 Feb 2008 01:33:09 -0600 Subject: [PATCH 09/10] Add new checkbox --- extra/ui/tools/deploy/deploy.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/ui/tools/deploy/deploy.factor b/extra/ui/tools/deploy/deploy.factor index df87d57873..9aa763d7ec 100755 --- a/extra/ui/tools/deploy/deploy.factor +++ b/extra/ui/tools/deploy/deploy.factor @@ -34,9 +34,10 @@ TUPLE: deploy-gadget vocab settings ; "Advanced:"