steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guard pages

cvs before-env-dt-removal
Slava Pestov 2004-08-12 06:13:43 +00:00
parent 2a74ca3f90
commit 3169e03624
18 changed files with 99 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
TODO.FACTOR.txt
View File

@ -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

2
library/cross-compiler.factor
View File

@ -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

5
library/httpd/html.factor
View File

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

6
library/platform/jvm/kernel.factor
View File

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

1
library/platform/native/kernel.factor
View File

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

2
library/platform/native/parse-syntax.factor
View File

@ -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
: #{

54
library/platform/native/parser.factor
View File

@ -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-blank ( -- ) [ ch-blank? ] [ advance ] while ;
: ch-word? ( -- ? ) end? [ f ] [ ch blank? not ] ifte ;
: skip-word ( -- ) [ ch-word? ] [ advance ] while ;
: skip ( n line quot -- n )
#! Find the next character that satisfies the quotation,
#! which should have stack effect ( ch -- ? ).
>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 )
skip-blank "pos" get
end? [
dup
: (scan) ( n line -- start end )
dup >r skip-blank dup r>
2dup str-length < [
2dup str-nth denotation? [
drop succ
] [
skip-word
] ifte
] [
ch-dispatch? [ advance ] [ skip-word ] ifte "pos" get
drop
] ifte ;
: scan ( -- str )
(scan) 2dup = [ 2drop f ] [ "line" get substring ] ifte ;
: scan ( -- token )
"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 ;

3
library/sbuf.factor
View File

@ -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 ;
: <% ( -- )

2
native/factor.c
View File

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

13
native/gc.c
View File

@ -115,8 +115,7 @@ void copy_roots(void)
{
int i;
CELL ds_depth = env.ds - UNTAG(env.ds_bot);
CELL cs_depth = env.cs - UNTAG(env.cs_bot);
CELL ptr;
gc_debug("collect_roots",scan);
/* these three must be the first in the heap */
@ -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]);
}

16
native/memory.c
View File

@ -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)
fatal_error("Cannot allocate low guard page",(CELL)stack);
if(mprotect(array,PAGE_SIZE,PROT_NONE) == -1)
fatal_error("Cannot allocate low guard page",(CELL)array);
if(mprotect(stack + PAGE_SIZE + STACK_SIZE,PAGE_SIZE,PROT_NONE) == -1)
fatal_error("Cannot allocate high guard page",(CELL)stack);
if(mprotect(array + PAGE_SIZE + size,PAGE_SIZE,PROT_NONE) == -1)
fatal_error("Cannot allocate high guard page",(CELL)array);
/* return bottom of actual stack */
return stack + PAGE_SIZE;
/* return bottom of actual array */
return array + PAGE_SIZE;
}
static ZONE* zalloc(CELL size)
ZONE* zalloc(CELL size)
{
ZONE* z = (ZONE*)malloc(sizeof(ZONE));
if(z == 0)

2
native/memory.h
View File

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

11
native/run.c
View File

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

5
native/run.h
View File

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

2
native/sbuf.c
View File

@ -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;
}

29
native/stack.c
View File

@ -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();
}

17
native/stack.h
View File

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

4
native/string.c
View File

@ -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(dpop());
STRING* s2 = untag_string(env.dt);
STRING* s1 = untag_string(dpop());
env.dt = tag_fixnum(string_compare(s1,s2));
}