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

More allot_* work

slava 2006-10-31 20:48:34 +00:00
parent 65128e6af3
commit b116ab3c25
9 changed files with 61 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
TODO.FACTOR.txt
View File

@ -11,6 +11,7 @@
+ ui:
- input operation: copy
- docs: mention that 'like' may destroy the underlying sequence
- live search: timer delay would be nice
- menu should stay up if mouse button released
@ -76,6 +77,7 @@
+ misc:
- faster apropos
- growable data heap
- minor GC takes too long now, we should card mark code heap
- buffer-ptr should be an alien

2
library/io/files.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: io
USING: hashtables kernel math memory namespaces sequences
strings styles ;
strings styles arrays ;
! Words for accessing filesystem meta-data.

19
vm/data_gc.h
View File

@ -180,13 +180,14 @@ void garbage_collection(CELL gen, bool code_gc);
#define REGISTER_ROOT(obj) rpush(obj)
#define UNREGISTER_ROOT(obj) obj = rpop()
/* WARNING: only call this from a context where all local variables
are also reachable via the GC roots, or gc_off is set to true. */
INLINE void maybe_gc(CELL size)
{
if(nursery.here + size > nursery.limit)
garbage_collection(NURSERY,false);
}
#define REGISTER_ARRAY(obj) rpush(tag_object(obj))
#define UNREGISTER_ARRAY(obj) obj = untag_array_fast(rpop())
#define REGISTER_STRING(obj) rpush(tag_object(obj))
#define UNREGISTER_STRING(obj) obj = untag_string_fast(rpop())
#define REGISTER_C_STRING(obj) rpush(tag_object(((F_ARRAY *)obj) - 1))
#define UNREGISTER_C_STRING(obj) obj = ((char*)(untag_array_fast(rpop()) + 1))
INLINE void *allot_zone(ZONE *z, CELL a)
{
@ -199,7 +200,9 @@ INLINE void *allot_zone(ZONE *z, CELL a)
INLINE void *allot(CELL a)
{
maybe_gc(a);
if(nursery.here + a > nursery.limit)
garbage_collection(NURSERY,false);
return allot_zone(&nursery,a);
}

11
vm/io.c
View File

@ -26,12 +26,11 @@ void io_error(void)
void primitive_fopen(void)
{
char *path, *mode;
FILE* file;
maybe_gc(0);
mode = unbox_char_string();
path = unbox_char_string();
file = fopen(path,mode);
char *mode = unbox_char_string();
REGISTER_C_STRING(mode);
char *path = unbox_char_string();
UNREGISTER_C_STRING(mode);
FILE *file = fopen(path,mode);
if(file == NULL)
io_error();
box_alien((CELL)file);

33
vm/math.c
View File

@ -401,7 +401,6 @@ void primitive_bignum_greatereq(void)
void primitive_bignum_not(void)
{
maybe_gc(0);
drepl(tag_bignum(s48_bignum_bitwise_not(
untag_bignum_fast(dpeek()))));
}
@ -512,13 +511,9 @@ void primitive_to_float(void)
void primitive_str_to_float(void)
{
F_STRING* str;
char *c_str, *end;
double f;
maybe_gc(sizeof(F_FLOAT));
str = untag_string(dpeek());
F_STRING *str = untag_string(dpeek());
/* if the string has nulls or chars > 255, its definitely not a float */
if(!check_string(str,sizeof(char)))
@ -538,71 +533,67 @@ void primitive_str_to_float(void)
void primitive_float_to_str(void)
{
char tmp[33];
maybe_gc(sizeof(F_FLOAT));
snprintf(tmp,32,"%.16g",to_float(dpop()));
snprintf(tmp,32,"%.16g",unbox_double());
tmp[32] = '\0';
box_char_string(tmp);
}
#define GC_AND_POP_FLOATS(x,y) \
#define POP_FLOATS(x,y) \
double x, y; \
maybe_gc(sizeof(F_FLOAT)); \
y = untag_float_fast(dpop()); \
x = untag_float_fast(dpop());
void primitive_float_add(void)
{
GC_AND_POP_FLOATS(x,y);
POP_FLOATS(x,y);
box_float(x + y);
}
void primitive_float_subtract(void)
{
GC_AND_POP_FLOATS(x,y);
POP_FLOATS(x,y);
box_float(x - y);
}
void primitive_float_multiply(void)
{
GC_AND_POP_FLOATS(x,y);
POP_FLOATS(x,y);
box_float(x * y);
}
void primitive_float_divfloat(void)
{
GC_AND_POP_FLOATS(x,y);
POP_FLOATS(x,y);
box_float(x / y);
}
void primitive_float_mod(void)
{
GC_AND_POP_FLOATS(x,y);
POP_FLOATS(x,y);
box_float(fmod(x,y));
}
void primitive_float_less(void)
{
GC_AND_POP_FLOATS(x,y);
POP_FLOATS(x,y);
box_boolean(x < y);
}
void primitive_float_lesseq(void)
{
GC_AND_POP_FLOATS(x,y);
POP_FLOATS(x,y);
box_boolean(x <= y);
}
void primitive_float_greater(void)
{
GC_AND_POP_FLOATS(x,y);
POP_FLOATS(x,y);
box_boolean(x > y);
}
void primitive_float_greatereq(void)
{
GC_AND_POP_FLOATS(x,y);
POP_FLOATS(x,y);
box_boolean(x >= y);
}

16
vm/os-unix.c
View File

@ -83,24 +83,20 @@ void primitive_stat(void)
void primitive_read_dir(void)
{
F_STRING *path;
DIR* dir;
F_ARRAY *result;
DIR* dir = opendir(unbox_char_string());
CELL result_count = 0;
F_ARRAY *result = allot_array(ARRAY_TYPE,100,F);
maybe_gc(0);
result = allot_array(ARRAY_TYPE,100,F);
path = untag_string(dpop());
dir = opendir(to_char_string(path,true));
if(dir != NULL)
{
struct dirent* file;
while((file = readdir(dir)) != NULL)
{
REGISTER_ARRAY(result);
CELL name = tag_object(from_char_string(file->d_name));
UNREGISTER_ARRAY(result);
if(result_count == array_capacity(result))
{
result = reallot_array(result,
@ -122,7 +118,6 @@ void primitive_read_dir(void)
void primitive_cwd(void)
{
char wd[MAXPATHLEN];
maybe_gc(0);
if(getcwd(wd,MAXPATHLEN) == NULL)
io_error();
box_char_string(wd);
@ -130,7 +125,6 @@ void primitive_cwd(void)
void primitive_cd(void)
{
maybe_gc(0);
chdir(unbox_char_string());
}

29
vm/os-windows.c
View File

@ -21,7 +21,7 @@ char *error_message(DWORD id)
{
char *buffer;
int index;
FormatMessage(
FORMAT_MESSAGE_ALLOCATE_BUFFER |
FORMAT_MESSAGE_FROM_SYSTEM,
@ -35,7 +35,7 @@ char *error_message(DWORD id)
index = strlen(buffer) - 1;
while(index >= 0 && isspace(buffer[index]))
buffer[index--] = 0;
return buffer_to_char_string(buffer);
}
@ -43,7 +43,7 @@ s64 current_millis(void)
{
FILETIME t;
GetSystemTimeAsFileTime(&t);
return (((s64)t.dwLowDateTime | (s64)t.dwHighDateTime<<32) - EPOCH_OFFSET)
return (((s64)t.dwLowDateTime | (s64)t.dwHighDateTime<<32) - EPOCH_OFFSET)
/ 10000;
}
@ -96,14 +96,14 @@ void primitive_stat(void)
if(!GetFileAttributesEx(
unbox_char_string(),
GetFileExInfoStandard,
&st))
&st))
{
dpush(F);
dpush(F);
dpush(F);
dpush(F);
}
else
}
else
{
box_boolean(st.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
box_signed_4(0);
@ -118,32 +118,31 @@ void primitive_read_dir(void)
{
HANDLE dir;
WIN32_FIND_DATA find_data;
F_ARRAY *result;
CELL result_count = 0;
char path[MAX_PATH + 4];
maybe_gc(0);
sprintf(path, "%s\\*", unbox_char_string());
result = array(ARRAY_TYPE,100,F);
F_ARRAY *result = allot_array(ARRAY_TYPE,100,F);
sprintf(path, "%s\\*", to_char_string(untag_string(dpop()),true));
if (INVALID_HANDLE_VALUE != (dir = FindFirstFile(path, &find_data)))
if(INVALID_HANDLE_VALUE != (dir = FindFirstFile(path, &find_data)))
{
do
{
REGISTER_ARRAY(result);
CELL name = tag_object(from_char_string(
find_data.cFileName));
UNREGISTER_ARRAY(result);
if(result_count == array_capacity(result))
{
result = reallot_array(result,
result_count * 2,F);
}
put(AREF(result,result_count),name);
result_count++;
}
}
while (FindNextFile(dir, &find_data));
CloseHandle(dir);
}
@ -157,7 +156,6 @@ void primitive_cwd(void)
{
char buf[MAX_PATH];
maybe_gc(0);
if(!GetCurrentDirectory(MAX_PATH, buf))
io_error();
@ -166,7 +164,6 @@ void primitive_cwd(void)
void primitive_cd(void)
{
maybe_gc(0);
SetCurrentDirectory(unbox_char_string());
}

16
vm/run.c
View File

@ -166,16 +166,12 @@ void primitive_exit(void)
void primitive_os_env(void)
{
char *name, *value;
maybe_gc(0);
name = unbox_char_string();
value = getenv(name);
char *name = unbox_char_string();
char *value = getenv(name);
if(value == NULL)
dpush(F);
else
box_char_string(getenv(name));
box_char_string(value);
}
void primitive_eq(void)
@ -187,8 +183,7 @@ void primitive_eq(void)
void primitive_millis(void)
{
maybe_gc(0);
dpush(tag_bignum(s48_long_long_to_bignum(current_millis())));
box_unsigned_8(current_millis());
}
void primitive_type(void)
@ -294,7 +289,8 @@ void memory_protection_error(CELL addr, int signal)
general_error(ERROR_CS_UNDERFLOW,F,F,false);
else if(in_page(addr, cs_bot, cs_size, 0))
general_error(ERROR_CS_OVERFLOW,F,F,false);
else
else if(in_page(addr, nursery.limit, 0, 0))
critical_error("Out of memory",0);
signal_error(signal);
}

14
vm/types.c
View File

@ -115,13 +115,13 @@ F_ARRAY *reallot_array(F_ARRAY* array, F_FIXNUM capacity, CELL fill)
if(capacity < to_copy)
to_copy = capacity;
REGISTER_ROOT(tag_object(array));
REGISTER_ARRAY(array);
REGISTER_ROOT(fill);
new_array = allot_array_internal(untag_header(array->header),capacity);
UNREGISTER_ROOT(fill);
array = untag_array_fast(rpop());
UNREGISTER_ARRAY(array);
memcpy(new_array + 1,array + 1,to_copy * CELLS);
@ -221,11 +221,11 @@ F_STRING* reallot_string(F_STRING* string, F_FIXNUM capacity, u16 fill)
if(capacity < to_copy)
to_copy = capacity;
REGISTER_ROOT(tag_object(string));
REGISTER_STRING(string);
F_STRING* new_string = allot_string_internal(capacity);
F_STRING *new_string = allot_string_internal(capacity);
string = untag_string_fast(rpop());
UNREGISTER_STRING(string);
memcpy(new_string + 1,string + 1,to_copy * CHARS);
@ -239,7 +239,7 @@ void primitive_resize_string(void)
{
F_STRING* string = untag_string_fast(dpop());
F_FIXNUM capacity = unbox_signed_cell();
drepl(tag_object(reallot_string(string,capacity,0)));
dpush(tag_object(reallot_string(string,capacity,0)));
}
/* Some ugly macros to prevent a 2x code duplication */
@ -276,7 +276,6 @@ void primitive_resize_string(void)
} \
void primitive_alien_to_##type##_string(void) \
{ \
maybe_gc(0); \
drepl(tag_object(from_##type##_string(alien_offset(dpeek())))); \
}
@ -345,7 +344,6 @@ F_ARRAY *allot_c_string(CELL capacity, CELL size)
void primitive_string_to_##type##_alien(void) \
{ \
CELL string, t; \
maybe_gc(0); \
string = dpeek(); \
t = type_of(string); \
if(t != ALIEN_TYPE && t != BYTE_ARRAY_TYPE && t != F_TYPE) \