diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 40b1f56f8b..4ddd0c0300 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -53,7 +53,7 @@ SYMBOL: labels V{ } clone literal-table set V{ } clone calls set compiling-word set - compiled-stack-traces? compiling-word get f ? add-literal drop ; + compiled-stack-traces? compiling-word get f ? add-literal ; : generate ( mr -- asm ) [ diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor index e0f391deb5..3a047a8d39 100755 --- a/basis/compiler/codegen/fixup/fixup.factor +++ b/basis/compiler/codegen/fixup/fixup.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays byte-arrays byte-vectors generic assocs hashtables io.binary kernel kernel.private math namespaces make sequences @@ -28,51 +28,47 @@ M: label-fixup fixup* [ label>> ] [ class>> ] bi compiled-offset 4 - rot 3array label-table get push ; -TUPLE: rel-fixup arg class type ; +TUPLE: rel-fixup class type ; -: rel-fixup ( arg class type -- ) \ rel-fixup boa , ; +: rel-fixup ( class type -- ) \ rel-fixup boa , ; : push-4 ( value vector -- ) [ length ] [ B{ 0 0 0 0 } swap push-all ] [ underlying>> ] tri swap set-alien-unsigned-4 ; M: rel-fixup fixup* - [ [ arg>> ] [ class>> ] [ type>> ] tri { 0 8 16 } bitfield ] - [ class>> rc-absolute-cell = cell 4 ? compiled-offset swap - ] bi - [ relocation-table get push-4 ] bi@ ; + [ type>> ] + [ class>> ] + [ class>> rc-absolute-cell = cell 4 ? compiled-offset swap - ] tri + { 0 24 28 } bitfield + relocation-table get push-4 ; M: integer fixup* , ; -: indq ( elt seq -- n ) [ eq? ] with find drop ; - -: adjoin* ( obj table -- n ) - 2dup indq [ 2nip ] [ dup length [ push ] dip ] if* ; - SYMBOL: literal-table -: add-literal ( obj -- n ) literal-table get adjoin* ; +: add-literal ( obj -- ) literal-table get push ; : add-dlsym-literals ( symbol dll -- ) - [ string>symbol ] dip 2array literal-table get push-all ; + [ string>symbol add-literal ] [ add-literal ] bi* ; : rel-dlsym ( name dll class -- ) - [ literal-table get length [ add-dlsym-literals ] dip ] dip - rt-dlsym rel-fixup ; + [ add-dlsym-literals ] dip rt-dlsym rel-fixup ; : rel-word ( word class -- ) [ add-literal ] dip rt-xt rel-fixup ; : rel-primitive ( word class -- ) - [ def>> first ] dip rt-primitive rel-fixup ; + [ def>> first add-literal ] dip rt-primitive rel-fixup ; : rel-immediate ( literal class -- ) [ add-literal ] dip rt-immediate rel-fixup ; : rel-this ( class -- ) - 0 swap rt-label rel-fixup ; + rt-this rel-fixup ; : rel-here ( offset class -- ) - rt-here rel-fixup ; + [ add-literal ] dip rt-here rel-fixup ; : init-fixup ( -- ) BV{ } clone relocation-table set diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index f82b6d479f..b3757bf008 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -23,7 +23,7 @@ CONSTANT: deck-bits 18 : quot-xt-offset ( -- n ) 5 bootstrap-cells object tag-number - ; inline : word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; inline : array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline -: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline +: compiled-header-size ( -- n ) 5 bootstrap-cells ; inline ! Relocation classes CONSTANT: rc-absolute-cell 0 @@ -42,7 +42,7 @@ CONSTANT: rt-dlsym 1 CONSTANT: rt-dispatch 2 CONSTANT: rt-xt 3 CONSTANT: rt-here 4 -CONSTANT: rt-label 5 +CONSTANT: rt-this 5 CONSTANT: rt-immediate 6 CONSTANT: rt-stack-chain 7 diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index b27f3aee72..ebee48de5f 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -41,7 +41,7 @@ big-endian on stack-frame 6 LI 6 1 next-save STW 0 1 lr-save stack-frame + STW -] rc-absolute-ppc-2/2 rt-label 1 jit-prolog jit-define +] rc-absolute-ppc-2/2 rt-this 1 jit-prolog jit-define [ 0 6 LOAD32 diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 5e3405e93a..f5829d76ea 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -32,7 +32,7 @@ big-endian off temp0 PUSH ! alignment stack-reg stack-frame-size 3 bootstrap-cells - SUB -] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define +] rc-absolute-cell rt-this 1 rex-length + jit-prolog jit-define [ ! load literal diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index d7f6f1841a..8b22b9a885 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -45,10 +45,13 @@ ERROR: no-boundary ; ";" split1 nip "=" split1 nip [ no-boundary ] unless* ; +SYMBOL: upload-limit + : read-multipart-data ( request -- mime-parts ) [ "content-type" header ] [ "content-length" header string>number ] bi - unlimit-input + unlimited-input + upload-limit get stream-throws limit-input stream-eofs limit-input binary decode-input parse-multipart-form-data parse-multipart ; @@ -252,10 +255,13 @@ LOG: httpd-benchmark DEBUG TUPLE: http-server < threaded-server ; +SYMBOL: request-limit + +64 1024 * request-limit set-global + M: http-server handle-client* - drop - [ - 64 1024 * stream-throws limit-input + drop [ + request-limit get stream-throws limit-input ?refresh-all [ read-request ] ?benchmark [ do-request ] ?benchmark diff --git a/basis/io/encodings/iana/iana.factor b/basis/io/encodings/iana/iana.factor index b504bf854a..cb4627460c 100644 --- a/basis/io/encodings/iana/iana.factor +++ b/basis/io/encodings/iana/iana.factor @@ -10,10 +10,10 @@ SYMBOL: e>n-table SYMBOL: aliases PRIVATE> -: name>encoding ( name -- encoding/f ) +: name>encoding ( name -- encoding ) n>e-table get-global at ; -: encoding>name ( encoding -- name/f ) +: encoding>name ( encoding -- name ) e>n-table get-global at ; { $values - { "stream" "an input stream" } { "limit" integer } { "mode" "a " { $link limited-stream } " mode singleton" } + { "stream" "an input stream" } { "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } } { "stream'" "an input stream" } } { $description "Constructs a new " { $link limited-stream } " from an existing stream. User code should use " { $link limit } " or " { $link limit-input } "." } ; HELP: limit { $values - { "stream" "an input stream" } { "limit" integer } { "mode" "a " { $link limited-stream } " mode singleton" } + { "stream" "an input stream" } { "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } } { "stream'" "a stream" } } { $description "Changes a decoder's stream to be a limited stream, or wraps " { $snippet "stream" } " in a " { $link limited-stream } "." } @@ -36,7 +36,7 @@ HELP: limit } } ; -HELP: unlimit +HELP: unlimited { $values { "stream" "an input stream" } { "stream'" "a stream" } @@ -51,22 +51,22 @@ HELP: limited-stream HELP: limit-input { $values - { "limit" integer } { "mode" "a " { $link limited-stream } " mode singleton" } + { "limit" integer } { "mode" { $link stream-throws } " or " { $link stream-eofs } } } { $description "Wraps the current " { $link input-stream } " in a " { $link limited-stream } "." } ; -HELP: unlimit-input +HELP: unlimited-input { $description "Returns the underlying stream of the limited-stream stored in " { $link input-stream } "." } ; HELP: stream-eofs { $values - { "value" "a " { $link limited-stream } " mode singleton" } + { "value" { $link stream-throws } " or " { $link stream-eofs } } } { $description "If the " { $slot "mode" } " of a limited stream is set to this singleton, the stream will return " { $link f } " upon exhaustion." } ; HELP: stream-throws { $values - { "value" "a " { $link limited-stream } " mode singleton" } + { "value" { $link stream-throws } " or " { $link stream-eofs } } } { $description "If the " { $slot "mode" } " of a limited stream is set to this singleton, the stream will throw " { $link limit-exceeded } " upon exhaustion." } ; @@ -79,9 +79,9 @@ ARTICLE: "io.streams.limited" "Limited input streams" "Wrap the current " { $link input-stream } " in a limited stream:" { $subsection limit-input } "Unlimits a limited stream:" -{ $subsection unlimit } +{ $subsection unlimited } "Unlimits the current " { $link input-stream } ":" -{ $subsection unlimit-input } +{ $subsection unlimited-input } "Make a limited stream throw an exception on exhaustion:" { $subsection stream-throws } "Make a limited stream return " { $link f } " on exhaustion:" diff --git a/basis/io/streams/limited/limited-tests.factor b/basis/io/streams/limited/limited-tests.factor index feddc130e9..36c257fb5e 100644 --- a/basis/io/streams/limited/limited-tests.factor +++ b/basis/io/streams/limited/limited-tests.factor @@ -57,13 +57,13 @@ IN: io.streams.limited.tests [ t ] [ - "abc" 3 stream-eofs limit unlimit + "abc" 3 stream-eofs limit unlimited "abc" = ] unit-test [ t ] [ - "abc" 3 stream-eofs limit unlimit + "abc" 3 stream-eofs limit unlimited "abc" = ] unit-test @@ -71,7 +71,7 @@ IN: io.streams.limited.tests [ [ "resource:license.txt" utf8 &dispose - 3 stream-eofs limit unlimit + 3 stream-eofs limit unlimited "resource:license.txt" utf8 &dispose [ decoder? ] both? ] with-destructors diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor index 1237b3aba2..fe3dd9ad93 100755 --- a/basis/io/streams/limited/limited.factor +++ b/basis/io/streams/limited/limited.factor @@ -24,20 +24,20 @@ M: decoder limit ( stream limit mode -- stream' ) M: object limit ( stream limit mode -- stream' ) ; -GENERIC: unlimit ( stream -- stream' ) +GENERIC: unlimited ( stream -- stream' ) -M: decoder unlimit ( stream -- stream' ) +M: decoder unlimited ( stream -- stream' ) [ stream>> ] change-stream ; -M: object unlimit ( stream -- stream' ) +M: object unlimited ( stream -- stream' ) stream>> stream>> ; : limit-input ( limit mode -- ) input-stream [ -rot limit ] change ; -: unlimit-input ( -- ) input-stream [ unlimit ] change ; +: unlimited-input ( -- ) input-stream [ unlimited ] change ; : with-unlimited-stream ( stream quot -- ) - [ clone unlimit ] dip call ; inline + [ clone unlimited ] dip call ; inline : with-limited-stream ( stream limit mode quot -- ) [ limit ] dip call ; inline diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor index 3924cc7b83..0bd3663729 100644 --- a/basis/tools/profiler/profiler-tests.factor +++ b/basis/tools/profiler/profiler-tests.factor @@ -25,7 +25,7 @@ words ; : indirect-test ( callback -- ) "void" { } "cdecl" alien-indirect ; -: foobar ; +: foobar ( -- ) ; [ [ ] [ callback-test indirect-test ] unit-test @@ -34,9 +34,9 @@ words ; [ 1 ] [ \ foobar counter>> ] unit-test -: fooblah { } [ ] each ; +: fooblah ( -- ) { } [ ] like call ; -: foobaz fooblah fooblah ; +: foobaz ( -- ) fooblah fooblah ; [ foobaz ] profile diff --git a/extra/project-euler/050/050.factor b/extra/project-euler/050/050.factor index a97e16d0fa..0c5b288b65 100644 --- a/extra/project-euler/050/050.factor +++ b/extra/project-euler/050/050.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel locals math math.primes sequences ; +USING: arrays kernel locals math math.primes sequences project-euler.common ; IN: project-euler.050 ! http://projecteuler.net/index.php?section=problems&id=50 diff --git a/vm/callstack.c b/vm/callstack.c index ae3f524112..d44a889756 100755 --- a/vm/callstack.c +++ b/vm/callstack.c @@ -97,7 +97,7 @@ F_CODE_BLOCK *frame_code(F_STACK_FRAME *frame) CELL frame_type(F_STACK_FRAME *frame) { - return frame_code(frame)->type; + return frame_code(frame)->block.type; } CELL frame_executing(F_STACK_FRAME *frame) diff --git a/vm/code_block.c b/vm/code_block.c index a1369a3f99..a9b5277c84 100644 --- a/vm/code_block.c +++ b/vm/code_block.c @@ -1,9 +1,8 @@ #include "master.h" -void flush_icache_for(F_CODE_BLOCK *compiled) +void flush_icache_for(F_CODE_BLOCK *block) { - CELL start = (CELL)(compiled + 1); - flush_icache(start,compiled->code_length); + flush_icache((CELL)block,block->block.size); } void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter) @@ -12,12 +11,34 @@ void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter) { F_BYTE_ARRAY *relocation = untag_object(compiled->relocation); + CELL index = 1; + F_REL *rel = (F_REL *)(relocation + 1); F_REL *rel_end = (F_REL *)((char *)rel + byte_array_capacity(relocation)); while(rel < rel_end) { - iter(rel,compiled); + iter(*rel,index,compiled); + + switch(REL_TYPE(*rel)) + { + case RT_PRIMITIVE: + case RT_XT: + case RT_IMMEDIATE: + case RT_HERE: + index++; + break; + case RT_DLSYM: + index += 2; + break; + case RT_THIS: + case RT_STACK_CHAIN: + break; + default: + critical_error("Bad rel type",*rel); + return; /* Can't happen */ + } + rel++; } } @@ -86,13 +107,13 @@ void store_address_in_code_block(CELL class, CELL offset, F_FIXNUM absolute_valu } } -void update_literal_references_step(F_REL *rel, F_CODE_BLOCK *compiled) +void update_literal_references_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled) { if(REL_TYPE(rel) == RT_IMMEDIATE) { - CELL offset = rel->offset + (CELL)(compiled + 1); + CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1); F_ARRAY *literals = untag_object(compiled->literals); - F_FIXNUM absolute_value = array_nth(literals,REL_ARGUMENT(rel)); + F_FIXNUM absolute_value = array_nth(literals,index); store_address_in_code_block(REL_CLASS(rel),offset,absolute_value); } } @@ -108,12 +129,12 @@ void update_literal_references(F_CODE_BLOCK *compiled) aging and nursery collections */ void copy_literal_references(F_CODE_BLOCK *compiled) { - if(collecting_gen >= compiled->last_scan) + if(collecting_gen >= compiled->block.last_scan) { if(collecting_accumulation_gen_p()) - compiled->last_scan = collecting_gen; + compiled->block.last_scan = collecting_gen; else - compiled->last_scan = collecting_gen + 1; + compiled->block.last_scan = collecting_gen + 1; /* initialize chase pointer */ CELL scan = newspace->here; @@ -137,13 +158,13 @@ CELL object_xt(CELL obj) return (CELL)untag_quotation(obj)->xt; } -void update_word_references_step(F_REL *rel, F_CODE_BLOCK *compiled) +void update_word_references_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled) { if(REL_TYPE(rel) == RT_XT) { - CELL offset = rel->offset + (CELL)(compiled + 1); + CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1); F_ARRAY *literals = untag_object(compiled->literals); - CELL xt = object_xt(array_nth(literals,REL_ARGUMENT(rel))); + CELL xt = object_xt(array_nth(literals,index)); store_address_in_code_block(REL_CLASS(rel),offset,xt); } } @@ -154,7 +175,7 @@ to update references to other words, without worrying about literals or dlsyms. */ void update_word_references(F_CODE_BLOCK *compiled) { - if(compiled->needs_fixup) + if(compiled->block.needs_fixup) relocate_code_block(compiled); else { @@ -170,7 +191,7 @@ is added to the heap. */ collections */ void mark_code_block(F_CODE_BLOCK *compiled) { - mark_block(compiled_to_block(compiled)); + mark_block(&compiled->block); copy_handle(&compiled->literals); copy_handle(&compiled->relocation); @@ -229,11 +250,10 @@ void undefined_symbol(void) } /* Look up an external library symbol referenced by a compiled code block */ -void *get_rel_symbol(F_REL *rel, F_ARRAY *literals) +void *get_rel_symbol(F_ARRAY *literals, CELL index) { - CELL arg = REL_ARGUMENT(rel); - CELL symbol = array_nth(literals,arg); - CELL library = array_nth(literals,arg + 1); + CELL symbol = array_nth(literals,index); + CELL library = array_nth(literals,index + 1); F_DLL *dll = (library == F ? NULL : untag_dll(library)); @@ -266,37 +286,37 @@ void *get_rel_symbol(F_REL *rel, F_ARRAY *literals) } /* Compute an address to store at a relocation */ -void relocate_code_block_step(F_REL *rel, F_CODE_BLOCK *compiled) +void relocate_code_block_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled) { - CELL offset = rel->offset + (CELL)(compiled + 1); + CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1); F_ARRAY *literals = untag_object(compiled->literals); F_FIXNUM absolute_value; switch(REL_TYPE(rel)) { case RT_PRIMITIVE: - absolute_value = (CELL)primitives[REL_ARGUMENT(rel)]; + absolute_value = (CELL)primitives[to_fixnum(array_nth(literals,index))]; break; case RT_DLSYM: - absolute_value = (CELL)get_rel_symbol(rel,literals); + absolute_value = (CELL)get_rel_symbol(literals,index); break; case RT_IMMEDIATE: - absolute_value = array_nth(literals,REL_ARGUMENT(rel)); + absolute_value = array_nth(literals,index); break; case RT_XT: - absolute_value = object_xt(array_nth(literals,REL_ARGUMENT(rel))); + absolute_value = object_xt(array_nth(literals,index)); break; case RT_HERE: - absolute_value = rel->offset + (CELL)(compiled + 1) + (short)REL_ARGUMENT(rel); + absolute_value = offset + (short)to_fixnum(array_nth(literals,index)); break; - case RT_LABEL: - absolute_value = (CELL)(compiled + 1) + REL_ARGUMENT(rel); + case RT_THIS: + absolute_value = (CELL)(compiled + 1); break; case RT_STACK_CHAIN: absolute_value = (CELL)&stack_chain; break; default: - critical_error("Bad rel type",rel->type); + critical_error("Bad rel type",rel); return; /* Can't happen */ } @@ -306,8 +326,8 @@ void relocate_code_block_step(F_REL *rel, F_CODE_BLOCK *compiled) /* Perform all fixups on a code block */ void relocate_code_block(F_CODE_BLOCK *compiled) { - compiled->last_scan = NURSERY; - compiled->needs_fixup = false; + compiled->block.last_scan = NURSERY; + compiled->block.needs_fixup = false; iterate_relocations(compiled,relocate_code_block_step); flush_icache_for(compiled); } @@ -361,18 +381,18 @@ CELL compiled_code_format(void) } /* Might GC */ -void *allot_code_block(CELL size) +F_CODE_BLOCK *allot_code_block(CELL size) { - void *start = heap_allot(&code_heap,size); + F_BLOCK *block = heap_allot(&code_heap,size + sizeof(F_CODE_BLOCK)); /* If allocation failed, do a code GC */ - if(start == NULL) + if(block == NULL) { gc(); - start = heap_allot(&code_heap,size); + block = heap_allot(&code_heap,size + sizeof(F_CODE_BLOCK)); /* Insufficient room even after code GC, give up */ - if(start == NULL) + if(block == NULL) { CELL used, total_free, max_free; heap_usage(&code_heap,&used,&total_free,&max_free); @@ -385,11 +405,11 @@ void *allot_code_block(CELL size) } } - return start; + return (F_CODE_BLOCK *)block; } /* Might GC */ -F_CODE_BLOCK *add_compiled_block( +F_CODE_BLOCK *add_code_block( CELL type, F_ARRAY *code, F_ARRAY *labels, @@ -404,7 +424,7 @@ F_CODE_BLOCK *add_compiled_block( REGISTER_UNTAGGED(code); REGISTER_UNTAGGED(labels); - F_CODE_BLOCK *compiled = allot_code_block(sizeof(F_CODE_BLOCK) + code_length); + F_CODE_BLOCK *compiled = allot_code_block(code_length); UNREGISTER_UNTAGGED(labels); UNREGISTER_UNTAGGED(code); @@ -412,10 +432,9 @@ F_CODE_BLOCK *add_compiled_block( UNREGISTER_ROOT(literals); /* compiled header */ - compiled->type = type; - compiled->last_scan = NURSERY; - compiled->needs_fixup = true; - compiled->code_length = code_length; + compiled->block.type = type; + compiled->block.last_scan = NURSERY; + compiled->block.needs_fixup = true; compiled->literals = literals; compiled->relocation = relocation; diff --git a/vm/code_block.h b/vm/code_block.h index 5ebe04f9c3..b00e4be8b6 100644 --- a/vm/code_block.h +++ b/vm/code_block.h @@ -9,8 +9,8 @@ typedef enum { RT_XT, /* current offset */ RT_HERE, - /* a local label */ - RT_LABEL, + /* current code block */ + RT_THIS, /* immediate literal */ RT_IMMEDIATE, /* address of stack_chain var */ @@ -43,21 +43,15 @@ typedef enum { #define REL_INDIRECT_ARM_MASK 0xfff #define REL_RELATIVE_ARM_3_MASK 0xffffff -/* the rel type is built like a cell to avoid endian-specific code in -the compiler */ -#define REL_TYPE(r) ((r)->type & 0x000000ff) -#define REL_CLASS(r) (((r)->type & 0x0000ff00) >> 8) -#define REL_ARGUMENT(r) (((r)->type & 0xffff0000) >> 16) - -/* code relocation consists of a table of entries for each fixup */ -typedef struct { - unsigned int type; - unsigned int offset; -} F_REL; +/* code relocation table consists of a table of entries for each fixup */ +typedef u32 F_REL; +#define REL_TYPE(r) (((r) & 0xf0000000) >> 28) +#define REL_CLASS(r) (((r) & 0x0f000000) >> 24) +#define REL_OFFSET(r) ((r) & 0x00ffffff) void flush_icache_for(F_CODE_BLOCK *compiled); -typedef void (*RELOCATION_ITERATOR)(F_REL *rel, F_CODE_BLOCK *compiled); +typedef void (*RELOCATION_ITERATOR)(F_REL rel, CELL index, F_CODE_BLOCK *compiled); void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter); @@ -83,7 +77,7 @@ CELL compiled_code_format(void); bool stack_traces_p(void); -F_CODE_BLOCK *add_compiled_block( +F_CODE_BLOCK *add_code_block( CELL type, F_ARRAY *code, F_ARRAY *labels, diff --git a/vm/code_gc.c b/vm/code_gc.c index 8c734c263c..c3c5bc9a10 100755 --- a/vm/code_gc.c +++ b/vm/code_gc.c @@ -13,7 +13,7 @@ void new_heap(F_HEAP *heap, CELL size) /* If there is no previous block, next_free becomes the head of the free list, else its linked in */ -INLINE void update_free_list(F_HEAP *heap, F_BLOCK *prev, F_BLOCK *next_free) +INLINE void update_free_list(F_HEAP *heap, F_FREE_BLOCK *prev, F_FREE_BLOCK *next_free) { if(prev) prev->next_free = next_free; @@ -28,18 +28,18 @@ compiling.limit. */ void build_free_list(F_HEAP *heap, CELL size) { F_BLOCK *prev = NULL; - F_BLOCK *prev_free = NULL; + F_FREE_BLOCK *prev_free = NULL; F_BLOCK *scan = first_block(heap); - F_BLOCK *end = (F_BLOCK *)(heap->segment->start + size); + F_FREE_BLOCK *end = (F_FREE_BLOCK *)(heap->segment->start + size); /* Add all free blocks to the free list */ - while(scan && scan < end) + while(scan && scan < (F_BLOCK *)end) { switch(scan->status) { case B_FREE: - update_free_list(heap,prev_free,scan); - prev_free = scan; + update_free_list(heap,prev_free,(F_FREE_BLOCK *)scan); + prev_free = (F_FREE_BLOCK *)scan; break; case B_ALLOCATED: break; @@ -56,9 +56,9 @@ void build_free_list(F_HEAP *heap, CELL size) branch is only taken after loading a new image, not after code GC */ if((CELL)(end + 1) <= heap->segment->end) { - end->status = B_FREE; + end->block.status = B_FREE; + end->block.size = heap->segment->end - (CELL)end; end->next_free = NULL; - end->size = heap->segment->end - (CELL)end; /* add final free block */ update_free_list(heap,prev_free,end); @@ -80,21 +80,19 @@ void build_free_list(F_HEAP *heap, CELL size) } /* Allocate a block of memory from the mark and sweep GC heap */ -void *heap_allot(F_HEAP *heap, CELL size) +F_BLOCK *heap_allot(F_HEAP *heap, CELL size) { - F_BLOCK *prev = NULL; - F_BLOCK *scan = heap->free_list; + F_FREE_BLOCK *prev = NULL; + F_FREE_BLOCK *scan = heap->free_list; size = (size + 31) & ~31; while(scan) { - CELL this_size = scan->size - sizeof(F_BLOCK); - - if(scan->status != B_FREE) + if(scan->block.status != B_FREE) critical_error("Invalid block in free list",(CELL)scan); - if(this_size < size) + if(scan->block.size < size) { prev = scan; scan = scan->next_free; @@ -102,9 +100,9 @@ void *heap_allot(F_HEAP *heap, CELL size) } /* we found a candidate block */ - F_BLOCK *next_free; + F_FREE_BLOCK *next_free; - if(this_size - size <= sizeof(F_BLOCK)) + if(scan->block.size - size <= sizeof(F_BLOCK) * 2) { /* too small to be split */ next_free = scan->next_free; @@ -112,12 +110,11 @@ void *heap_allot(F_HEAP *heap, CELL size) else { /* split the block in two */ - CELL new_size = size + sizeof(F_BLOCK); - F_BLOCK *split = (F_BLOCK *)((CELL)scan + new_size); - split->status = B_FREE; - split->size = scan->size - new_size; + F_FREE_BLOCK *split = (F_FREE_BLOCK *)((CELL)scan + size); + split->block.status = B_FREE; + split->block.size = scan->block.size - size; split->next_free = scan->next_free; - scan->size = new_size; + scan->block.size = size; next_free = split; } @@ -125,9 +122,8 @@ void *heap_allot(F_HEAP *heap, CELL size) update_free_list(heap,prev,next_free); /* this is our new block */ - scan->status = B_ALLOCATED; - - return scan + 1; + scan->block.status = B_ALLOCATED; + return &scan->block; } return NULL; diff --git a/vm/code_gc.h b/vm/code_gc.h index 4d4637d0e1..cc2c42f120 100644 --- a/vm/code_gc.h +++ b/vm/code_gc.h @@ -1,32 +1,11 @@ -typedef enum -{ - B_FREE, - B_ALLOCATED, - B_MARKED -} F_BLOCK_STATUS; - -typedef struct _F_BLOCK -{ - F_BLOCK_STATUS status; - - /* In bytes, includes this header */ - CELL size; - - /* Filled in on image load */ - struct _F_BLOCK *next_free; - - /* Used during compaction */ - struct _F_BLOCK *forwarding; -} F_BLOCK; - typedef struct { F_SEGMENT *segment; - F_BLOCK *free_list; + F_FREE_BLOCK *free_list; } F_HEAP; void new_heap(F_HEAP *heap, CELL size); void build_free_list(F_HEAP *heap, CELL size); -void *heap_allot(F_HEAP *heap, CELL size); +F_BLOCK *heap_allot(F_HEAP *heap, CELL size); void mark_block(F_BLOCK *block); void unmark_marked(F_HEAP *heap); void free_unmarked(F_HEAP *heap); diff --git a/vm/code_heap.c b/vm/code_heap.c index 325aed5037..65a28c6de3 100755 --- a/vm/code_heap.c +++ b/vm/code_heap.c @@ -14,7 +14,7 @@ bool in_code_heap_p(CELL ptr) void set_word_code(F_WORD *word, F_CODE_BLOCK *compiled) { - if(compiled->type != WORD_TYPE) + if(compiled->block.type != WORD_TYPE) critical_error("bad param to set_word_xt",(CELL)compiled); word->code = compiled; @@ -40,7 +40,7 @@ void iterate_code_heap(CODE_HEAP_ITERATOR iter) while(scan) { if(scan->status != B_FREE) - iter(block_to_compiled(scan)); + iter((F_CODE_BLOCK *)scan); scan = next_block(&code_heap,scan); } } @@ -103,7 +103,7 @@ void primitive_modify_code_heap(void) REGISTER_UNTAGGED(alist); REGISTER_UNTAGGED(word); - F_CODE_BLOCK *compiled = add_compiled_block( + F_CODE_BLOCK *compiled = add_code_block( WORD_TYPE, code, labels, @@ -137,7 +137,7 @@ void primitive_code_room(void) F_CODE_BLOCK *forward_xt(F_CODE_BLOCK *compiled) { - return block_to_compiled(compiled_to_block(compiled)->forwarding); + return (F_CODE_BLOCK *)compiled->block.forwarding; } void forward_frame_xt(F_STACK_FRAME *frame) diff --git a/vm/code_heap.h b/vm/code_heap.h index 17a32aedd3..4f52819547 100755 --- a/vm/code_heap.h +++ b/vm/code_heap.h @@ -1,16 +1,6 @@ /* compiled code */ F_HEAP code_heap; -INLINE F_BLOCK *compiled_to_block(F_CODE_BLOCK *compiled) -{ - return (F_BLOCK *)compiled - 1; -} - -INLINE F_CODE_BLOCK *block_to_compiled(F_BLOCK *block) -{ - return (F_CODE_BLOCK *)(block + 1); -} - void init_code_heap(CELL size); bool in_code_heap_p(CELL ptr); diff --git a/vm/data_gc.h b/vm/data_gc.h index 06beb7ea33..354c9398a5 100755 --- a/vm/data_gc.h +++ b/vm/data_gc.h @@ -30,7 +30,7 @@ u64 decks_scanned; CELL code_heap_scans; /* What generation was being collected when copy_code_heap_roots() was last -called? Until the next call to add_compiled_block(), future +called? Until the next call to add_code_block(), future collections of younger generations don't have to touch the code heap. */ CELL last_code_heap_scan; diff --git a/vm/debug.c b/vm/debug.c index 6b72b97bec..adae1cdd36 100755 --- a/vm/debug.c +++ b/vm/debug.c @@ -324,11 +324,11 @@ void dump_code_heap(void) status = "free"; break; case B_ALLOCATED: - size += object_size(block_to_compiled(scan)->relocation); + size += object_size(((F_CODE_BLOCK *)scan)->relocation); status = "allocated"; break; case B_MARKED: - size += object_size(block_to_compiled(scan)->relocation); + size += object_size(((F_CODE_BLOCK *)scan)->relocation); status = "marked"; break; default: diff --git a/vm/layouts.h b/vm/layouts.h index 5b417f92dd..e9cdef6272 100755 --- a/vm/layouts.h +++ b/vm/layouts.h @@ -102,12 +102,38 @@ typedef struct { } F_STRING; /* The compiled code heap is structured into blocks. */ -typedef struct +typedef enum { + B_FREE, + B_ALLOCATED, + B_MARKED +} F_BLOCK_STATUS; + +typedef struct _F_BLOCK +{ + char status; /* free or allocated? */ char type; /* this is WORD_TYPE or QUOTATION_TYPE */ char last_scan; /* the youngest generation in which this block's literals may live */ char needs_fixup; /* is this a new block that needs full fixup? */ - CELL code_length; /* # bytes */ + + /* In bytes, includes this header */ + CELL size; + + /* Used during compaction */ + struct _F_BLOCK *forwarding; +} F_BLOCK; + +typedef struct _F_FREE_BLOCK +{ + F_BLOCK block; + + /* Filled in on image load */ + struct _F_FREE_BLOCK *next_free; +} F_FREE_BLOCK; + +typedef struct +{ + F_BLOCK block; CELL literals; /* # bytes */ CELL relocation; /* tagged pointer to byte-array or f */ } F_CODE_BLOCK; diff --git a/vm/profiler.c b/vm/profiler.c index 66cefcf891..acafecdff5 100755 --- a/vm/profiler.c +++ b/vm/profiler.c @@ -3,7 +3,7 @@ /* Allocates memory */ F_CODE_BLOCK *compile_profiling_stub(F_WORD *word) { - CELL literals = allot_array_1(tag_object(word)); + CELL literals = allot_array_2(tag_object(word),tag_object(word)); REGISTER_ROOT(literals); F_ARRAY *quadruple = untag_object(userenv[JIT_PROFILING]); @@ -11,17 +11,17 @@ F_CODE_BLOCK *compile_profiling_stub(F_WORD *word) CELL code = array_nth(quadruple,0); REGISTER_ROOT(code); - F_REL rel; - rel.type = to_fixnum(array_nth(quadruple,2)) | (to_fixnum(array_nth(quadruple,1)) << 8); - rel.offset = to_fixnum(array_nth(quadruple,3)) * compiled_code_format(); + F_REL rel = (to_fixnum(array_nth(quadruple,1)) << 24) + | (to_fixnum(array_nth(quadruple,2)) << 28) + | (to_fixnum(array_nth(quadruple,3)) * compiled_code_format()); F_BYTE_ARRAY *relocation = allot_byte_array(sizeof(F_REL)); - memcpy((void *)BREF(relocation,0),&rel,sizeof(F_REL)); + memcpy(relocation + 1,&rel,sizeof(F_REL)); UNREGISTER_ROOT(code); UNREGISTER_ROOT(literals); - return add_compiled_block( + return add_code_block( WORD_TYPE, untag_object(code), NULL, /* no labels */ diff --git a/vm/quotations.c b/vm/quotations.c index 8ea2d5839b..86e47745b7 100755 --- a/vm/quotations.c +++ b/vm/quotations.c @@ -94,37 +94,30 @@ F_ARRAY *code_to_emit(CELL code) return untag_object(array_nth(untag_object(code),0)); } -F_REL rel_to_emit(CELL code, CELL code_format, CELL code_length, - CELL rel_argument, bool *rel_p) +F_REL rel_to_emit(CELL code, CELL code_format, CELL code_length, bool *rel_p) { F_ARRAY *quadruple = untag_object(code); CELL rel_class = array_nth(quadruple,1); CELL rel_type = array_nth(quadruple,2); CELL offset = array_nth(quadruple,3); - F_REL rel; - if(rel_class == F) { *rel_p = false; - rel.type = 0; - rel.offset = 0; + return 0; } else { *rel_p = true; - rel.type = to_fixnum(rel_type) - | (to_fixnum(rel_class) << 8) - | (rel_argument << 16); - rel.offset = (code_length + to_fixnum(offset)) * code_format; + return (to_fixnum(rel_type) << 28) + | (to_fixnum(rel_class) << 24) + | ((code_length + to_fixnum(offset)) * code_format); } - - return rel; } -#define EMIT(name,rel_argument) { \ +#define EMIT(name) { \ bool rel_p; \ - F_REL rel = rel_to_emit(name,code_format,code_count,rel_argument,&rel_p); \ + F_REL rel = rel_to_emit(name,code_format,code_count,&rel_p); \ if(rel_p) GROWABLE_BYTE_ARRAY_APPEND(relocation,&rel,sizeof(F_REL)); \ GROWABLE_ARRAY_APPEND(code,code_to_emit(name)); \ } @@ -157,8 +150,8 @@ bool jit_stack_frame_p(F_ARRAY *array) void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code) { - if(code->type != QUOTATION_TYPE) - critical_error("bad param to set_quot_xt",(CELL)code); + if(code->block.type != QUOTATION_TYPE) + critical_error("Bad param to set_quot_xt",(CELL)code); quot->code = code; quot->xt = (XT)(code + 1); @@ -192,7 +185,7 @@ void jit_compile(CELL quot, bool relocate) bool stack_frame = jit_stack_frame_p(untag_object(array)); if(stack_frame) - EMIT(userenv[JIT_PROLOG],0); + EMIT(userenv[JIT_PROLOG]); CELL i; CELL length = array_capacity(untag_object(array)); @@ -217,35 +210,36 @@ void jit_compile(CELL quot, bool relocate) GROWABLE_ARRAY_ADD(literals,T); } - EMIT(word->subprimitive,literals_count - 1); + EMIT(word->subprimitive); } else { - GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); + GROWABLE_ARRAY_ADD(literals,obj); if(i == length - 1) { if(stack_frame) - EMIT(userenv[JIT_EPILOG],0); + EMIT(userenv[JIT_EPILOG]); - EMIT(userenv[JIT_WORD_JUMP],literals_count - 1); + EMIT(userenv[JIT_WORD_JUMP]); tail_call = true; } else - EMIT(userenv[JIT_WORD_CALL],literals_count - 1); + EMIT(userenv[JIT_WORD_CALL]); } break; case WRAPPER_TYPE: wrapper = untag_object(obj); GROWABLE_ARRAY_ADD(literals,wrapper->object); - EMIT(userenv[JIT_PUSH_IMMEDIATE],literals_count - 1); + EMIT(userenv[JIT_PUSH_IMMEDIATE]); break; case FIXNUM_TYPE: if(jit_primitive_call_p(untag_object(array),i)) { - EMIT(userenv[JIT_SAVE_STACK],0); - EMIT(userenv[JIT_PRIMITIVE],to_fixnum(obj)); + EMIT(userenv[JIT_SAVE_STACK]); + GROWABLE_ARRAY_ADD(literals,obj); + EMIT(userenv[JIT_PRIMITIVE]); i++; @@ -256,15 +250,15 @@ void jit_compile(CELL quot, bool relocate) if(jit_fast_if_p(untag_object(array),i)) { if(stack_frame) - EMIT(userenv[JIT_EPILOG],0); + EMIT(userenv[JIT_EPILOG]); jit_compile(array_nth(untag_object(array),i),relocate); jit_compile(array_nth(untag_object(array),i + 1),relocate); GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT(userenv[JIT_IF_1],literals_count - 1); + EMIT(userenv[JIT_IF_1]); GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i + 1)); - EMIT(userenv[JIT_IF_2],literals_count - 1); + EMIT(userenv[JIT_IF_2]); i += 2; @@ -276,7 +270,7 @@ void jit_compile(CELL quot, bool relocate) jit_compile(obj,relocate); GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT(userenv[JIT_DIP],literals_count - 1); + EMIT(userenv[JIT_DIP]); i++; break; @@ -286,7 +280,7 @@ void jit_compile(CELL quot, bool relocate) jit_compile(obj,relocate); GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT(userenv[JIT_2DIP],literals_count - 1); + EMIT(userenv[JIT_2DIP]); i++; break; @@ -296,7 +290,7 @@ void jit_compile(CELL quot, bool relocate) jit_compile(obj,relocate); GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT(userenv[JIT_3DIP],literals_count - 1); + EMIT(userenv[JIT_3DIP]); i++; break; @@ -305,10 +299,10 @@ void jit_compile(CELL quot, bool relocate) if(jit_fast_dispatch_p(untag_object(array),i)) { if(stack_frame) - EMIT(userenv[JIT_EPILOG],0); + EMIT(userenv[JIT_EPILOG]); GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT(userenv[JIT_DISPATCH],literals_count - 1); + EMIT(userenv[JIT_DISPATCH]); i++; @@ -322,7 +316,7 @@ void jit_compile(CELL quot, bool relocate) } default: GROWABLE_ARRAY_ADD(literals,obj); - EMIT(userenv[JIT_PUSH_IMMEDIATE],literals_count - 1); + EMIT(userenv[JIT_PUSH_IMMEDIATE]); break; } } @@ -330,16 +324,16 @@ void jit_compile(CELL quot, bool relocate) if(!tail_call) { if(stack_frame) - EMIT(userenv[JIT_EPILOG],0); + EMIT(userenv[JIT_EPILOG]); - EMIT(userenv[JIT_RETURN],0); + EMIT(userenv[JIT_RETURN]); } GROWABLE_ARRAY_TRIM(code); GROWABLE_ARRAY_TRIM(literals); GROWABLE_BYTE_ARRAY_TRIM(relocation); - F_CODE_BLOCK *compiled = add_compiled_block( + F_CODE_BLOCK *compiled = add_code_block( QUOTATION_TYPE, untag_object(code), NULL, diff --git a/vm/types.c b/vm/types.c index 2f8cafb768..119dc675bc 100755 --- a/vm/types.c +++ b/vm/types.c @@ -81,7 +81,7 @@ void primitive_word_xt(void) F_WORD *word = untag_word(dpop()); F_CODE_BLOCK *code = (profiling_p ? word->profiling : word->code); dpush(allot_cell((CELL)code + sizeof(F_CODE_BLOCK))); - dpush(allot_cell((CELL)code + sizeof(F_CODE_BLOCK) + code->code_length)); + dpush(allot_cell((CELL)code + code->block.size)); } void primitive_wrapper(void) @@ -139,6 +139,18 @@ CELL allot_array_1(CELL obj) return tag_object(a); } +CELL allot_array_2(CELL v1, CELL v2) +{ + REGISTER_ROOT(v1); + REGISTER_ROOT(v2); + F_ARRAY *a = allot_array_internal(ARRAY_TYPE,2); + UNREGISTER_ROOT(v2); + UNREGISTER_ROOT(v1); + set_array_nth(a,0,v1); + set_array_nth(a,1,v2); + return tag_object(a); +} + CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4) { REGISTER_ROOT(v1); diff --git a/vm/types.h b/vm/types.h index 5850489a4c..2775f57bb2 100755 --- a/vm/types.h +++ b/vm/types.h @@ -109,6 +109,7 @@ F_ARRAY *allot_array(CELL type, CELL capacity, CELL fill); F_BYTE_ARRAY *allot_byte_array(CELL size); CELL allot_array_1(CELL obj); +CELL allot_array_2(CELL v1, CELL v2); CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4); void primitive_array(void);