Merge branch 'master' into new_ui

db4
Slava Pestov 2009-01-21 19:56:20 -06:00
commit 87a1363c95
8 changed files with 30 additions and 16 deletions

View File

@ -8,10 +8,6 @@ sequences system libc alien.strings io.encodings.utf8 ;
[ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test
: foo ( -- n ) &: fdafd [ 123 ] unless* ;
[ 123 ] [ foo ] unit-test
[ -1 ] [ -1 <char> *char ] unit-test [ -1 ] [ -1 <char> *char ] unit-test
[ -1 ] [ -1 <short> *short ] unit-test [ -1 ] [ -1 <short> *short ] unit-test
[ -1 ] [ -1 <int> *int ] unit-test [ -1 ] [ -1 <int> *int ] unit-test

View File

@ -34,6 +34,8 @@ IN: alien.syntax
[ [ create-in ] dip define-constant ] each-index ; [ [ create-in ] dip define-constant ] each-index ;
parsing parsing
: address-of ( name library -- value )
load-library dlsym [ "No such symbol" throw ] unless* ;
: &: : &:
scan "c-library" get scan "c-library" get '[ _ _ address-of ] over push-all ; parsing
'[ _ _ load-library dlsym ] over push-all ; parsing

View File

@ -32,10 +32,8 @@ IN: heaps.tests
: random-alist ( n -- alist ) : random-alist ( n -- alist )
[ [
[ drop 32 random-bits dup number>string
32 random-bits dup number>string swap set ] H{ } map>assoc ;
] times
] H{ } make-assoc ;
: test-heap-sort ( n -- ? ) : test-heap-sort ( n -- ? )
random-alist dup >alist sort-keys swap heap-sort = ; random-alist dup >alist sort-keys swap heap-sort = ;

View File

@ -1,9 +1,9 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays byte-arrays kernel kernel.private math namespaces USING: arrays byte-arrays kernel kernel.private math namespaces
make sequences strings words effects generic generic.standard make sequences strings words effects generic generic.standard
classes classes.algebra slots.private combinators accessors classes classes.algebra slots.private combinators accessors
words sequences.private assocs alien quotations ; words sequences.private assocs alien quotations hashtables ;
IN: slots IN: slots
TUPLE: slot-spec name offset class initial read-only ; TUPLE: slot-spec name offset class initial read-only ;
@ -86,7 +86,7 @@ ERROR: bad-slot-value value class ;
] [ ] make ; ] [ ] make ;
: writer-props ( slot-spec -- assoc ) : writer-props ( slot-spec -- assoc )
[ "writing" set ] H{ } make-assoc ; "writing" associate ;
: define-writer ( class slot-spec -- ) : define-writer ( class slot-spec -- )
[ name>> writer-word ] [ writer-quot ] [ writer-props ] tri [ name>> writer-word ] [ writer-quot ] [ writer-props ] tri

View File

@ -53,8 +53,7 @@ INLINE bool factor_arg(const F_CHAR* str, const F_CHAR* arg, CELL* value)
void init_parameters_from_args(F_PARAMETERS *p, int argc, F_CHAR **argv) void init_parameters_from_args(F_PARAMETERS *p, int argc, F_CHAR **argv)
{ {
default_parameters(p); default_parameters(p);
const F_CHAR *executable_path = vm_executable_path(); p->executable_path = argv[0];
p->executable_path = executable_path ? executable_path : argv[0];
int i = 0; int i = 0;
@ -106,6 +105,11 @@ void init_factor(F_PARAMETERS *p)
/* OS-specific initialization */ /* OS-specific initialization */
early_init(); early_init();
const F_CHAR *executable_path = vm_executable_path();
if(executable_path)
p->executable_path = executable_path;
if(p->image_path == NULL) if(p->image_path == NULL)
p->image_path = default_image_path(); p->image_path = default_image_path();

View File

@ -112,7 +112,9 @@ bool save_image(const F_CHAR *filename)
FILE* file; FILE* file;
F_HEADER h; F_HEADER h;
file = OPEN_WRITE(filename); F_CHAR temporary_filename[] = "##saving-factor-image##";
file = OPEN_WRITE(temporary_filename);
if(file == NULL) if(file == NULL)
{ {
print_string("Cannot open image file: "); print_native_string(filename); nl(); print_string("Cannot open image file: "); print_native_string(filename); nl();
@ -163,6 +165,14 @@ bool save_image(const F_CHAR *filename)
return false; return false;
} }
if(MOVE_FILE_FAILS(temporary_filename, filename))
{
print_string("Failed to rename tempoarary image file: "); print_string(strerror(errno)); nl();
if(DELETE_FILE_FAILS(temporary_filename))
print_string("Failed to clean up temporary image file: "); print_string(strerror(errno)); nl();
return false;
}
return true; return true;
} }

View File

@ -22,6 +22,8 @@ typedef char F_SYMBOL;
#define STRCMP strcmp #define STRCMP strcmp
#define STRNCMP strncmp #define STRNCMP strncmp
#define STRDUP strdup #define STRDUP strdup
#define MOVE_FILE_FAILS(old,new) (rename((old),(new)) < 0)
#define DELETE_FILE_FAILS(old) (unlink((old)) < 0)
#define FIXNUM_FORMAT "%ld" #define FIXNUM_FORMAT "%ld"
#define CELL_FORMAT "%lu" #define CELL_FORMAT "%lu"

View File

@ -19,6 +19,8 @@ typedef wchar_t F_CHAR;
#define STRCMP wcscmp #define STRCMP wcscmp
#define STRNCMP wcsncmp #define STRNCMP wcsncmp
#define STRDUP _wcsdup #define STRDUP _wcsdup
#define MOVE_FILE_FAILS(old,new) (MoveFile((old),(new)) == 0)
#define DELETE_FILE_FAILS(old) (DeleteFile((old)) == 0)
#ifdef WIN64 #ifdef WIN64
#define CELL_FORMAT "%Iu" #define CELL_FORMAT "%Iu"