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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2010-02-05 20:13:45 -08:00
parent 6199d3fccc 342af1a8dd
commit 74d0ef4413
15 changed files with 145 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -10,6 +10,7 @@ Factor/factor
*.lib
*.exp
*.res
*.RES
*.image
*.dylib
factor

12
basis/alien/c-types/c-types-tests.factor
View File

@ -1,6 +1,7 @@
USING: alien alien.syntax alien.c-types alien.parser
eval kernel tools.test sequences system libc alien.strings
io.encodings.utf8 math.constants classes.struct classes ;
io.encodings.utf8 math.constants classes.struct classes
accessors compiler.units ;
IN: alien.c-types.tests
CONSTANT: xyz 123
@ -100,3 +101,12 @@ DEFER: struct-redefined
\ struct-redefined class?
] unit-test
[
"IN: alien.c-types.tests
USE: alien.syntax
USE: alien.c-types
TYPEDEF: int type-redefinition-test
TYPEDEF: int type-redefinition-test" eval( -- )
]
[ error>> error>> redefine-error? ]
must-fail-with

4
basis/alien/syntax/syntax.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2009 Slava Pestov, Alex Chapman.
! Copyright (C) 2005, 2010 Slava Pestov, Alex Chapman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays alien alien.c-types
alien.arrays alien.strings kernel math namespaces parser
@ -22,7 +22,7 @@ SYNTAX: CALLBACK:
(CALLBACK:) define-inline ;
SYNTAX: TYPEDEF:
scan-c-type CREATE-C-TYPE typedef ;
scan-c-type CREATE-C-TYPE dup save-location typedef ;
SYNTAX: C-ENUM:
";" parse-tokens

10
basis/cpu/x86/bootstrap.factor
View File

@ -56,15 +56,15 @@ big-endian off
[
! Load word
temp0 0 MOV rc-absolute-cell rt-literal jit-rel
safe-reg 0 MOV rc-absolute-cell rt-literal jit-rel
! Bump profiling counter
temp0 profile-count-offset [+] 1 tag-fixnum ADD
safe-reg profile-count-offset [+] 1 tag-fixnum ADD
! Load word->code
temp0 temp0 word-code-offset [+] MOV
safe-reg safe-reg word-code-offset [+] MOV
! Compute word entry point
temp0 compiled-header-size ADD
safe-reg compiled-header-size ADD
! Jump to entry point
temp0 JMP
safe-reg JMP
] jit-profiling jit-define
[

9
basis/tools/profiler/profiler-tests.factor
View File

@ -1,6 +1,6 @@
USING: accessors tools.profiler tools.test kernel memory math
threads alien alien.c-types tools.profiler.private sequences
compiler.test compiler.units words ;
compiler.test compiler.units words arrays ;
IN: tools.profiler.tests
[ t ] [
@ -9,7 +9,7 @@ IN: tools.profiler.tests
\ length counter>> =
] unit-test
[ ] [ [ 10 [ gc ] times ] profile ] unit-test
[ ] [ [ 3 [ gc ] times ] profile ] unit-test
[ ] [ [ 1000000 sleep ] profile ] unit-test
@ -72,3 +72,8 @@ IN: tools.profiler.tests
] profile
counter>>
] unit-test
! unwind_native_frames() would fail if profiling was enabled
! because the jit-profiling stub would clobber a parameter register
! on x86-64
[ [ -10 f <array> ] profile ] must-fail

2
basis/unix/groups/groups.factor
View File

@ -59,7 +59,7 @@ PRIVATE>
[ nip ] [ number>string ] if* ;
: group-id ( string -- id/f )
group-struct [ gr_gid>> ] [ f ] if* ;
group-struct dup [ gr_gid>> ] when ;
<PRIVATE

2
basis/unix/users/users-docs.factor
View File

@ -62,7 +62,7 @@ HELP: user-name
HELP: user-id
{ $values
{ "string" string }
{ "id" integer } }
{ "id/f" "an integer or f" } }
{ $description "Returns the user id associated with the user-name." } ;
HELP: with-effective-user

2
basis/unix/users/users-tests.factor
View File

