Skip to content

Commit

Permalink
Merge branch 'master' into startup
Browse files Browse the repository at this point in the history 
Conflicts:
	core/bootstrap/primitives.factor
	vm/run.hpp
  • Loading branch information
@erg
erg committed Nov 15, 2009
2 parents b34bfe5 + 6f38690 commit cc19441
Show file tree
Hide file tree
Showing 1,229 changed files with 14,851 additions and 8,333 deletions.
7 changes: 5 additions & 2 deletions Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,22 +41,25 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
vm/callstack.o \
vm/code_block.o \
vm/code_heap.o \
vm/compaction.o \
vm/contexts.o \
vm/data_heap.o \
vm/data_heap_checker.o \
vm/debug.o \
vm/dispatch.o \
vm/errors.o \
vm/factor.o \
vm/free_list.o \
vm/full_collector.o \
vm/gc.o \
vm/heap.o \
vm/image.o \
vm/inline_cache.o \
vm/io.o \
vm/jit.o \
vm/math.o \
vm/nursery_collector.o \
vm/old_space.o \
vm/object_start_map.o \
vm/objects.o \
vm/primitives.o \
vm/profiler.o \
vm/quotations.o \
Expand Down
36 changes: 28 additions & 8 deletions basis/alarms/alarms-docs.factor
View file
Original file line number Diff line number Diff line change
@@ -1,16 +1,23 @@
IN: alarms
USING: help.markup help.syntax calendar quotations ;
IN: alarms

HELP: alarm
{ $class-description "An alarm. Can be passed to " { $link cancel-alarm } "." } ;

HELP: add-alarm
{ $values { "quot" quotation } { "time" timestamp } { "frequency" { $maybe duration } } { "alarm" alarm } }
{ $description "Creates and registers an alarm. If " { $snippet "frequency" } " is " { $link f } ", this will be a one-time alarm, otherwise it will fire with the given frequency. The quotation will be called from the alarm thread." } ;
{ $description "Creates and registers an alarm to start at " { $snippet "time" } ". If " { $snippet "frequency" } " is " { $link f } ", this will be a one-time alarm, otherwise it will fire with the given frequency. The quotation will be called from the alarm thread." } ;

