guard pages

TODO.FACTOR.txt

@@ -26,7 +26,7 @@
 + tests:
 
 - java factor: equal numbers have non-equal hashcodes!
-- sbuf=
+- sbuf-hashcode
 - vector-hashcode
 - clone-sbuf
 - FactorLib.equal() not very good
@@ -78,8 +78,8 @@ ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable
 
 + misc:
 
+- telnetd: needs own history
 - compiled stack traces broken
-- should i -i inf -inf be parsing words?
 - namespace clone drops static var bindings
 - ditch map
 - ditch expand
@@ -89,7 +89,6 @@ ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable
 + httpd:
 
 - multitasking
-- inspect: always use inspect/ URL prefix, not responder name var
 - httpd: don't flush so much
 - log with date
 - log user agent

library/cross-compiler.factor

@@ -59,6 +59,7 @@ DEFER: size-of
 IN: strings
 DEFER: str=
 DEFER: str-hashcode
+DEFER: sbuf=
 
 IN: io-internals
 DEFER: open-file
@@ -124,6 +125,7 @@ IN: cross-compiler
         set-sbuf-nth
         sbuf-append
         sbuf>str
+        sbuf=
         number?
         >fixnum
         >bignum

library/httpd/html.factor

@@ -64,11 +64,8 @@ USE: url-encoding
     #! Wrap a string in an HTML tag.
     <% dupd opening-tag swap % closing-tag %> ;
 
-: responder-link% ( -- )
-    "/" % "responder" get % "/" % ;
-
 : link-attrs ( link -- attrs )
-    <% "href=\"" % responder-link% % "\"" % %> ;
+    <% "href=\"/inspect/" % % "\"" % %> ;
 
 : link-tag ( string link -- string )
     "a" swap link-attrs html-tag ;

library/platform/jvm/kernel.factor

@@ -58,14 +58,14 @@ IN: kernel
     [ ] "java.lang.Object" "getClass" jinvoke
     [ ] "java.lang.Class" "getName" jinvoke ;
 
-: clone ( obj -- obj )
-    [ ] "factor.PublicCloneable" "clone" jinvoke ;
-
 : is ( obj class -- boolean )
     ! Like "instanceof" in Java.
     [ "java.lang.Object" ] "java.lang.Class" "isInstance"
     jinvoke ;
 
+: clone ( obj -- obj )
+    [ ] "factor.PublicCloneable" "clone" jinvoke ;
+
 : toplevel ( -- )
     interpreter
     [ ] "factor.FactorInterpreter" "topLevel" jinvoke ;

library/platform/native/kernel.factor

@@ -61,6 +61,7 @@ USE: unparser
             [ cons? ] [ cons= ]
             [ vector? ] [ vector= ]
             [ string? ] [ str= ]
+            [ sbuf? ] [ sbuf= ]
             [ drop t ] [ 2drop f ]
         ] cond
     ] ifte ;

library/platform/native/parse-syntax.factor

@@ -132,7 +132,7 @@ USE: unparser
     <% parse-string "pos" get %> swap "pos" set parsed ; parsing
 
 ! Char literal
-: CHAR: ( -- ) skip-blank next-ch parse-ch parsed ; parsing
+: CHAR: ( -- ) next-word-ch parse-ch parsed ; parsing
 
 ! Complex literal
 : #{

library/platform/native/parser.factor

@@ -67,31 +67,54 @@ USE: unparser
 : ch ( -- ch ) "pos" get "line" get str-nth ;
 : advance ( -- ) "pos" succ@ ;
 
-: ch-blank? ( -- ? ) end? [ f ] [ ch blank? ] ifte ;
+: skip ( n line quot -- n )
-: skip-blank ( -- ) [ ch-blank? ] [ advance ] while ;
+    #! Find the next character that satisfies the quotation,
-: ch-word? ( -- ? ) end? [ f ] [ ch blank? not ] ifte ;
+    #! which should have stack effect ( ch -- ? ).
-: skip-word ( -- ) [ ch-word? ] [ advance ] while ;
+    >r 2dup str-length < [
+        2dup str-nth r> dup >r call [
+            r> 2drop
+        ] [
+            >r succ r> r> skip
+        ] ifte
+    ] [
+        r> drop nip str-length
+    ] ifte ;
 
