Merge branch 'master' of git://factorcode.org/git/factor

extra/bake/bake.factor

@@ -1,6 +1,6 @@
 
-USING: kernel parser namespaces quotations vectors strings
+USING: kernel parser namespaces quotations arrays vectors strings
-sequences assocs tuples math combinators ;
+       sequences assocs tuples math combinators ;
 
 IN: bake
 
@@ -22,6 +22,10 @@ C: <splice-quot> splice-quot
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: ,u ( seq -- seq ) unclip building get push ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 SYMBOL: exemplar
 
 : reset-building ( -- ) 1024 <vector> 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? ]     [ , ] }
@@ -49,3 +54,8 @@ DEFER: bake
 
 : bake ( seq -- seq )
   [ reset-building save-exemplar bake-items finish-baking ] with-scope ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing
+

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,20 @@ IN: raptor
   configure-route
 ] networking-hook set-global
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Filesystems
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+"/dev/hda1"     root-device     set-global
+
+{ "/dev/hda5" } swap-devices	set-global
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! boot-hook
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 [
+                                    start-wait-loop
 
   ! rcS.d
 
@@ -38,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
@@ -76,11 +94,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 +132,8 @@ IN: raptor
   "reboot" 			    stop-service
 ] reboot-hook set-global
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! shutdown-hook
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 [

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> 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         <when> [ cron-jobs-hourly  get call ] schedule
+  { 25 } { 6 } f f f     <when> [ cron-jobs-daily   get call ] schedule
+  { 47 } { 6 } f f { 7 } <when> [ cron-jobs-weekly  get call ] schedule
+  { 52 } { 6 } { 1 } f f <when> [ cron-jobs-monthly get call ] schedule ;
+

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 ;
-    
-: 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 ;
-
-: 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         <when> [ cron-hourly  ] schedule
+    "/etc/cron.daily/apt"             run-script
-  { 25 } { 6 } f f f     <when> [ cron-daily   ] schedule
+    "/etc/cron.daily/aptitude"	      run-script
-  { 47 } { 6 } f f { 7 } <when> [ cron-weekly  ] schedule
+    "/etc/cron.daily/bsdmainutils"    run-script
-  { 52 } { 6 } { 1 } f f <when> [ cron-monthly ] schedule ;
+    "/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
+    
+[
+  "/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
+
+[
+  "/etc/cron.monthly/scrollkeeper" run-script
+  "/etc/cron.monthly/standard"     run-script
+] cron-jobs-monthly set-global

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 -- )
+: getty ( tty -- ) `{ "/sbin/getty" "38400" , } fork-exec-args-wait ;
-  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 ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -40,16 +41,19 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex
        listener ;
 
 : tty-listener ( tty -- )
-  [ <file-reader> <line-reader>  ]
+  [ <file-reader> ] [ <file-writer> ] bi <duplex-stream>
-  [ <file-writer> <plain-writer> ]
+  [ listener ] with-stream ;
-  bi <duplex-stream> [ listener ] with-stream ;
 
-: forever ( quot -- ) [ call ] [ forever ] bi ;
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: start-listeners ( -- )
+USING: unix.linux.swap unix.linux.fs ;
-  [ [ "/dev/tty2" tty-listener ] forever ] in-thread
+
-  [ [ "/dev/tty3" tty-listener ] forever ] in-thread
+SYMBOL: root-device
-  [ [ "/dev/tty4" tty-listener ] forever ] in-thread ;
+SYMBOL: swap-devices
+
+: activate-swap ( -- ) swap-devices get [ 0 swapon drop ] each ;
+
+: mount-root ( -- ) root-device get "/" "ext3" MS_REMOUNT f mount drop ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -60,3 +64,4 @@ USING: io io.files io.streams.lines io.streams.plain io.streams.duplex
 : shutdown ( -- ) shutdown-hook get call ;
 
 MAIN: boot
+

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

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 ) ;

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 ) ;

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 -- )
+! KEY | VALUE
-  dup "int" <c-object> WNOHANG waitpid
+! -----------
-  0 = [ 100 sleep wait-for-pid ] [ drop ] if ;
+! 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 <int> 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 ;

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 ) ;

extra/webapps/article-manager/furnace/article.furnace

@@ -1,4 +1,4 @@
-<% USING: kernel io http.server namespaces sequences math html.elements random furnace webapps.article-manager webapps.article-manager.database ; %>
+<% USING: kernel io http.server namespaces sequences math html.elements random furnace webapps.article-manager webapps.article-manager.database html.elements ; %>
     <div id="banner"><h1><% "arg1" get second article-title write %></h1></div>
     <% f "navigation" render-template %>
     <div id="article">

extra/webapps/article-manager/furnace/tag.furnace

@@ -1,4 +1,4 @@
-<% USING: kernel io http.server namespaces sequences math html furnace webapps.article-manager.database webapps.article-manager ; %>
+<% USING: kernel io http.server namespaces sequences math html furnace webapps.article-manager.database webapps.article-manager html.elements ; %>
 
 	<div id="banner"><h1><% "arg1" get second tag-title write %></h1></div>
     <% f "navigation" render-template %>

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)