HELP: later
{ $values { "quot" quotation } { "duration" duration } { "alarm" alarm } }
{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." } ;
{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." }
{ $examples
{ $unchecked-example
"USING: alarms io calendar ;"
"""[ "GET BACK TO WORK, Guy." print flush ] 10 minutes later drop"""
""
}
} ;

HELP: cancel-alarm
{ $values { "alarm" alarm } }
Expand All @@ -20,16 +27,29 @@ HELP: every
{ $values
{ "quot" quotation } { "duration" duration }
{ "alarm" alarm } }
{ $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency." } ;
{ $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency." }
{ $examples
{ $unchecked-example
"USING: alarms io calendar ;"
"""[ "Hi Buddy." print flush ] 10 seconds every drop"""
""
}
} ;

ARTICLE: "alarms" "Alarms"
"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks without spawning a new thread."
"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks without spawning a new thread." $nl
"The alarm class:"
{ $subsections
alarm
add-alarm
later
cancel-alarm
}
"Register a recurring alarm:"
{ $subsections every }
"Register a one-time alarm:"
{ $subsections later }
"Low-level interface to add alarms:"
{ $subsections add-alarm }
"Cancelling an alarm:"
{ $subsections cancel-alarm }
"Alarms do not persist across image saves. Saving and restoring an image has the effect of calling " { $link cancel-alarm } " on all " { $link alarm } " instances." ;

ABOUT: "alarms"
7 changes: 6 additions & 1 deletion basis/alien/arrays/arrays.factor
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,8 @@ M: array heap-size unclip [ array-length ] [ heap-size ] bi* * ;

M: array c-type-align first c-type-align ;

M: array c-type-align-first first c-type-align-first ;

M: array c-type-stack-align? drop f ;

M: array unbox-parameter drop void* unbox-parameter ;
Expand Down Expand Up @@ -55,6 +57,9 @@ M: string-type heap-size
M: string-type c-type-align
drop void* c-type-align ;

M: string-type c-type-align-first
drop void* c-type-align-first ;

M: string-type c-type-stack-align?
drop void* c-type-stack-align? ;

Expand Down Expand Up @@ -97,5 +102,5 @@ M: string-type c-type-setter
{ char* utf8 } char* typedef
char* uchar* typedef

char char* "pointer-c-type" set-word-prop
char char* "pointer-c-type" set-word-prop
uchar uchar* "pointer-c-type" set-word-prop
95 changes: 71 additions & 24 deletions basis/alien/c-types/c-types.factor
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,9 @@ TUPLE: abstract-c-type
{ unboxer-quot callable }
{ getter callable }
{ setter callable }
size
align ;
{ size integer }
{ align integer }
{ align-first integer } ;

TUPLE: c-type < abstract-c-type
boxer
Expand Down Expand Up @@ -104,10 +105,9 @@ M: word c-type

GENERIC: c-struct? ( c-type -- ? )

M: object c-struct?
drop f ;
M: c-type-name c-struct?
dup void? [ drop f ] [ c-type c-struct? ] if ;
M: object c-struct? drop f ;

M: c-type-name c-struct? dup void? [ drop f ] [ c-type c-struct? ] if ;

! These words being foldable means that words need to be
! recompiled if a C type is redefined. Even so, folding the
Expand Down Expand Up @@ -172,6 +172,12 @@ M: abstract-c-type c-type-align align>> ;

M: c-type-name c-type-align c-type c-type-align ;

GENERIC: c-type-align-first ( name -- n )

M: c-type-name c-type-align-first c-type c-type-align-first ;

M: abstract-c-type c-type-align-first align-first>> ;

GENERIC: c-type-stack-align? ( name -- ? )

M: c-type c-type-stack-align? stack-align?>> ;
Expand Down Expand Up @@ -230,6 +236,10 @@ M: byte-array byte-length length ; inline

M: f byte-length drop 0 ; inline

: >c-bool ( ? -- int ) 1 0 ? ; inline

: c-bool> ( int -- ? ) 0 = not ; inline

MIXIN: value-type

: c-getter ( name -- quot )
Expand All @@ -256,6 +266,7 @@ PREDICATE: typedef-word < c-type-word
"c-type" word-prop c-type-name? ;

M: string typedef ( old new -- ) c-types get set-at ;

M: word typedef ( old new -- )
{
[ nip define-symbol ]
Expand Down Expand Up @@ -292,7 +303,7 @@ M: long-long-type box-return ( c-type -- )

: define-out ( name -- )
[ "alien.c-types" constructor-word ]
[ dup c-setter '[ _ heap-size <byte-array> [ 0 @ ] keep ] ] bi
[ dup c-setter '[ _ heap-size (byte-array) [ 0 @ ] keep ] ] bi
(( value -- c-ptr )) define-inline ;

: define-primitive-type ( c-type name -- )
Expand All @@ -319,6 +330,13 @@ SYMBOLS:
ptrdiff_t intptr_t uintptr_t size_t
char* uchar* ;

: 8-byte-alignment ( c-type -- c-type )
{
{ [ cpu ppc? os macosx? and ] [ 4 >>align 8 >>align-first ] }
{ [ cpu x86.32? os windows? not and ] [ 4 >>align 4 >>align-first ] }
[ 8 >>align 8 >>align-first ]
} cond ;

[
<c-type>
c-ptr >>class
Expand All @@ -327,6 +345,7 @@ SYMBOLS:
[ [ >c-ptr ] 2dip set-alien-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
bootstrap-cell >>align-first
[ >c-ptr ] >>unboxer-quot
"box_alien" >>boxer
"alien_offset" >>unboxer
Expand All @@ -338,7 +357,7 @@ SYMBOLS:
[ alien-signed-8 ] >>getter
[ set-alien-signed-8 ] >>setter
8 >>size
8 >>align
8-byte-alignment
"box_signed_8" >>boxer
"to_signed_8" >>unboxer
\ longlong define-primitive-type
Expand All @@ -349,7 +368,7 @@ SYMBOLS:
[ alien-unsigned-8 ] >>getter
[ set-alien-unsigned-8 ] >>setter
8 >>size
8 >>align
8-byte-alignment
"box_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer
\ ulonglong define-primitive-type
Expand All @@ -361,6 +380,7 @@ SYMBOLS:
[ set-alien-signed-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
bootstrap-cell >>align-first
"box_signed_cell" >>boxer
"to_fixnum" >>unboxer
\ long define-primitive-type
Expand All @@ -372,6 +392,7 @@ SYMBOLS:
[ set-alien-unsigned-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
bootstrap-cell >>align-first
"box_unsigned_cell" >>boxer
"to_cell" >>unboxer
\ ulong define-primitive-type
Expand All @@ -383,6 +404,7 @@ SYMBOLS:
[ set-alien-signed-4 ] >>setter
4 >>size
4 >>align
4 >>align-first
"box_signed_4" >>boxer
"to_fixnum" >>unboxer
\ int define-primitive-type
Expand All @@ -394,6 +416,7 @@ SYMBOLS:
[ set-alien-unsigned-4 ] >>setter
4 >>size
4 >>align
4 >>align-first
"box_unsigned_4" >>boxer
"to_cell" >>unboxer
\ uint define-primitive-type
Expand All @@ -405,6 +428,7 @@ SYMBOLS:
[ set-alien-signed-2 ] >>setter
2 >>size
2 >>align
2 >>align-first
"box_signed_2" >>boxer
"to_fixnum" >>unboxer
\ short define-primitive-type
Expand All @@ -416,6 +440,7 @@ SYMBOLS:
[ set-alien-unsigned-2 ] >>setter
2 >>size
2 >>align
2 >>align-first
"box_unsigned_2" >>boxer
"to_cell" >>unboxer
\ ushort define-primitive-type
Expand All @@ -427,6 +452,7 @@ SYMBOLS:
[ set-alien-signed-1 ] >>setter
1 >>size
1 >>align
1 >>align-first
"box_signed_1" >>boxer
"to_fixnum" >>unboxer
\ char define-primitive-type
Expand All @@ -438,17 +464,30 @@ SYMBOLS:
[ set-alien-unsigned-1 ] >>setter
1 >>size
1 >>align
1 >>align-first
"box_unsigned_1" >>boxer
"to_cell" >>unboxer
\ uchar define-primitive-type

<c-type>
[ alien-unsigned-1 0 = not ] >>getter
[ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
1 >>size
1 >>align
"box_boolean" >>boxer
"to_boolean" >>unboxer
cpu ppc? [
<c-type>
[ alien-unsigned-4 c-bool> ] >>getter
[ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter
4 >>size
4 >>align
4 >>align-first
"box_boolean" >>boxer
"to_boolean" >>unboxer
] [
<c-type>
[ alien-unsigned-1 c-bool> ] >>getter
[ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
1 >>size
1 >>align
1 >>align-first
"box_boolean" >>boxer
"to_boolean" >>unboxer
] if
\ bool define-primitive-type

<c-type>
Expand All @@ -458,6 +497,7 @@ SYMBOLS:
[ [ >float ] 2dip set-alien-float ] >>setter
4 >>size
4 >>align
4 >>align-first
"box_float" >>boxer
"to_float" >>unboxer
float-rep >>rep
Expand All @@ -470,17 +510,24 @@ SYMBOLS:
[ alien-double ] >>getter
[ [ >float ] 2dip set-alien-double ] >>setter
8 >>size
8 >>align
8-byte-alignment
"box_double" >>boxer
"to_double" >>unboxer
double-rep >>rep
[ >float ] >>unboxer-quot
\ double define-primitive-type

\ long c-type \ ptrdiff_t typedef
\ long c-type \ intptr_t typedef
\ ulong c-type \ uintptr_t typedef
\ ulong c-type \ size_t typedef
cpu x86.64? os windows? and [
\ longlong c-type \ ptrdiff_t typedef
\ longlong c-type \ intptr_t typedef
\ ulonglong c-type \ uintptr_t typedef
\ ulonglong c-type \ size_t typedef
] [
\ long c-type \ ptrdiff_t typedef
\ long c-type \ intptr_t typedef
\ ulong c-type \ uintptr_t typedef
\ ulong c-type \ size_t typedef
] if
] with-compilation-unit

M: char-16-rep rep-component-type drop char ;
Expand All @@ -501,9 +548,9 @@ M: double-2-rep rep-component-type drop double ;

: c-type-interval ( c-type -- from to )
{
{ [ dup { float double } memq? ] [ drop -1/0. 1/0. ] }
{ [ dup { char short int long longlong } memq? ] [ signed-interval ] }
{ [ dup { uchar ushort uint ulong ulonglong } memq? ] [ unsigned-interval ] }
{ [ dup { float double } member-eq? ] [ drop -1/0. 1/0. ] }
{ [ dup { char short int long longlong } member-eq? ] [ signed-interval ] }
{ [ dup { uchar ushort uint ulong ulonglong } member-eq? ] [ unsigned-interval ] }
} cond ; foldable

: c-type-clamp ( value c-type -- value' ) c-type-interval clamp ; inline
6 changes: 0 additions & 6 deletions basis/alien/data/data.factor
View file
Original file line number Diff line number Diff line change
Expand Up @@ -65,10 +65,6 @@ M: memory-stream stream-read
: byte-array>memory ( byte-array base -- )
swap dup byte-length memcpy ; inline

: >c-bool ( ? -- int ) 1 0 ? ; inline

: c-bool> ( int -- ? ) 0 = not ; inline

M: value-type c-type-rep drop int-rep ;

M: value-type c-type-getter
Expand All @@ -77,5 +73,3 @@ M: value-type c-type-getter
M: value-type c-type-setter ( type -- quot )
[ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
'[ @ swap @ _ memcpy ] ;


Loading

0 comments on commit cc19441

Please sign in to comment.