httpd responder changes, fix gc race

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index d31834f077ab73ed6ada9499613bbfc76e99d1e9..0b34eb2c7a7a126d0f59311aa940018ae1852aea 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -22,15 +22,19 @@ FFI:
 \r
 - clean up listener's action popups\r
 - jedit ==> jedit-word, jedit takes a file name\r
-- introduce ifte* and ?str-head/?str-tail where appropriate\r
 - namespace clone drops static var bindings\r
+- add a socket timeout\r
+- fix error postoning -- not all errors thrown by i/o code are\r
+  postponed\r
+- sbuf-hashcode\r
+- vector-hashcode\r
+- some way to run httpd from command line\r
 \r
 + bignums:\r
 \r
 - move some s48_ functions into bignum.c\r
 - remove unused functions\r
 \r
-- add a socket timeout\r
 - >lower, >upper for strings\r
 - accept multi-line input in listener\r
 \r
@@ -75,12 +79,6 @@ FFI:
 \r
 + native:\r
 \r
-- fix error postoning -- not all errors thrown by i/o code are\r
-  postponed\r
-- sbuf-hashcode\r
-- vector-hashcode\r
-- irc: stack underflow?\r
-- gc call in the middle of some ops might affect callstack\r
 - better i/o scheduler\r
 \r
 + JVM compiler:\r
@@ -98,7 +96,6 @@ FFI:
 \r
 + misc:\r
 \r
-- some way to run httpd from command line\r
 - don't rehash strings on every startup\r
 - 'cascading' styles\r
 - ditch expand\r
@@ -106,7 +103,6 @@ FFI:
 \r
 + httpd:\r
 \r
-- 'default responder' for when we go to root\r
 - wiki responder:\r
   - port to native\r
   - text styles\r

diff --git a/library/httpd/default-responders.factor b/library/httpd/default-responders.factor
index 7859b84efb2d01ade77829ac17ea99badd215e06..320eac1cde9b0960b9df4cf465661cf861bc9f29 100644 (file)
--- a/library/httpd/default-responders.factor
+++ b/library/httpd/default-responders.factor
@@ -75,6 +75,8 @@ global [ <namespace> "httpd-responders" set ] bind
     [ resource-responder ] "get" set
 ] extend add-responder
 
+"file" set-default-responder
+
 !        <responder> [
 !            "wiki" "responder" set
 !            [ wiki-get-responder ] "get" set

diff --git a/library/httpd/responder.factor b/library/httpd/responder.factor
index 17d7794ab170acd260feecf5d8a776b755f8c47a..f045374ed1421033e2cede87567cb0ff5de12ada 100644 (file)
--- a/library/httpd/responder.factor
+++ b/library/httpd/responder.factor
@@ -76,25 +76,44 @@ USE: strings
         "404" "httpd-responders" get get*
     ] unless* ;
 
+: default-responder ( -- responder )
+    "default" get-responder ;
+
+: set-default-responder ( name -- )
+    get-responder "default" "httpd-responders" get set* ;
+
 : responder-argument ( argument -- argument )
     dup f-or-"" [ drop "default-argument" get ] when ;
 
 : call-responder ( method argument responder -- )
     [ responder-argument swap get call ] bind ;
 
-: trim-/ ( url -- url )
-    #! Trim a leading /, if there is one.
-    "/" ?str-head drop ;
+: serve-default-responder ( method url -- )
+    default-responder call-responder ;
+
+: serve-explicit-responder ( method url -- )
+    "/" split1 dup [
+        swap get-responder call-responder
+    ] [
+        ! Just a responder name by itself
+        drop "request" get "/" cat2 redirect drop
+    ] ifte ;
 
 : log-responder ( url -- )
     "Calling responder " swap cat2 log ;
 
+: trim-/ ( url -- url )
+    #! Trim a leading /, if there is one.
+    "/" ?str-head drop ;
+
 : serve-responder ( method url -- )
-    dup log-responder trim-/ "/" split1 dup [
-        swap get-responder call-responder
+    #! Responder URLs come in two forms:
+    #! /foo/bar... - default-responder used
+    #! /responder/foo/bar - responder foo, argument bar
+    dup log-responder trim-/ "responder/" ?str-head [
+        serve-explicit-responder
     ] [
-        ! Just a responder name by itself
-        drop "/" swap "/" cat3 redirect drop
+        serve-default-responder
     ] ifte ;
 
 : no-such-responder ( -- )

diff --git a/native/memory.c b/native/memory.c
index d44b2b33f669e8df727c7259ca38dcae6b462dbf..2dedc4cce41d956f88621fcd7481eb85497a0398 100644 (file)
--- a/native/memory.c
+++ b/native/memory.c
@@ -36,6 +36,7 @@ void init_arena(CELL size)
        init_zone(&prior,size);
        allot_profiling = false;
        gc_in_progress = false;
+       gc_protect = false;
 }
 
 void allot_profile_step(CELL a)
@@ -59,21 +60,21 @@ void allot_profile_step(CELL a)
 
 void check_memory(void)
 {
-       if(active.here > active.alarm)
-       {
-               if(active.here > active.limit)
-               {
-                       fprintf(stderr,"Out of memory\n");
-                       fprintf(stderr,"active.base  = %ld\n",active.base);
-                       fprintf(stderr,"active.here  = %ld\n",active.here);
-                       fprintf(stderr,"active.limit = %ld\n",active.limit);
-                       fflush(stderr);
-                       exit(1);
-               }
+       if(gc_protect)
+               return;
 
-               /* Execute the 'garbage-collection' word */
-               call(userenv[GC_ENV]);
+       if(active.here > active.limit)
+       {
+               fprintf(stderr,"Out of memory\n");
+               fprintf(stderr,"active.base  = %ld\n",active.base);
+               fprintf(stderr,"active.here  = %ld\n",active.here);
+               fprintf(stderr,"active.limit = %ld\n",active.limit);
+               fflush(stderr);
+               exit(1);
        }
+
+       /* Execute the 'garbage-collection' word */
+       call(userenv[GC_ENV]);
 }
 
 void flip_zones()

diff --git a/native/memory.h b/native/memory.h
index 27af3e8059d7a18a8667beea7ddcecb14eed5f67..fd4ba1460664632b056dd4e8ab1ea248b0e184ca 100644 (file)
--- a/native/memory.h
+++ b/native/memory.h
@@ -10,6 +10,9 @@ ZONE prior;
 
 bool allot_profiling;
 
+/* we can temporarily disable GC */
+bool gc_protect;
+
 void* alloc_guarded(CELL size);
 void init_zone(ZONE* zone, CELL size);
 void init_arena(CELL size);
@@ -29,7 +32,8 @@ INLINE void* allot(CELL a)
        active.here += align8(a);
        if(allot_profiling)
                allot_profile_step(align8(a));
-       check_memory();
+       if(active.here > active.alarm)
+               check_memory();
        return (void*)h;
 }
 

diff --git a/native/stack.c b/native/stack.c
index 453768e1bd64595ffedc7361f940e87220699a2f..5079d5a24b0eeb290f27cb4c1796cbdb815b5cb7 100644 (file)
--- a/native/stack.c
+++ b/native/stack.c
@@ -101,7 +101,10 @@ void primitive_datastack(void)
 
 void primitive_callstack(void)
 {
+       /* we don't want gc word to end up on callstack. */
+       gc_protect = true;
        dpush(tag_object(stack_to_vector(cs_bot,cs)));
+       gc_protect = false;
 }
 
 /* Returns top of stack */