From 565f97950a35e5dd001887c12edc32150b220906 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 15 Nov 2007 23:09:38 -0600 Subject: [PATCH 01/19] Fix redundancy in tty-listener --- extra/raptor/raptor.factor | 5 ++--- extra/raptor/readme-0.1.1 | 17 +++++++++++++---- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index b0b9c05895..a3b4cbfd0a 100644 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -40,9 +40,8 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex listener ; : tty-listener ( tty -- ) - [ ] - [ ] - bi [ listener ] with-stream ; + [ ] [ ] bi + [ listener ] with-stream ; : forever ( quot -- ) [ call ] [ forever ] bi ; diff --git a/extra/raptor/readme-0.1.1 b/extra/raptor/readme-0.1.1 index 303fb416c4..bb5d4c0ff8 100644 --- a/extra/raptor/readme-0.1.1 +++ b/extra/raptor/readme-0.1.1 @@ -8,9 +8,22 @@ Raptor Linux is a mod of Ubuntu 6.06 (Dapper Drake) This is unlikely to work on another version of Ubuntu, much less another Linux distribution. +*** Features *** + + * /sbin/init is replaced with Factor + * Virtual terminals managed by Factor + * Listeners run on virtual terminals + * Native support for static ip networking + * Crontab replacement + *** Install *** + # mkdir -v /etc/raptor + + # cp -v /scratch/factor/extra/raptor/{config,cronjobs}.factor /etc/raptor + ( scratchpad ) USE: raptor + ( scratchpad ) reload-raptor-config ( scratchpad ) save # mv -v /sbin/{init,init.orig} @@ -19,10 +32,6 @@ another Linux distribution. # cp -v /scratch/factor/factor.image /sbin/init.image - # mkdir -v /etc/raptor - - # cp -v /scratch/factor/extra/raptor/config.factor /etc/raptor/config.factor - *** Static IP networking *** If you use a static IP in your network then Factor can take care of From f927a01370f3d7d77717f64635c65cd9bc71a534 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 18 Nov 2007 15:19:02 -0600 Subject: [PATCH 02/19] unix: Added words to inspect status from wait/waitpid --- extra/unix/unix.factor | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 0854754dcb..10ff7a9efa 100644 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -166,6 +166,10 @@ FUNCTION: time_t time ( time_t* t ) ; FUNCTION: int unlink ( char* path ) ; FUNCTION: int utimes ( char* path, timeval[2] times ) ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! wait and waitpid +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Flags for waitpid : WNOHANG 1 ; @@ -176,7 +180,27 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ; : WCONTINUED 8 ; : WNOWAIT HEX: 1000000 ; +! Examining status + +: WTERMSIG ( status -- value ) HEX: 7f bitand ; + +: WIFEXITED ( status -- ? ) WTERMSIG zero? ; + +: WEXITSTATUS ( status -- value ) HEX: ff00 bitand -8 shift ; + +: WIFSIGNALED ( status -- ? ) HEX: 7f bitand 1+ -1 shift 0 > ; + +: WCOREFLAG ( -- value ) HEX: 80 ; + +: WCOREDUMP ( status -- ? ) WCOREFLAG bitand zero? not ; + +: WIFSTOPPED ( status -- ? ) HEX: ff bitand HEX: 7f = ; + +: WSTOPSIG ( status -- value ) WEXITSTATUS ; + FUNCTION: pid_t wait ( int* status ) ; FUNCTION: pid_t waitpid ( pid_t wpid, int* status, int options ) ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; From 76146310db62e8f265e078b0f035e4861906ee72 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:57:22 -0600 Subject: [PATCH 03/19] Add `{ parsing word to bake --- extra/bake/bake.factor | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor index 5e1700c6e2..437a42d546 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -1,6 +1,6 @@ -USING: kernel parser namespaces quotations vectors strings -sequences assocs tuples math combinators ; +USING: kernel parser namespaces quotations arrays vectors strings + sequences assocs tuples math combinators ; IN: bake @@ -48,4 +48,8 @@ DEFER: bake : bake-items ( seq -- ) [ bake-item ] each ; : bake ( seq -- seq ) - [ reset-building save-exemplar bake-items finish-baking ] with-scope ; \ No newline at end of file + [ reset-building save-exemplar bake-items finish-baking ] with-scope ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing \ No newline at end of file From 350a23e525f10f8041db3c2a02c12f6d71ee219c Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:57:44 -0600 Subject: [PATCH 04/19] Add factor-refresh-all function to factor.el --- misc/factor.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/misc/factor.el b/misc/factor.el index 19e29843d6..88af0a6dab 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -166,6 +166,9 @@ (beginning-of-line) (insert "! ")) +(defun factor-refresh-all () + (interactive) + (comint-send-string "*factor*" "refresh-all\n")) (define-key factor-mode-map "\C-c\C-f" 'factor-run-file) (define-key factor-mode-map "\C-c\C-r" 'factor-send-region) From 1d4d78c2ce404e2827488d2bced2b15710cb5512 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:58:20 -0600 Subject: [PATCH 05/19] Add the new wait-loop system to unix.process --- extra/unix/process/process.factor | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index 7f06f903ac..a99611aba6 100644 --- a/extra/unix/process/process.factor +++ b/extra/unix/process/process.factor @@ -31,11 +31,23 @@ IN: unix.process ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! This is kludgy. We need a better implementation. +USING: kernel alien.c-types namespaces continuations threads assocs unix + combinators.cleave ; -USE: threads +SYMBOL: pid-wait -: wait-for-pid ( pid -- ) - dup "int" WNOHANG waitpid - 0 = [ 100 sleep wait-for-pid ] [ drop ] if ; +! KEY | VALUE +! ----------- +! pid | continuation +: init-pid-wait ( -- ) H{ } clone pid-wait set-global ; + +: wait-for-pid ( pid -- status ) [ pid-wait get set-at stop ] curry callcc1 ; + +: wait-loop ( -- ) + -1 0 tuck WNOHANG waitpid ! &status return + [ *int ] [ pid-wait get delete-at* drop ] bi* ! status ? + dup [ schedule-thread-with ] [ 2drop ] if + 250 sleep wait-loop ; + +: start-wait-loop ( -- ) init-pid-wait [ wait-loop ] in-thread ; \ No newline at end of file From bbcd7bc6ea2ab9a5ff7cc5b1c98776aee9de90f0 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:59:04 -0600 Subject: [PATCH 06/19] Modify raptor.cron --- extra/raptor/cron/cron.factor | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/extra/raptor/cron/cron.factor b/extra/raptor/cron/cron.factor index f004ba30d5..8158a03286 100644 --- a/extra/raptor/cron/cron.factor +++ b/extra/raptor/cron/cron.factor @@ -1,5 +1,6 @@ -USING: kernel threads sequences calendar combinators.cleave combinators.lib ; +USING: kernel namespaces threads sequences calendar + combinators.cleave combinators.lib ; IN: raptor.cron @@ -46,3 +47,16 @@ C: when : schedule ( when quot -- ) [ recurring-job ] curry curry in-thread ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: cron-jobs-hourly +SYMBOL: cron-jobs-daily +SYMBOL: cron-jobs-weekly +SYMBOL: cron-jobs-monthly + +: schedule-cron-jobs ( -- ) + { 17 } f f f f [ cron-jobs-hourly get call ] schedule + { 25 } { 6 } f f f [ cron-jobs-daily get call ] schedule + { 47 } { 6 } f f { 7 } [ cron-jobs-weekly get call ] schedule + { 52 } { 6 } { 1 } f f [ cron-jobs-monthly get call ] schedule ; + From bab5554cfe409af70b5cb127e58bd71e186d24de Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 01:59:37 -0600 Subject: [PATCH 07/19] Refactor raptor a bit --- extra/raptor/raptor.factor | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index a3b4cbfd0a..7e32463ea1 100644 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -1,5 +1,6 @@ -USING: kernel parser namespaces threads unix.process combinators.cleave ; +USING: kernel parser namespaces threads sequences unix unix.process + combinators.cleave bake ; IN: raptor @@ -10,29 +11,29 @@ SYMBOL: reboot-hook SYMBOL: shutdown-hook SYMBOL: networking-hook +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : reload-raptor-config ( -- ) "/etc/raptor/config.factor" run-file "/etc/raptor/cronjobs.factor" run-file ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -USING: sequences unix ; +: fork-exec-wait ( pathname args -- ) + fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid drop ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: forever ( quot -- ) [ call ] [ forever ] bi ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : start-service ( name -- ) "/etc/init.d/" swap " start" 3append system drop ; : stop-service ( name -- ) "/etc/init.d/" swap " stop" 3append system drop ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: fork-exec-wait ( pathname args -- ) - fork dup 0 = [ drop exec drop ] [ 2nip wait-for-pid ] if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: respawn ( pathname args -- ) [ fork-exec-wait ] [ respawn ] 2bi ; - -: start-gettys ( -- ) - [ "/sbin/getty" { "getty" "38400" "tty5" } respawn ] in-thread - [ "/sbin/getty" { "getty" "38400" "tty6" } respawn ] in-thread ; +: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-wait ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -43,13 +44,6 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex [ ] [ ] bi [ listener ] with-stream ; -: forever ( quot -- ) [ call ] [ forever ] bi ; - -: start-listeners ( -- ) - [ [ "/dev/tty2" tty-listener ] forever ] in-thread - [ [ "/dev/tty3" tty-listener ] forever ] in-thread - [ [ "/dev/tty4" tty-listener ] forever ] in-thread ; - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : start-networking ( -- ) networking-hook get call ; @@ -59,3 +53,4 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex : shutdown ( -- ) shutdown-hook get call ; MAIN: boot + From a2aea6a4d17353812b9b3c9561ba2297d88e4ea1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 20 Nov 2007 02:03:16 -0600 Subject: [PATCH 08/19] Update raptor config and cronjobs --- extra/raptor/config.factor | 21 +++++++++--- extra/raptor/cronjobs.factor | 63 ++++++++++++++++-------------------- 2 files changed, 45 insertions(+), 39 deletions(-) diff --git a/extra/raptor/config.factor b/extra/raptor/config.factor index d06d8e3db0..386ddf7744 100644 --- a/extra/raptor/config.factor +++ b/extra/raptor/config.factor @@ -1,5 +1,7 @@ -USING: namespaces unix.linux.if unix.linux.ifreq unix.linux.route ; +USING: namespaces threads + unix.process unix.linux.if unix.linux.ifreq unix.linux.route + raptor.cron ; IN: raptor @@ -24,9 +26,12 @@ IN: raptor configure-route ] networking-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! boot-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ + start-wait-loop ! rcS.d @@ -76,11 +81,17 @@ IN: raptor "rmnologin" start-service schedule-cron-jobs - start-listeners - start-gettys - + + [ [ "/dev/tty2" tty-listener ] forever ] in-thread + [ [ "/dev/tty3" tty-listener ] forever ] in-thread + [ [ "/dev/tty4" tty-listener ] forever ] in-thread + [ [ "/dev/tty5" getty ] forever ] in-thread + [ [ "/dev/tty6" getty ] forever ] in-thread + ] boot-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! reboot-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ @@ -108,6 +119,8 @@ IN: raptor "reboot" stop-service ] reboot-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! shutdown-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ diff --git a/extra/raptor/cronjobs.factor b/extra/raptor/cronjobs.factor index 394c213162..894e8e5ce7 100644 --- a/extra/raptor/cronjobs.factor +++ b/extra/raptor/cronjobs.factor @@ -1,5 +1,6 @@ -USING: kernel threads arrays sequences combinators.cleave raptor raptor.cron ; +USING: kernel namespaces threads arrays sequences combinators.cleave + raptor raptor.cron ; IN: raptor @@ -7,41 +8,33 @@ IN: raptor : fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ; +: run-script ( path -- ) 1array [ fork-exec-args-wait ] curry in-thread ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: cron-hourly ( -- ) ; - -: cron-daily ( -- ) - { "/etc/cron.daily/apt" - "/etc/cron.daily/aptitude" - "/etc/cron.daily/bsdmainutils" - "/etc/cron.daily/find.notslocate" - "/etc/cron.daily/logrotate" - "/etc/cron.daily/man-db" - "/etc/cron.daily/ntp-server" - "/etc/cron.daily/slocate" - "/etc/cron.daily/standard" - "/etc/cron.daily/sysklogd" - "/etc/cron.daily/tetex-bin" } - [ 1array [ fork-exec-args-wait ] in-thread drop ] each ; +[ + "/etc/cron.daily/apt" run-script + "/etc/cron.daily/aptitude" run-script + "/etc/cron.daily/bsdmainutils" run-script + "/etc/cron.daily/find.notslocate" run-script + "/etc/cron.daily/logrotate" run-script + "/etc/cron.daily/man-db" run-script + "/etc/cron.daily/ntp-server" run-script + "/etc/cron.daily/slocate" run-script + "/etc/cron.daily/standard" run-script + "/etc/cron.daily/sysklogd" run-script + "/etc/cron.daily/tetex-bin" run-script +] cron-jobs-daily set-global -: cron-weekly ( -- ) - { "/etc/cron.weekly/cvs" - "/etc/cron.weekly/man-db" - "/etc/cron.weekly/ntp-server" - "/etc/cron.weekly/popularity-contest" - "/etc/cron.weekly/sysklogd" } - [ 1array [ fork-exec-args-wait ] in-thread drop ] each ; +[ + "/etc/cron.weekly/cvs" run-script + "/etc/cron.weekly/man-db" run-script + "/etc/cron.weekly/ntp-server" run-script + "/etc/cron.weekly/popularity-contest" run-script + "/etc/cron.weekly/sysklogd" run-script +] cron-jobs-weekly set-global -: cron-monthly ( -- ) - { "/etc/cron.monthly/scrollkeeper" - "/etc/cron.monthly/standard" } - [ 1array [ fork-exec-args-wait ] in-thread drop ] each ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: schedule-cron-jobs ( -- ) - { 17 } f f f f [ cron-hourly ] schedule - { 25 } { 6 } f f f [ cron-daily ] schedule - { 47 } { 6 } f f { 7 } [ cron-weekly ] schedule - { 52 } { 6 } { 1 } f f [ cron-monthly ] schedule ; \ No newline at end of file +[ + "/etc/cron.monthly/scrollkeeper" run-script + "/etc/cron.monthly/standard" run-script +] cron-jobs-monthly set-global \ No newline at end of file From 32da4e364cd6a64a243e5661ab88f5399a51e607 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Nov 2007 03:19:06 -0500 Subject: [PATCH 09/19] Deployment fixes for Windows --- extra/tools/deploy/deploy.factor | 2 +- extra/tools/deploy/shaker/shaker.factor | 16 ++++++++-------- extra/tools/deploy/shaker/strip-debugger.factor | 0 3 files changed, 9 insertions(+), 9 deletions(-) mode change 100644 => 100755 extra/tools/deploy/shaker/shaker.factor mode change 100644 => 100755 extra/tools/deploy/shaker/strip-debugger.factor diff --git a/extra/tools/deploy/deploy.factor b/extra/tools/deploy/deploy.factor index 7c0dabc458..1b05412227 100755 --- a/extra/tools/deploy/deploy.factor +++ b/extra/tools/deploy/deploy.factor @@ -54,7 +54,7 @@ IN: tools.deploy "\"-output-image=" swap "\"" 3append , - "-no-stack-traces" , + ! "-no-stack-traces" , "-no-user-init" , ] { } make ; diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor old mode 100644 new mode 100755 index 0322ed372f..3e1aa3ab53 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -24,7 +24,6 @@ IN: tools.deploy.shaker "Stripping debugger" show "resource:extra/tools/deploy/shaker/strip-debugger.factor" run-file - do-parse-hook ] when ; : strip-libc ( -- ) @@ -32,7 +31,6 @@ IN: tools.deploy.shaker "Stripping manual memory management debug code" show "resource:extra/tools/deploy/shaker/strip-libc.factor" run-file - do-parse-hook ] when ; : strip-cocoa ( -- ) @@ -40,7 +38,6 @@ IN: tools.deploy.shaker "Stripping unused Cocoa methods" show "resource:extra/tools/deploy/shaker/strip-cocoa.factor" run-file - do-parse-hook ] when ; : strip-assoc ( retained-keys assoc -- newassoc ) @@ -116,7 +113,6 @@ SYMBOL: deploy-vocab strip-dictionary? [ { - builtins dictionary inspector-hook lexer-factory @@ -142,6 +138,10 @@ SYMBOL: deploy-vocab "c-types" "alien.c-types" lookup , ] when + native-io? [ + "default-buffer-size" "io.nonblocking" lookup , + ] when + deploy-ui? get [ "ui" child-vocabs "cocoa" child-vocabs @@ -152,10 +152,11 @@ SYMBOL: deploy-vocab ] when ] { } make dup . ; -: strip ( -- ) - strip-libc +: strip ( hook -- ) + >r strip-libc strip-cocoa strip-debugger + r> [ call ] when* strip-init-hooks deploy-vocab get vocab-main set-boot-quot* retained-props >r @@ -168,10 +169,9 @@ SYMBOL: deploy-vocab [ [ deploy-vocab set - parse-hook get >r + parse-hook get parse-hook off deploy-vocab get require - r> [ call ] when* strip finish-deploy ] [ diff --git a/extra/tools/deploy/shaker/strip-debugger.factor b/extra/tools/deploy/shaker/strip-debugger.factor old mode 100644 new mode 100755 From 25de6273b391d9b915cf4a0ea080ef1c18120c97 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Nov 2007 03:20:32 -0500 Subject: [PATCH 10/19] Fix editors --- extra/ui/gadgets/editors/editors-tests.factor | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/extra/ui/gadgets/editors/editors-tests.factor b/extra/ui/gadgets/editors/editors-tests.factor index a38ca6044e..6be0423e95 100755 --- a/extra/ui/gadgets/editors/editors-tests.factor +++ b/extra/ui/gadgets/editors/editors-tests.factor @@ -1,7 +1,7 @@ USING: ui.gadgets.editors tools.test kernel io io.streams.plain definitions namespaces ui.gadgets ui.gadgets.grids prettyprint documents ui.gestures -tools.test.inference tools.test.ui ; +tools.test.inference tools.test.ui models ; [ "foo bar" ] [ "editor" set @@ -31,3 +31,9 @@ tools.test.inference tools.test.ui ; ] unit-test { 0 1 } [ ] unit-test-effect + +"hello" "field" set + +"field" get [ + [ "hello" ] [ "field" get field-model model-value ] unit-test +] with-grafted-gadget From 555e2c9964347129b12438eea1c79bbad21c5df7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Nov 2007 03:21:26 -0500 Subject: [PATCH 11/19] Fix activate-control --- extra/ui/gadgets/gadgets.factor | 8 ++++-- .../ui/gadgets/incremental/incremental.factor | 25 +++++++++++-------- 2 files changed, 20 insertions(+), 13 deletions(-) diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index 9929cece29..7dd12cb610 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -70,8 +70,12 @@ M: gadget model-changed 2drop ; >r r> construct-delegate ; inline : activate-control ( gadget -- ) - dup gadget-model dup [ 2dup add-connection ] when drop - dup gadget-model swap model-changed ; + dup gadget-model dup [ + 2dup add-connection + swap model-changed + ] [ + 2drop + ] if ; : deactivate-control ( gadget -- ) dup gadget-model dup [ 2dup remove-connection ] when 2drop ; diff --git a/extra/ui/gadgets/incremental/incremental.factor b/extra/ui/gadgets/incremental/incremental.factor index a5c7431d36..3e068ead45 100755 --- a/extra/ui/gadgets/incremental/incremental.factor +++ b/extra/ui/gadgets/incremental/incremental.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io kernel math namespaces math.vectors ui.gadgets ; +USING: io kernel math namespaces math.vectors ui.gadgets +dlists ; IN: ui.gadgets.incremental ! Incremental layout allows adding lines to panes to be O(1). @@ -14,12 +15,14 @@ IN: ui.gadgets.incremental ! New gadgets are added at ! incremental-cursor gadget-orientation v* -TUPLE: incremental cursor ; +TUPLE: incremental cursor queue ; : ( pack -- incremental ) - dup pref-dim - { set-gadget-delegate set-incremental-cursor } - incremental construct ; + dup pref-dim { + set-gadget-delegate + set-incremental-cursor + set-incremental-queue + } incremental construct ; M: incremental pref-dim* dup gadget-layout-state [ @@ -40,17 +43,17 @@ M: incremental pref-dim* swap set-rect-loc ; : prefer-incremental ( gadget -- ) - dup forget-pref-dim dup pref-dim over set-rect-dim - layout ; + dup forget-pref-dim dup pref-dim swap set-rect-dim ; : add-incremental ( gadget incremental -- ) not-in-layout - 2dup (add-gadget) - over prefer-incremental + 2dup incremental-queue push-front + add-gadget ; + +: (add-incremental) ( gadget incremental -- ) 2dup incremental-loc tuck update-cursor - dup prefer-incremental - gadget-parent [ invalidate* ] when* ; + prefer-incremental ; : clear-incremental ( incremental -- ) not-in-layout From 2ace9adafbd4bfe212b34cfb026f4c319c48d835 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Nov 2007 03:21:41 -0500 Subject: [PATCH 12/19] Fix deployment of ui.windows --- extra/ui/windows/windows.factor | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index cd77dc0a98..d4e3770f7b 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -280,10 +280,13 @@ SYMBOL: hWnd mouse-captured? [ release-capture ] when prepare-mouse send-button-up ; +: make-TRACKMOUSEEVENT ( hWnd -- alien ) + "TRACKMOUSEEVENT" [ set-TRACKMOUSEEVENT-hwndTrack ] keep + "TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize ; + : handle-wm-mousemove ( hWnd uMsg wParam lParam -- ) 2nip - over "TRACKMOUSEEVENT" [ set-TRACKMOUSEEVENT-hwndTrack ] keep - "TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize + over make-TRACKMOUSEEVENT TME_LEAVE over set-TRACKMOUSEEVENT-dwFlags 0 over set-TRACKMOUSEEVENT-dwHoverTime TrackMouseEvent drop @@ -387,10 +390,10 @@ SYMBOL: hWnd dup SetForegroundWindow drop SetFocus drop ; -: init-win32-ui +: init-win32-ui ( -- ) "MSG" msg-obj set "Factor-window" malloc-u16-string class-name-ptr set-global - register-wndclassex + register-wndclassex drop GetDoubleClickTime double-click-timeout set-global ; : cleanup-win32-ui ( -- ) From 0c57b8e08680a06b49f8cbd2bda4319f89f0e01a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Nov 2007 03:26:13 -0500 Subject: [PATCH 13/19] Remove debug --- extra/tools/deploy/deploy.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/tools/deploy/deploy.factor b/extra/tools/deploy/deploy.factor index 1b05412227..7c0dabc458 100755 --- a/extra/tools/deploy/deploy.factor +++ b/extra/tools/deploy/deploy.factor @@ -54,7 +54,7 @@ IN: tools.deploy "\"-output-image=" swap "\"" 3append , - ! "-no-stack-traces" , + "-no-stack-traces" , "-no-user-init" , ] { } make ; From a552625ee3eddfeef5dccb64440ecc09dbdb715c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Nov 2007 03:39:34 -0500 Subject: [PATCH 14/19] Fix stream-read-partial on a line-reader --- core/io/io.factor | 0 core/io/streams/lines/lines-tests.factor | 8 ++++++++ core/io/streams/lines/lines.factor | 23 +++++++++++++++++------ 3 files changed, 25 insertions(+), 6 deletions(-) mode change 100644 => 100755 core/io/io.factor mode change 100644 => 100755 core/io/streams/lines/lines-tests.factor mode change 100644 => 100755 core/io/streams/lines/lines.factor diff --git a/core/io/io.factor b/core/io/io.factor old mode 100644 new mode 100755 diff --git a/core/io/streams/lines/lines-tests.factor b/core/io/streams/lines/lines-tests.factor old mode 100644 new mode 100755 index b09711bf60..64dc7bff3b --- a/core/io/streams/lines/lines-tests.factor +++ b/core/io/streams/lines/lines-tests.factor @@ -41,6 +41,14 @@ unit-test 4 swap stream-read ] unit-test +[ + "1234" +] [ + "Hello world\r\n1234" + dup stream-readln drop + 4 swap stream-read-partial +] unit-test + [ CHAR: 1 ] [ diff --git a/core/io/streams/lines/lines.factor b/core/io/streams/lines/lines.factor old mode 100644 new mode 100755 index 3de8bdc7b7..391c602cc3 --- a/core/io/streams/lines/lines.factor +++ b/core/io/streams/lines/lines.factor @@ -32,15 +32,26 @@ M: line-reader stream-readln ( stream -- str ) "\r\n" over delegate stream-read-until handle-readln ; : fix-read ( stream string -- string ) - "\n" ?head [ swap stream-read1 [ add ] when* ] [ nip ] if ; + over line-reader-cr [ + over cr- + "\n" ?head [ + swap stream-read1 [ add ] when* + ] [ nip ] if + ] [ nip ] if ; M: line-reader stream-read - tuck delegate stream-read - over line-reader-cr [ over cr- fix-read ] [ nip ] if ; + tuck delegate stream-read fix-read ; + +M: line-reader stream-read-partial + tuck delegate stream-read-partial fix-read ; : fix-read1 ( stream char -- char ) - dup CHAR: \n = [ drop stream-read1 ] [ nip ] if ; + over line-reader-cr [ + over cr- + dup CHAR: \n = [ + drop stream-read1 + ] [ nip ] if + ] [ nip ] if ; M: line-reader stream-read1 ( stream -- char ) - dup delegate stream-read1 - over line-reader-cr [ over cr- fix-read1 ] [ nip ] if ; + dup delegate stream-read1 fix-read1 ; From 0714bb7a86352fd76ecd8a752c962e05fd6dd7f0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Nov 2007 04:19:50 -0500 Subject: [PATCH 15/19] Revert incomplete changes --- .../ui/gadgets/incremental/incremental.factor | 25 ++++++++----------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/extra/ui/gadgets/incremental/incremental.factor b/extra/ui/gadgets/incremental/incremental.factor index 3e068ead45..a5c7431d36 100755 --- a/extra/ui/gadgets/incremental/incremental.factor +++ b/extra/ui/gadgets/incremental/incremental.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io kernel math namespaces math.vectors ui.gadgets -dlists ; +USING: io kernel math namespaces math.vectors ui.gadgets ; IN: ui.gadgets.incremental ! Incremental layout allows adding lines to panes to be O(1). @@ -15,14 +14,12 @@ IN: ui.gadgets.incremental ! New gadgets are added at ! incremental-cursor gadget-orientation v* -TUPLE: incremental cursor queue ; +TUPLE: incremental cursor ; : ( pack -- incremental ) - dup pref-dim { - set-gadget-delegate - set-incremental-cursor - set-incremental-queue - } incremental construct ; + dup pref-dim + { set-gadget-delegate set-incremental-cursor } + incremental construct ; M: incremental pref-dim* dup gadget-layout-state [ @@ -43,17 +40,17 @@ M: incremental pref-dim* swap set-rect-loc ; : prefer-incremental ( gadget -- ) - dup forget-pref-dim dup pref-dim swap set-rect-dim ; + dup forget-pref-dim dup pref-dim over set-rect-dim + layout ; : add-incremental ( gadget incremental -- ) not-in-layout - 2dup incremental-queue push-front - add-gadget ; - -: (add-incremental) ( gadget incremental -- ) + 2dup (add-gadget) + over prefer-incremental 2dup incremental-loc tuck update-cursor - prefer-incremental ; + dup prefer-incremental + gadget-parent [ invalidate* ] when* ; : clear-incremental ( incremental -- ) not-in-layout From 861cfe7dc2f88990d4da9056bf30dff3792c64fa Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 21 Nov 2007 18:32:32 -0600 Subject: [PATCH 16/19] add unix.linux.fs --- extra/unix/linux/fs/fs.factor | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) create mode 100644 extra/unix/linux/fs/fs.factor diff --git a/extra/unix/linux/fs/fs.factor b/extra/unix/linux/fs/fs.factor new file mode 100644 index 0000000000..02fd357ccd --- /dev/null +++ b/extra/unix/linux/fs/fs.factor @@ -0,0 +1,25 @@ + +USING: alien.syntax ; + +IN: unix.linux.fs + +: MS_RDONLY 1 ; ! Mount read-only. +: MS_NOSUID 2 ; ! Ignore suid and sgid bits. +: MS_NODEV 4 ; ! Disallow access to device special files. +: MS_NOEXEC 8 ; ! Disallow program execution. +: MS_SYNCHRONOUS 16 ; ! Writes are synced at once. +: MS_REMOUNT 32 ; ! Alter flags of a mounted FS. +: MS_MANDLOCK 64 ; ! Allow mandatory locks on an FS. +: S_WRITE 128 ; ! Write on file/directory/symlink. +: S_APPEND 256 ; ! Append-only file. +: S_IMMUTABLE 512 ; ! Immutable file. +: MS_NOATIME 1024 ; ! Do not update access times. +: MS_NODIRATIME 2048 ; ! Do not update directory access times. +: MS_BIND 4096 ; ! Bind directory at different place. + +FUNCTION: int mount +( char* special_file, char* dir, char* fstype, ulong options, void* data ) ; + +! FUNCTION: int umount2 ( char* file, int flags ) ; + +FUNCTION: int umount ( char* file ) ; \ No newline at end of file From 963ae64952ce375237090e199b3bc24f707c96f1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 21 Nov 2007 18:32:51 -0600 Subject: [PATCH 17/19] add unix.linux.swap --- extra/unix/linux/swap/swap.factor | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 extra/unix/linux/swap/swap.factor diff --git a/extra/unix/linux/swap/swap.factor b/extra/unix/linux/swap/swap.factor new file mode 100644 index 0000000000..4cafa5723f --- /dev/null +++ b/extra/unix/linux/swap/swap.factor @@ -0,0 +1,12 @@ + +USING: alien.syntax ; + +IN: unix.linux.swap + +: SWAP_FLAG_PREFER HEX: 8000 ; ! Set if swap priority is specified. +: SWAP_FLAG_PRIO_MASK HEX: 7fff ; +: SWAP_FLAG_PRIO_SHIFT 0 ; + +FUNCTION: int swapon ( char* path, int flags ) ; + +FUNCTION: int swapoff ( char* path ) ; \ No newline at end of file From 6d64c460c31fcbfb74753c417b91a69b5c9d8208 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 21 Nov 2007 18:33:39 -0600 Subject: [PATCH 18/19] Add ,u and `{ to bake --- extra/bake/bake.factor | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor index 437a42d546..d038e81394 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -22,6 +22,10 @@ C: splice-quot ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: ,u ( seq -- seq ) unclip building get push ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SYMBOL: exemplar : reset-building ( -- ) 1024 building set ; @@ -35,6 +39,7 @@ DEFER: bake : bake-item ( item -- ) { { [ dup \ , = ] [ drop , ] } { [ dup \ % = ] [ drop % ] } + { [ dup \ ,u = ] [ drop ,u ] } { [ dup insert-quot? ] [ insert-quot-expr call , ] } { [ dup splice-quot? ] [ splice-quot-expr call % ] } { [ dup integer? ] [ , ] } @@ -52,4 +57,5 @@ DEFER: bake ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing \ No newline at end of file +: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing + From 1143f52f25ac9af286ee4259dc38cdcffec18715 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 21 Nov 2007 18:34:25 -0600 Subject: [PATCH 19/19] Activate swap and mount root fs in raptor --- extra/raptor/config.factor | 15 ++++++++++++++- extra/raptor/raptor.factor | 13 ++++++++++++- 2 files changed, 26 insertions(+), 2 deletions(-) diff --git a/extra/raptor/config.factor b/extra/raptor/config.factor index 386ddf7744..ecdbf98f17 100644 --- a/extra/raptor/config.factor +++ b/extra/raptor/config.factor @@ -26,6 +26,14 @@ IN: raptor configure-route ] networking-hook set-global +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Filesystems +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +"/dev/hda1" root-device set-global + +{ "/dev/hda5" } swap-devices set-global + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! boot-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -43,7 +51,12 @@ IN: raptor "mountdevsubfs" start-service "module-init-tools" start-service "procps.sh" start-service - "checkroot.sh" start-service + + ! "checkroot.sh" start-service + + activate-swap + mount-root + "mtab" start-service "checkfs.sh" start-service "mountall.sh" start-service diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index 7e32463ea1..e6f960cd8d 100644 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -33,7 +33,7 @@ SYMBOL: networking-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-wait ; +: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-args-wait ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -46,6 +46,17 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +USING: unix.linux.swap unix.linux.fs ; + +SYMBOL: root-device +SYMBOL: swap-devices + +: activate-swap ( -- ) swap-devices get [ 0 swapon drop ] each ; + +: mount-root ( -- ) root-device get "/" "ext3" MS_REMOUNT f mount drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : start-networking ( -- ) networking-hook get call ; : boot ( -- ) boot-hook get call ;