@ -25,3 +25,5 @@ IN: unix.users.tests
[ "9999999999999999999" ] [ 9999999999999999999 user-name ] unit-test
[ f ] [ 89898989898989898989898989898 user-passwd ] unit-test
[ f ] [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" user-id ] unit-test

4
basis/unix/users/users.factor
View File

@ -61,8 +61,8 @@ M: string user-passwd ( string -- passwd/f )
dup user-passwd
[ nip user-name>> ] [ number>string ] if* ;
: user-id ( string -- id )
user-passwd uid>> ;
: user-id ( string -- id/f )
user-passwd dup [ uid>> ] when ;
: real-user-id ( -- id )
unix.ffi:getuid ; inline

2
basis/windows/directx/dinput/dinput.factor
View File

@ -72,7 +72,7 @@ STRUCT: DICONFIGUREDEVICESPARAMSW
{ dics DICOLORSET }
{ lpUnkDDSTarget IUnknown* } ;
TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPDICONFIGUREDEVICESPARAMSW
TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPDICONFIGUREDEVICESPARAMSW
TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPCDICONFIGUREDEVICESPARAMSW
STRUCT: DIDEVCAPS
{ dwSize DWORD }

14
basis/windows/types/types.factor
View File

@ -36,12 +36,10 @@ TYPEDEF: int HFILE
TYPEDEF: long LONG
TYPEDEF: long* LPLONG
TYPEDEF: long LONG_PTR
TYPEDEF: long* PLONG_PTR
TYPEDEF: intptr_t LONG_PTR
TYPEDEF: uint ULONG
TYPEDEF: void* ULONG_PTR
TYPEDEF: void* PULONG_PTR
TYPEDEF: uintptr_t ULONG_PTR
TYPEDEF: void VOID
TYPEDEF: void* PVOID
@ -55,9 +53,6 @@ TYPEDEF: intptr_t UHALF_PTR
TYPEDEF: intptr_t INT_PTR
TYPEDEF: intptr_t UINT_PTR
TYPEDEF: int LONG_PTR
TYPEDEF: ulong ULONG_PTR
TYPEDEF: int INT32
TYPEDEF: uint UINT32
TYPEDEF: uint DWORD32
@ -88,7 +83,6 @@ TYPEDEF: TCHAR TBYTE
TYPEDEF: WORD ATOM
TYPEDEF: BYTE BOOLEAN
TYPEDEF: DWORD COLORREF
TYPEDEF: ULONGLONG DWORDLONG
TYPEDEF: ULONG_PTR DWORD_PTR
TYPEDEF: PVOID HANDLE
@ -135,7 +129,6 @@ TYPEDEF: DWORD LGRPID
TYPEDEF: LONG_PTR LPARAM
TYPEDEF: BOOL* LPBOOL
TYPEDEF: BYTE* LPBYTE
TYPEDEF: DWORD* LPCOLORREF
TYPEDEF: WCHAR* LPCWSTR
! TYPEDEF: WCHAR* LPWSTR
@ -199,8 +192,6 @@ TYPEDEF: WCHAR* PWSTR
TYPEDEF: HANDLE SC_HANDLE
TYPEDEF: LPVOID SC_LOCK
TYPEDEF: HANDLE SERVICE_STATUS_HANDLE
TYPEDEF: ULONG_PTR SIZE_T
TYPEDEF: LONG_PTR SSIZE_T
TYPEDEF: LONGLONG USN
TYPEDEF: UINT_PTR WPARAM
@ -335,7 +326,6 @@ TYPEDEF: RECT* LPRECT
TYPEDEF: PIXELFORMATDESCRIPTOR PFD
TYPEDEF: PFD* LPPFD
TYPEDEF: HANDLE HGLRC
TYPEDEF: HANDLE HRGN
TYPEDEF: void* PWNDCLASS
TYPEDEF: void* PWNDCLASSEX

2
vm/image.cpp
View File

@ -301,7 +301,7 @@ bool factor_vm::save_image(const vm_char *saving_filename, const vm_char *filena
if(safe_fwrite(&h,sizeof(image_header),1,file) != 1) ok = false;
if(safe_fwrite((void*)data->tenured->start,h.data_size,1,file) != 1) ok = false;
if(safe_fwrite(code->allocator->first_block(),h.code_size,1,file) != 1) ok = false;
if(safe_fclose(file)) ok = false;
safe_fclose(file);
if(!ok)
std::cout << "save-image failed: " << strerror(errno) << std::endl;

174
vm/io.cpp
View File

@ -31,7 +31,38 @@ void factor_vm::io_error()
general_error(ERROR_IO,tag_fixnum(errno),false_object,NULL);
}
size_t safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
FILE *factor_vm::safe_fopen(char *filename, char *mode)
{
FILE *file;
do {
file = fopen(filename,mode);
if(file == NULL)
io_error();
else
break;
} while(errno == EINTR);
return file;
}
int factor_vm::safe_fgetc(FILE *stream)
{
int c;
do {
c = fgetc(stream);
if(c == EOF)
{
if(feof(stream))
return EOF;
else
io_error();
}
else
break;
} while(errno == EINTR);
return c;
}
size_t factor_vm::safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
{
size_t items_read = 0;
@ -42,7 +73,17 @@ size_t safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
return items_read;
}
size_t safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
void factor_vm::safe_fputc(int c, FILE *stream)
{
do {
if(fputc(c,stream) == EOF)
io_error();
else
break;
} while(errno == EINTR);
}
size_t factor_vm::safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
{
size_t items_written = 0;
@ -53,15 +94,55 @@ size_t safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
return items_written;
}
int safe_fclose(FILE *stream)
int factor_vm::safe_ftell(FILE *stream)
{
int ret = 0;
off_t offset;
do {
if((offset = FTELL(stream)) == -1)
io_error();
else
break;
} while(errno == EINTR);
return offset;
}
void factor_vm::safe_fseek(FILE *stream, off_t offset, int whence)
{
switch(whence)
{
case 0: whence = SEEK_SET; break;
case 1: whence = SEEK_CUR; break;
case 2: whence = SEEK_END; break;
default:
critical_error("Bad value for whence",whence);
}
do {
ret = fclose(stream);
} while(ret != 0 && errno == EINTR);
if(FSEEK(stream,offset,whence) == -1)
io_error();
else
break;
} while(errno == EINTR);
}
return ret;
void factor_vm::safe_fflush(FILE *stream)
{
do {
if(fflush(stream) == EOF)
io_error();
else
break;
} while(errno == EINTR);
}
void factor_vm::safe_fclose(FILE *stream)
{
do {
if(fclose(stream) == EOF)
io_error();
else
break;
} while(errno == EINTR);
}
void factor_vm::primitive_fopen()
@ -72,13 +153,8 @@ void factor_vm::primitive_fopen()
path.untag_check(this);
FILE *file;
do {
file = fopen((char *)(path.untagged() + 1),
(char *)(mode.untagged() + 1));
if(file == NULL)
io_error();
} while(errno == EINTR);
file = safe_fopen((char *)(path.untagged() + 1),
(char *)(mode.untagged() + 1));
ctx->push(allot_alien(file));
}
@ -91,24 +167,11 @@ void factor_vm::primitive_fgetc()
{
FILE *file = pop_file_handle();
do {
int c = fgetc(file);
if(c == EOF)
{
if(feof(file))
{
ctx->push(false_object);
break;
}
else
io_error();
}
else
{
ctx->push(tag_fixnum(c));
break;
}
} while(errno == EINTR);
int c = safe_fgetc(file);
if(c == EOF && feof(file))
ctx->push(false_object);
else
ctx->push(tag_fixnum(c));
}
void factor_vm::primitive_fread()
@ -156,13 +219,7 @@ void factor_vm::primitive_fputc()
{
FILE *file = pop_file_handle();
fixnum ch = to_fixnum(ctx->pop());
do {
if(fputc(ch,file) == EOF)
io_error();
else
break;
} while(errno == EINTR);
safe_fputc(ch, file);
}
void factor_vm::primitive_fwrite()
@ -183,16 +240,7 @@ void factor_vm::primitive_fwrite()
void factor_vm::primitive_ftell()
{
FILE *file = pop_file_handle();
off_t offset;
do {
if((offset = FTELL(file)) == -1)
io_error();
else
break;
} while(errno == EINTR);
ctx->push(from_signed_8(offset));
ctx->push(from_signed_8(safe_ftell(file)));
}
void factor_vm::primitive_fseek()
@ -200,41 +248,19 @@ void factor_vm::primitive_fseek()
int whence = to_fixnum(ctx->pop());
FILE *file = pop_file_handle();
off_t offset = to_signed_8(ctx->pop());
switch(whence)
{
case 0: whence = SEEK_SET; break;
case 1: whence = SEEK_CUR; break;
case 2: whence = SEEK_END; break;
default:
critical_error("Bad value for whence",whence);
break;
}
do {
if(FSEEK(file,offset,whence) == -1)
io_error();
else
break;
} while(errno == EINTR);
safe_fseek(file,offset,whence);
}
void factor_vm::primitive_fflush()
{
FILE *file = pop_file_handle();
do {
if(fflush(file) == EOF)
io_error();
else
break;
} while(errno == EINTR);
safe_fflush(file);
}
void factor_vm::primitive_fclose()
{
FILE *file = pop_file_handle();
if(safe_fclose(file) == EOF)
io_error();
safe_fclose(file);
}
/* This function is used by FFI I/O. Accessing the errno global directly is

4
vm/io.hpp
View File

@ -1,10 +1,6 @@
namespace factor
{
size_t safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream);
size_t safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream);
int safe_fclose(FILE *stream);
/* Platform specific primitives */
VM_C_API int err_no();

9
vm/vm.hpp
View File

@ -492,6 +492,15 @@ struct factor_vm
//io
void init_c_io();
void io_error();
FILE* safe_fopen(char *filename, char *mode);
int safe_fgetc(FILE *stream);
size_t safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream);
void safe_fputc(int c, FILE* stream);
size_t safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream);
int safe_ftell(FILE *stream);
void safe_fseek(FILE *stream, off_t offset, int whence);
void safe_fflush(FILE *stream);
void safe_fclose(FILE *stream);
void primitive_fopen();
FILE *pop_file_handle();
void primitive_fgetc();