*.lib
*.exp
*.res
+*.RES
*.image
*.dylib
factor
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
\ 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
-! 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
(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
[
! 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
[
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 ] [
\ length counter>> =
] unit-test
-[ ] [ [ 10 [ gc ] times ] profile ] unit-test
+[ ] [ [ 3 [ gc ] times ] profile ] unit-test
[ ] [ [ 1000000 sleep ] profile ] unit-test
] 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
[ nip ] [ number>string ] if* ;
: group-id ( string -- id/f )
- group-struct [ gr_gid>> ] [ f ] if* ;
+ group-struct dup [ gr_gid>> ] when ;
<PRIVATE
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
[ "9999999999999999999" ] [ 9999999999999999999 user-name ] unit-test
[ f ] [ 89898989898989898989898989898 user-passwd ] unit-test
+
+[ f ] [ "thisusershouldnotexistabcdefg12345asdfasdfasdfasdfasdfasdfasdf" user-id ] unit-test
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
{ dics DICOLORSET }
{ lpUnkDDSTarget IUnknown* } ;
TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPDICONFIGUREDEVICESPARAMSW
-TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPDICONFIGUREDEVICESPARAMSW
+TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPCDICONFIGUREDEVICESPARAMSW
STRUCT: DIDEVCAPS
{ dwSize DWORD }
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
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
TYPEDEF: WORD ATOM
TYPEDEF: BYTE BOOLEAN
-TYPEDEF: DWORD COLORREF
TYPEDEF: ULONGLONG DWORDLONG
TYPEDEF: ULONG_PTR DWORD_PTR
TYPEDEF: PVOID HANDLE
TYPEDEF: LONG_PTR LPARAM
TYPEDEF: BOOL* LPBOOL
TYPEDEF: BYTE* LPBYTE
-TYPEDEF: DWORD* LPCOLORREF
TYPEDEF: WCHAR* LPCWSTR
! TYPEDEF: WCHAR* LPWSTR
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
TYPEDEF: PIXELFORMATDESCRIPTOR PFD
TYPEDEF: PFD* LPPFD
TYPEDEF: HANDLE HGLRC
-TYPEDEF: HANDLE HRGN
TYPEDEF: void* PWNDCLASS
TYPEDEF: void* PWNDCLASSEX
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;
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;
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;
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()
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));
}
{
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()
{
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()
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()
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
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();
//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();
projects / factor.git / commitdiff