-: ch-dispatch? ( -- ? )
+: skip-blank ( n line -- n )
+    [ blank? not ] skip ;
+
+: skip-word ( n line -- n )
+    [ blank? ] skip ;
+
+: denotation? ( ch -- ? )
     #! Hard-coded for now. Make this customizable later.
-    #! A 'dispatch' is a character that is treated as its
+    #! A 'denotation' is a character that is treated as its
     #! own word, eg:
     #!
     #! "hello world"
     #!
     #! Will call the parsing word ".
-    ch "\"" str-contains? ;
+    "\"" str-contains? ;
 
-: (scan) ( -- start end )
+: (scan) ( n line -- start end )
-    skip-blank "pos" get
+    dup >r skip-blank dup r>
-    end? [
+    2dup str-length < [
-        dup
+        2dup str-nth denotation? [
+            drop succ
+        ] [
+            skip-word
+        ] ifte
     ] [
-        ch-dispatch? [ advance ] [ skip-word ] ifte "pos" get
+        drop
     ] ifte ;
 
-: scan ( -- str )
+: scan ( -- token )
-    (scan) 2dup = [ 2drop f ] [ "line" get substring ] ifte ;
+    "pos" get "line" get dup >r (scan) dup "pos" set
+    2dup = [
+        r> 3drop f
+    ] [
+        r> substring
+    ] ifte ;
 
 : parse-word ( str -- obj )
     dup "use" get search dup [
@@ -146,3 +169,6 @@ USE: unparser
 
 : next-ch ( -- ch )
     end? [ "Unexpected EOF" throw ] [ ch advance ] ifte ;
+
+: next-word-ch ( -- ch )
+    "pos" get "line" get skip-blank "pos" set next-ch ;

library/sbuf.factor

@@ -34,6 +34,9 @@ USE: namespaces
 USE: strings
 USE: stack
 
+: str>sbuf ( str -- sbuf )
+    dup str-length <sbuf> tuck sbuf-append ;
+
 : string-buffer-size 80 ;
 
 : <% ( -- )

native/factor.c

@@ -12,7 +12,7 @@ int main(int argc, char** argv)
 
 	init_arena(DEFAULT_ARENA);
 	load_image(argv[1]);
-	init_environment();
+	init_stacks();
 	init_io();
 	run();
 

native/gc.c

@@ -115,9 +115,8 @@ void copy_roots(void)
 {
 	int i;
 
-	CELL ds_depth = env.ds - UNTAG(env.ds_bot);
+	CELL ptr;
-	CELL cs_depth = env.cs - UNTAG(env.cs_bot);
+
-	
 	gc_debug("collect_roots",scan);
 	/* these three must be the first in the heap */
 	copy_object(&empty);
@@ -127,13 +126,15 @@ void copy_roots(void)
 	copy_object(&T);
 	gc_debug("t",T);
 	copy_object(&env.dt);
-	copy_object(&env.ds_bot);
-	env.ds = UNTAG(env.ds_bot) + ds_depth;
-	copy_object(&env.cs_bot);
-	env.cs = UNTAG(env.cs_bot) + cs_depth;
 	copy_object(&env.cf);
 	copy_object(&env.boot);
-	
+
+	for(ptr = env.ds_bot; ptr < env.ds; ptr += CELLS)
+		copy_object((void*)ptr);
+
+	for(ptr = env.cs_bot; ptr < env.cs; ptr += CELLS)
+		copy_object((void*)ptr);
+
 	for(i = 0; i < USER_ENV; i++)
 		copy_object(&env.user[i]);
 }

native/memory.c

@@ -4,20 +4,20 @@
 under/overflow. size must be a multiple of the page size */
 void* alloc_guarded(CELL size)
 {
-	char* stack = mmap((void*)0,PAGE_SIZE + STACK_SIZE + PAGE_SIZE,
+	char* array = mmap((void*)0,PAGE_SIZE + size + PAGE_SIZE,
 		PROT_READ | PROT_WRITE,MAP_ANON,-1,0);
 
-	if(mprotect(stack,PAGE_SIZE,PROT_NONE) == -1)
+	if(mprotect(array,PAGE_SIZE,PROT_NONE) == -1)
-		fatal_error("Cannot allocate low guard page",(CELL)stack);
+		fatal_error("Cannot allocate low guard page",(CELL)array);
 
-	if(mprotect(stack + PAGE_SIZE + STACK_SIZE,PAGE_SIZE,PROT_NONE) == -1)
+	if(mprotect(array + PAGE_SIZE + size,PAGE_SIZE,PROT_NONE) == -1)
-		fatal_error("Cannot allocate high guard page",(CELL)stack);
+		fatal_error("Cannot allocate high guard page",(CELL)array);
 
-	/* return bottom of actual stack */
+	/* return bottom of actual array */
-	return stack + PAGE_SIZE;
+	return array + PAGE_SIZE;
 }
 
-static ZONE* zalloc(CELL size)
+ZONE* zalloc(CELL size)
 {
 	ZONE* z = (ZONE*)malloc(sizeof(ZONE));
 	if(z == 0)

native/memory.h

@@ -10,6 +10,8 @@ ZONE* z2;
 ZONE* active; /* either z1 or z2 */
 ZONE* prior; /* if active==z1, z2; if active==z2, z1 */
 
+void* alloc_guarded(CELL size);
+ZONE* zalloc(CELL size);
 void init_arena(CELL size);
 void flip_zones();
 

native/run.c

@@ -7,15 +7,6 @@ void clear_environment(void)
 		env.user[i] = 0;
 }
 
-void init_environment(void)
-{
-	env.ds_bot = tag_object(array(STACK_SIZE,empty));
-	reset_datastack();
-	env.cs_bot = tag_object(array(STACK_SIZE,empty));
-	reset_callstack();
-	env.cf = env.boot;
-}
-
 #define EXECUTE(w) ((XT)(w->xt))()
 
 void run(void)
@@ -27,8 +18,6 @@ void run(void)
 	
 	for(;;)
 	{
-		check_stacks();
-
 		if(env.cf == F)
 		{
 			if(cpeek() == empty)

native/run.h

@@ -17,11 +17,11 @@ typedef struct {
 	CELL dt;
 	/* TAGGED currently executing quotation */
 	CELL cf;
-	/* TAGGED pointer to datastack bottom */
+	/* raw pointer to datastack bottom */
 	CELL ds_bot;
 	/* raw pointer to datastack top */
 	CELL ds;
-	/* TAGGED pointer to callstack bottom */
+	/* raw pointer to callstack bottom */
 	CELL cs_bot;
 	/* raw pointer to callstack top */
 	CELL cs;
@@ -36,7 +36,6 @@ typedef struct {
 ENV env;
 
 void clear_environment(void);
-void init_environment(void);
 void check_non_empty(CELL cell);
 
 INLINE CELL dpop(void)

native/sbuf.c

@@ -124,7 +124,7 @@ void primitive_sbuf_to_string(void)
 bool sbuf_eq(SBUF* s1, SBUF* s2)
 {
 	if(s1->top == s2->top)
-		return string_compare_head(s1->string,s2->string,s1->top);
+		return (string_compare_head(s1->string,s2->string,s1->top) == 0);
 	else
 		return false;
 }

native/stack.c

@@ -2,16 +2,25 @@
 
 void reset_datastack(void)
 {
-	env.ds = UNTAG(env.ds_bot) + sizeof(ARRAY);
+	env.ds = env.ds_bot;
 	env.dt = empty;
 }
 
 void reset_callstack(void)
 {
-	env.cs = UNTAG(env.cs_bot) + sizeof(ARRAY);
+	env.cs = env.cs_bot;
 	cpush(empty);
 }
 
+void init_stacks(void)
+{
+	env.ds_bot = (CELL)alloc_guarded(STACK_SIZE);
+	reset_datastack();
+	env.cs_bot = (CELL)alloc_guarded(STACK_SIZE);
+	reset_callstack();
+	env.cf = env.boot;
+}
+
 void primitive_drop(void)
 {
 	check_non_empty(env.dt);
@@ -99,12 +108,12 @@ void primitive_from_r(void)
 	env.dt = cpop();
 }
 
-VECTOR* stack_to_vector(CELL top, CELL bottom)
+VECTOR* stack_to_vector(CELL bottom, CELL top)
 {
-	CELL depth = (top - bottom - sizeof(ARRAY)) / CELLS - 1;
+	CELL depth = (top - bottom) / CELLS - 1;
 	VECTOR* v = vector(depth);
 	ARRAY* a = v->array;
-	memcpy(a + 1,(void*)(bottom + sizeof(ARRAY) + CELLS),depth * CELLS);
+	memcpy(a + 1,(char*)bottom + CELLS,depth * CELLS);
 	v->top = depth;
 	return v;
 }
@@ -112,19 +121,19 @@ VECTOR* stack_to_vector(CELL top, CELL bottom)
 void primitive_datastack(void)
 {
 	dpush(env.dt);
-	env.dt = tag_object(stack_to_vector(env.ds,UNTAG(env.ds_bot)));
+	env.dt = tag_object(stack_to_vector(env.ds_bot,env.ds));
 }
 
 void primitive_callstack(void)
 {
 	dpush(env.dt);
-	env.dt = tag_object(stack_to_vector(env.cs,UNTAG(env.cs_bot)));
+	env.dt = tag_object(stack_to_vector(env.cs_bot,env.cs));
 }
 
 /* Returns top of stack */
 CELL vector_to_stack(VECTOR* vector, CELL bottom)
 {
-	CELL start = bottom + sizeof(ARRAY) + CELLS;
+	CELL start = bottom + CELLS;
 	CELL len = vector->top * CELLS;
 	memcpy((void*)start,vector->array + 1,len);
 	return start + len;
@@ -132,12 +141,12 @@ CELL vector_to_stack(VECTOR* vector, CELL bottom)
 
 void primitive_set_datastack(void)
 {
-	env.ds = vector_to_stack(untag_vector(env.dt),UNTAG(env.ds_bot));
+	env.ds = vector_to_stack(untag_vector(env.dt),env.ds_bot);
 	env.dt = dpop();
 }
 
 void primitive_set_callstack(void)
 {
-	env.cs = vector_to_stack(untag_vector(env.dt),UNTAG(env.cs_bot));
+	env.cs = vector_to_stack(untag_vector(env.dt),env.cs_bot);
 	env.dt = dpop();
 }

native/stack.h

@@ -1,22 +1,9 @@
-#define STACK_UNDERFLOW_CHECKING
-
 #define STACK_UNDERFLOW(stack,bot) ((stack) < UNTAG(bot) + sizeof(ARRAY))
 #define STACK_OVERFLOW(stack,bot) ((stack) >= UNTAG(bot) + object_size(bot))
 
-INLINE void check_stacks(void)
-{
-
-#ifdef STACK_UNDERFLOW_CHECKING
-	if(STACK_OVERFLOW(env.ds,env.ds_bot))
-		general_error(ERROR_OVERFLOW,F);
-	if(STACK_OVERFLOW(env.cs,env.cs_bot))
-		general_error(ERROR_OVERFLOW,F);
-#endif
-
-}
-
 void reset_datastack(void);
 void reset_callstack(void);
+void init_stacks(void);
 
 void primitive_drop(void);
 void primitive_dup(void);
@@ -28,7 +15,7 @@ void primitive_tuck(void);
 void primitive_rot(void);
 void primitive_to_r(void);
 void primitive_from_r(void);
-VECTOR* stack_to_vector(CELL top, CELL bottom);
+VECTOR* stack_to_vector(CELL bottom, CELL top);
 void primitive_datastack(void);
 void primitive_callstack(void);
 CELL vector_to_stack(VECTOR* vector, CELL bottom);

native/string.c

@@ -136,8 +136,8 @@ FIXNUM string_compare(STRING* s1, STRING* s2)
 
 void primitive_string_compare(void)
 {
-	STRING* s1 = untag_string(env.dt);
+	STRING* s2 = untag_string(env.dt);
-	STRING* s2 = untag_string(dpop());
+	STRING* s1 = untag_string(dpop());
 
 	env.dt = tag_fixnum(string_compare(s1,s2));
 }