Merge branch 'master' of factorcode.org:/git/factor
commit
9fca06209a
|
@ -10,8 +10,10 @@ ARTICLE: "combinators-quot" "Quotation construction utilities"
|
|||
{ $subsection alist>quot } ;
|
||||
|
||||
ARTICLE: "combinators" "Additional combinators"
|
||||
"The " { $vocab-link "combinators" } " vocabulary provides generalizations of certain combinators from the " { $vocab-link "kernel" } " vocabulary."
|
||||
"The " { $vocab-link "combinators" } " vocabulary provides a few useful combinators."
|
||||
$nl
|
||||
"A looping combinator:"
|
||||
{ $subsection while }
|
||||
"Generalization of " { $link bi } " and " { $link tri } ":"
|
||||
{ $subsection cleave }
|
||||
"Generalization of " { $link bi* } " and " { $link tri* } ":"
|
||||
|
|
|
@ -1,14 +1,10 @@
|
|||
USING: help.syntax help.markup generator.fixup math kernel
|
||||
words strings alien ;
|
||||
words strings alien byte-array ;
|
||||
|
||||
HELP: frame-required
|
||||
{ $values { "n" "a non-negative integer" } }
|
||||
{ $description "Notify the code generator that the currently compiling code block needs a stack frame with room for at least " { $snippet "n" } " parameters." } ;
|
||||
|
||||
HELP: (rel-fixup)
|
||||
{ $values { "arg" integer } { "class" "a relocation class" } { "type" "a relocation type" } { "offset" integer } { "pair" "a pair of integers" } }
|
||||
{ $description "Creates a relocation instruction for the VM's runtime compiled code linker." } ;
|
||||
|
||||
HELP: add-literal
|
||||
{ $values { "obj" object } { "n" integer } }
|
||||
{ $description "Adds a literal to the " { $link literal-table } ", if it is not already there, and outputs the index of the literal in the table. This literal can then be used as an argument for a " { $link rt-literal } " relocation with " { $link rel-fixup } "." } ;
|
||||
|
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays generic assocs hashtables
|
||||
USING: arrays byte-arrays generic assocs hashtables io.binary
|
||||
kernel kernel.private math namespaces sequences words
|
||||
quotations strings alien.strings layouts system combinators
|
||||
math.bitfields words.private cpu.architecture math.order ;
|
||||
quotations strings alien.accessors alien.strings layouts system
|
||||
combinators math.bitfields words.private cpu.architecture
|
||||
math.order accessors growable ;
|
||||
IN: generator.fixup
|
||||
|
||||
: no-stack-frame -1 ; inline
|
||||
|
@ -77,26 +78,23 @@ TUPLE: label-fixup label class ;
|
|||
: label-fixup ( label class -- ) \ label-fixup boa , ;
|
||||
|
||||
M: label-fixup fixup*
|
||||
dup label-fixup-class rc-absolute?
|
||||
dup class>> rc-absolute?
|
||||
[ "Absolute labels not supported" throw ] when
|
||||
dup label-fixup-label swap label-fixup-class
|
||||
compiled-offset 4 - rot 3array label-table get push ;
|
||||
dup label>> swap class>> compiled-offset 4 - rot
|
||||
3array label-table get push ;
|
||||
|
||||
TUPLE: rel-fixup arg class type ;
|
||||
|
||||
: rel-fixup ( arg class type -- ) \ rel-fixup boa , ;
|
||||
|
||||
: (rel-fixup) ( arg class type offset -- pair )
|
||||
pick rc-absolute-cell = cell 4 ? -
|
||||
>r { 0 8 16 } bitfield r>
|
||||
2array ;
|
||||
: push-4 ( value vector -- )
|
||||
[ length ] [ B{ 0 0 0 0 } swap push-all ] [ underlying ] tri
|
||||
swap set-alien-unsigned-4 ;
|
||||
|
||||
M: rel-fixup fixup*
|
||||
dup rel-fixup-arg
|
||||
over rel-fixup-class
|
||||
rot rel-fixup-type
|
||||
compiled-offset (rel-fixup)
|
||||
relocation-table get push-all ;
|
||||
[ [ arg>> ] [ class>> ] [ type>> ] tri { 0 8 16 } bitfield ]
|
||||
[ class>> rc-absolute-cell = cell 4 ? compiled-offset swap - ] bi
|
||||
[ relocation-table get push-4 ] bi@ ;
|
||||
|
||||
M: frame-required fixup* drop ;
|
||||
|
||||
|
@ -134,7 +132,7 @@ SYMBOL: literal-table
|
|||
0 swap rt-here rel-fixup ;
|
||||
|
||||
: init-fixup ( -- )
|
||||
V{ } clone relocation-table set
|
||||
BV{ } clone relocation-table set
|
||||
V{ } clone label-table set ;
|
||||
|
||||
: resolve-labels ( labels -- labels' )
|
||||
|
@ -150,6 +148,6 @@ SYMBOL: literal-table
|
|||
dup stack-frame-size swap [ fixup* ] each drop
|
||||
|
||||
literal-table get >array
|
||||
relocation-table get >array
|
||||
relocation-table get >byte-array
|
||||
label-table get resolve-labels
|
||||
] { } make ;
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
USING: help.markup help.syntax io math ;
|
||||
USING: help.markup help.syntax io math byte-arrays ;
|
||||
IN: io.binary
|
||||
|
||||
ARTICLE: "stream-binary" "Working with binary data"
|
||||
"The core stream words read and write strings. Packed binary integers can be read and written by converting to and from sequences of bytes. Floating point numbers can be read and written by converting them into a their bitwise integer representation (" { $link "floats" } ")."
|
||||
"Stream words on binary streams only read and write byte arrays. Packed binary integers can be read and written by converting to and from sequences of bytes. Floating point numbers can be read and written by converting them into a their bitwise integer representation (" { $link "floats" } ")."
|
||||
$nl
|
||||
"There are two ways to order the bytes making up an integer; " { $emphasis "little endian" } " byte order outputs the least significant byte first, and the most significant byte last, whereas " { $emphasis "big endian" } " is the other way around."
|
||||
$nl
|
||||
|
@ -42,11 +42,11 @@ HELP: nth-byte
|
|||
{ $description "Outputs the " { $snippet "n" } "th least significant byte of the sign-extended 2's complement representation of " { $snippet "x" } "." } ;
|
||||
|
||||
HELP: >le
|
||||
{ $values { "x" integer } { "n" "a non-negative integer" } { "str" "a string" } }
|
||||
{ $values { "x" integer } { "n" "a non-negative integer" } { "byte-array" byte-array } }
|
||||
{ $description "Converts an integer " { $snippet "x" } " into a string of " { $snippet "n" } " bytes in little endian order. Truncation will occur if the integer is not in the range " { $snippet "[-2^(8n),2^(8n))" } "." } ;
|
||||
|
||||
HELP: >be
|
||||
{ $values { "x" integer } { "n" "a non-negative integer" } { "str" "a string" } }
|
||||
{ $values { "x" integer } { "n" "a non-negative integer" } { "byte-array" byte-array } }
|
||||
{ $description "Converts an integer " { $snippet "x" } " into a string of " { $snippet "n" } " bytes in big endian order. Truncation will occur if the integer is not in the range " { $snippet "[-2^(8n),2^(8n))" } "." } ;
|
||||
|
||||
HELP: mask-byte
|
||||
|
|
|
@ -10,8 +10,8 @@ IN: io.binary
|
|||
|
||||
: nth-byte ( x n -- b ) -8 * shift mask-byte ; inline
|
||||
|
||||
: >le ( x n -- str ) [ nth-byte ] with B{ } map-as ;
|
||||
: >be ( x n -- str ) >le dup reverse-here ;
|
||||
: >le ( x n -- byte-array ) [ nth-byte ] with B{ } map-as ;
|
||||
: >be ( x n -- byte-array ) >le dup reverse-here ;
|
||||
|
||||
: d>w/w ( d -- w1 w2 )
|
||||
dup HEX: ffffffff bitand
|
||||
|
|
|
@ -193,10 +193,7 @@ ARTICLE: "implementing-combinators" "Implementing combinators"
|
|||
": keep ( x quot -- x )"
|
||||
" over >r call r> ; inline"
|
||||
}
|
||||
"Word inlining is documented in " { $link "declarations" } "."
|
||||
$nl
|
||||
"A looping combinator:"
|
||||
{ $subsection while } ;
|
||||
"Word inlining is documented in " { $link "declarations" } "." ;
|
||||
|
||||
ARTICLE: "booleans" "Booleans"
|
||||
"In Factor, any object that is not " { $link f } " has a true value, and " { $link f } " has a false value. The " { $link t } " object is the canonical true value."
|
||||
|
|
|
@ -4,7 +4,7 @@ USING: calendar io io.files kernel math math.order
|
|||
math.parser http http.server namespaces parser sequences strings
|
||||
assocs hashtables debugger http.mime sorting html.elements
|
||||
html.templates.fhtml logging calendar.format accessors
|
||||
io.encodings.binary fry xml.entities ;
|
||||
io.encodings.binary fry xml.entities destructors ;
|
||||
IN: http.server.static
|
||||
|
||||
! special maps mime types to quots with effect ( path -- )
|
||||
|
@ -29,16 +29,14 @@ TUPLE: file-responder root hook special allow-listings ;
|
|||
swap >>root
|
||||
H{ } clone >>special ;
|
||||
|
||||
: (serve-static) ( path mime-type -- response )
|
||||
[ [ binary <file-reader> &dispose ] dip <content> ]
|
||||
[ drop file-info [ size>> ] [ modified>> ] bi ] 2bi
|
||||
[ "content-length" set-header ]
|
||||
[ "last-modified" set-header ] bi* ;
|
||||
|
||||
: <static> ( root -- responder )
|
||||
[
|
||||
<content>
|
||||
swap [
|
||||
file-info
|
||||
[ size>> "content-length" set-header ]
|
||||
[ modified>> "last-modified" set-header ] bi
|
||||
]
|
||||
[ '[ , binary <file-reader> output-stream get stream-copy ] >>body ] bi
|
||||
] <file-responder> ;
|
||||
[ (serve-static) ] <file-responder> ;
|
||||
|
||||
: serve-static ( filename mime-type -- response )
|
||||
over modified-since?
|
||||
|
|
|
@ -38,7 +38,7 @@ HELP: render-glyph
|
|||
{ $description "Renders a character and outputs a pointer to the bitmap." } ;
|
||||
|
||||
HELP: <char-sprite>
|
||||
{ $values { "font" font } { "char" "a non-negative integer" } { "sprite" sprite } }
|
||||
{ $values { "open-font" font } { "char" "a non-negative integer" } { "sprite" sprite } }
|
||||
{ $description "Renders a character to an OpenGL texture and records a display list which draws a quad with this texture. This word allocates native resources which must be freed by " { $link free-sprites } "." } ;
|
||||
|
||||
HELP: (draw-string)
|
||||
|
|
|
@ -109,9 +109,7 @@ CELL frame_executing(F_STACK_FRAME *frame)
|
|||
{
|
||||
F_COMPILED *compiled = frame_code(frame);
|
||||
CELL code_start = (CELL)(compiled + 1);
|
||||
CELL literal_start = code_start
|
||||
+ compiled->code_length
|
||||
+ compiled->reloc_length;
|
||||
CELL literal_start = code_start + compiled->code_length;
|
||||
|
||||
return get(literal_start);
|
||||
}
|
||||
|
|
|
@ -257,12 +257,13 @@ void iterate_code_heap(CODE_HEAP_ITERATOR iter)
|
|||
}
|
||||
|
||||
/* Copy all literals referenced from a code block to newspace */
|
||||
void collect_literals_step(F_COMPILED *compiled, CELL code_start,
|
||||
CELL reloc_start, CELL literals_start)
|
||||
void collect_literals_step(F_COMPILED *compiled, CELL code_start, CELL literals_start)
|
||||
{
|
||||
CELL scan;
|
||||
CELL literal_end = literals_start + compiled->literals_length;
|
||||
|
||||
copy_handle(&compiled->relocation);
|
||||
|
||||
for(scan = literals_start; scan < literal_end; scan += CELLS)
|
||||
copy_handle((CELL*)scan);
|
||||
}
|
||||
|
|
11
vm/code_gc.h
11
vm/code_gc.h
|
@ -17,9 +17,6 @@ typedef struct _F_BLOCK
|
|||
|
||||
/* Used during compaction */
|
||||
struct _F_BLOCK *forwarding;
|
||||
|
||||
/* Alignment padding */
|
||||
CELL padding[4];
|
||||
} F_BLOCK;
|
||||
|
||||
typedef struct {
|
||||
|
@ -47,16 +44,14 @@ INLINE F_BLOCK *next_block(F_HEAP *heap, F_BLOCK *block)
|
|||
/* compiled code */
|
||||
F_HEAP code_heap;
|
||||
|
||||
typedef void (*CODE_HEAP_ITERATOR)(F_COMPILED *compiled, CELL code_start,
|
||||
CELL reloc_start, CELL literals_start);
|
||||
typedef void (*CODE_HEAP_ITERATOR)(F_COMPILED *compiled, CELL code_start, CELL literals_start);
|
||||
|
||||
INLINE void iterate_code_heap_step(F_COMPILED *compiled, CODE_HEAP_ITERATOR iter)
|
||||
{
|
||||
CELL code_start = (CELL)(compiled + 1);
|
||||
CELL reloc_start = code_start + compiled->code_length;
|
||||
CELL literals_start = reloc_start + compiled->reloc_length;
|
||||
CELL literals_start = code_start + compiled->code_length;
|
||||
|
||||
iter(compiled,code_start,reloc_start,literals_start);
|
||||
iter(compiled,code_start,literals_start);
|
||||
}
|
||||
|
||||
INLINE F_BLOCK *compiled_to_block(F_COMPILED *compiled)
|
||||
|
|
|
@ -139,13 +139,14 @@ void apply_relocation(CELL class, CELL offset, F_FIXNUM absolute_value)
|
|||
}
|
||||
|
||||
/* Perform all fixups on a code block */
|
||||
void relocate_code_block(F_COMPILED *relocating, CELL code_start,
|
||||
CELL reloc_start, CELL literals_start)
|
||||
void relocate_code_block(F_COMPILED *compiled, CELL code_start, CELL literals_start)
|
||||
{
|
||||
if(reloc_start != literals_start)
|
||||
if(compiled->relocation != F)
|
||||
{
|
||||
F_REL *rel = (F_REL *)reloc_start;
|
||||
F_REL *rel_end = (F_REL *)literals_start;
|
||||
F_BYTE_ARRAY *relocation = untag_object(compiled->relocation);
|
||||
|
||||
F_REL *rel = (F_REL *)(relocation + 1);
|
||||
F_REL *rel_end = (F_REL *)((char *)rel + byte_array_capacity(relocation));
|
||||
|
||||
while(rel < rel_end)
|
||||
{
|
||||
|
@ -160,7 +161,7 @@ void relocate_code_block(F_COMPILED *relocating, CELL code_start,
|
|||
}
|
||||
}
|
||||
|
||||
flush_icache(code_start,reloc_start - code_start);
|
||||
flush_icache(code_start,literals_start - code_start);
|
||||
}
|
||||
|
||||
/* Fixup labels. This is done at compile time, not image load time */
|
||||
|
@ -249,34 +250,32 @@ F_COMPILED *add_compiled_block(
|
|||
CELL type,
|
||||
F_ARRAY *code,
|
||||
F_ARRAY *labels,
|
||||
F_ARRAY *relocation,
|
||||
CELL relocation,
|
||||
F_ARRAY *literals)
|
||||
{
|
||||
CELL code_format = compiled_code_format();
|
||||
|
||||
CELL code_length = align8(array_capacity(code) * code_format);
|
||||
CELL rel_length = array_capacity(relocation) * sizeof(unsigned int);
|
||||
CELL literals_length = array_capacity(literals) * CELLS;
|
||||
|
||||
REGISTER_ROOT(relocation);
|
||||
REGISTER_UNTAGGED(code);
|
||||
REGISTER_UNTAGGED(labels);
|
||||
REGISTER_UNTAGGED(relocation);
|
||||
REGISTER_UNTAGGED(literals);
|
||||
|
||||
CELL here = allot_code_block(sizeof(F_COMPILED) + code_length
|
||||
+ rel_length + literals_length);
|
||||
CELL here = allot_code_block(sizeof(F_COMPILED) + code_length + literals_length);
|
||||
|
||||
UNREGISTER_UNTAGGED(literals);
|
||||
UNREGISTER_UNTAGGED(relocation);
|
||||
UNREGISTER_UNTAGGED(labels);
|
||||
UNREGISTER_UNTAGGED(code);
|
||||
UNREGISTER_ROOT(relocation);
|
||||
|
||||
/* compiled header */
|
||||
F_COMPILED *header = (void *)here;
|
||||
header->type = type;
|
||||
header->code_length = code_length;
|
||||
header->reloc_length = rel_length;
|
||||
header->literals_length = literals_length;
|
||||
header->relocation = relocation;
|
||||
|
||||
here += sizeof(F_COMPILED);
|
||||
|
||||
|
@ -286,10 +285,6 @@ F_COMPILED *add_compiled_block(
|
|||
deposit_integers(here,code,code_format);
|
||||
here += code_length;
|
||||
|
||||
/* relation info */
|
||||
deposit_integers(here,relocation,sizeof(unsigned int));
|
||||
here += rel_length;
|
||||
|
||||
/* literals */
|
||||
deposit_objects(here,literals);
|
||||
here += literals_length;
|
||||
|
@ -353,7 +348,7 @@ DEFINE_PRIMITIVE(modify_code_heap)
|
|||
F_ARRAY *compiled_code = untag_array(data);
|
||||
|
||||
F_ARRAY *literals = untag_array(array_nth(compiled_code,0));
|
||||
F_ARRAY *relocation = untag_array(array_nth(compiled_code,1));
|
||||
CELL relocation = array_nth(compiled_code,1);
|
||||
F_ARRAY *labels = untag_array(array_nth(compiled_code,2));
|
||||
F_ARRAY *code = untag_array(array_nth(compiled_code,3));
|
||||
|
||||
|
|
|
@ -53,8 +53,7 @@ typedef struct {
|
|||
unsigned int offset;
|
||||
} F_REL;
|
||||
|
||||
void relocate_code_block(F_COMPILED *relocating, CELL code_start,
|
||||
CELL reloc_start, CELL literals_start);
|
||||
void relocate_code_block(F_COMPILED *relocating, CELL code_start, CELL literals_start);
|
||||
|
||||
void default_word_code(F_WORD *word, bool relocate);
|
||||
|
||||
|
@ -64,7 +63,7 @@ F_COMPILED *add_compiled_block(
|
|||
CELL type,
|
||||
F_ARRAY *code,
|
||||
F_ARRAY *labels,
|
||||
F_ARRAY *rel,
|
||||
CELL relocation,
|
||||
F_ARRAY *literals);
|
||||
|
||||
CELL compiled_code_format(void);
|
||||
|
|
26
vm/data_gc.c
26
vm/data_gc.c
|
@ -930,22 +930,22 @@ DEFINE_PRIMITIVE(gc_stats)
|
|||
for(i = 0; i < MAX_GEN_COUNT; i++)
|
||||
{
|
||||
F_GC_STATS *s = &gc_stats[i];
|
||||
GROWABLE_ADD(stats,allot_cell(s->collections));
|
||||
GROWABLE_ADD(stats,allot_cell(s->gc_time));
|
||||
GROWABLE_ADD(stats,allot_cell(s->max_gc_time));
|
||||
GROWABLE_ADD(stats,allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
|
||||
GROWABLE_ADD(stats,allot_cell(s->object_count));
|
||||
GROWABLE_ADD(stats,tag_bignum(long_long_to_bignum(s->bytes_copied)));
|
||||
GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections));
|
||||
GROWABLE_ARRAY_ADD(stats,allot_cell(s->gc_time));
|
||||
GROWABLE_ARRAY_ADD(stats,allot_cell(s->max_gc_time));
|
||||
GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
|
||||
GROWABLE_ARRAY_ADD(stats,allot_cell(s->object_count));
|
||||
GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->bytes_copied)));
|
||||
|
||||
total_gc_time += s->gc_time;
|
||||
}
|
||||
|
||||
GROWABLE_ADD(stats,allot_cell(total_gc_time));
|
||||
GROWABLE_ADD(stats,tag_bignum(long_long_to_bignum(cards_scanned)));
|
||||
GROWABLE_ADD(stats,tag_bignum(long_long_to_bignum(decks_scanned)));
|
||||
GROWABLE_ADD(stats,allot_cell(code_heap_scans));
|
||||
GROWABLE_ARRAY_ADD(stats,allot_cell(total_gc_time));
|
||||
GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(cards_scanned)));
|
||||
GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(decks_scanned)));
|
||||
GROWABLE_ARRAY_ADD(stats,allot_cell(code_heap_scans));
|
||||
|
||||
GROWABLE_TRIM(stats);
|
||||
GROWABLE_ARRAY_TRIM(stats);
|
||||
dpush(stats);
|
||||
}
|
||||
|
||||
|
@ -986,13 +986,13 @@ CELL find_all_words(void)
|
|||
while((obj = next_object()) != F)
|
||||
{
|
||||
if(type_of(obj) == WORD_TYPE)
|
||||
GROWABLE_ADD(words,obj);
|
||||
GROWABLE_ARRAY_ADD(words,obj);
|
||||
}
|
||||
|
||||
/* End heap scan */
|
||||
gc_off = false;
|
||||
|
||||
GROWABLE_TRIM(words);
|
||||
GROWABLE_ARRAY_TRIM(words);
|
||||
|
||||
return words;
|
||||
}
|
||||
|
|
|
@ -296,8 +296,7 @@ void find_data_references(CELL look_for_)
|
|||
|
||||
CELL look_for;
|
||||
|
||||
void find_code_references_step(F_COMPILED *compiled, CELL code_start,
|
||||
CELL reloc_start, CELL literals_start)
|
||||
void find_code_references_step(F_COMPILED *compiled, CELL code_start, CELL literals_start)
|
||||
{
|
||||
CELL scan;
|
||||
CELL literal_end = literals_start + compiled->literals_length;
|
||||
|
@ -305,9 +304,7 @@ void find_code_references_step(F_COMPILED *compiled, CELL code_start,
|
|||
for(scan = literals_start; scan < literal_end; scan += CELLS)
|
||||
{
|
||||
CELL code_start = (CELL)(compiled + 1);
|
||||
CELL literal_start = code_start
|
||||
+ compiled->code_length
|
||||
+ compiled->reloc_length;
|
||||
CELL literal_start = code_start + compiled->code_length;
|
||||
|
||||
CELL obj = get(literal_start);
|
||||
|
||||
|
|
10
vm/image.c
10
vm/image.c
|
@ -288,18 +288,18 @@ void relocate_data()
|
|||
}
|
||||
}
|
||||
|
||||
void fixup_code_block(F_COMPILED *relocating, CELL code_start,
|
||||
CELL reloc_start, CELL literals_start)
|
||||
void fixup_code_block(F_COMPILED *compiled, CELL code_start, CELL literals_start)
|
||||
{
|
||||
/* relocate literal table data */
|
||||
CELL scan;
|
||||
CELL literal_end = literals_start + relocating->literals_length;
|
||||
CELL literal_end = literals_start + compiled->literals_length;
|
||||
|
||||
data_fixup(&compiled->relocation);
|
||||
|
||||
for(scan = literals_start; scan < literal_end; scan += CELLS)
|
||||
data_fixup((CELL*)scan);
|
||||
|
||||
if(reloc_start != literals_start)
|
||||
relocate_code_block(relocating,code_start,reloc_start,literals_start);
|
||||
relocate_code_block(compiled,code_start,literals_start);
|
||||
}
|
||||
|
||||
void relocate_code()
|
||||
|
|
|
@ -113,8 +113,8 @@ typedef struct
|
|||
{
|
||||
CELL type; /* this is WORD_TYPE or QUOTATION_TYPE */
|
||||
CELL code_length; /* # bytes */
|
||||
CELL reloc_length; /* # bytes */
|
||||
CELL literals_length; /* # bytes */
|
||||
CELL relocation; /* tagged pointer to byte-array or f */
|
||||
} F_COMPILED;
|
||||
|
||||
/* Assembly code makes assumptions about the layout of this struct */
|
||||
|
|
|
@ -73,14 +73,14 @@ DEFINE_PRIMITIVE(read_dir)
|
|||
while((file = readdir(dir)) != NULL)
|
||||
{
|
||||
CELL pair = parse_dir_entry(file);
|
||||
GROWABLE_ADD(result,pair);
|
||||
GROWABLE_ARRAY_ADD(result,pair);
|
||||
}
|
||||
|
||||
closedir(dir);
|
||||
}
|
||||
|
||||
UNREGISTER_ROOT(result);
|
||||
GROWABLE_TRIM(result);
|
||||
GROWABLE_ARRAY_TRIM(result);
|
||||
|
||||
dpush(result);
|
||||
}
|
||||
|
@ -104,12 +104,12 @@ DEFINE_PRIMITIVE(os_envs)
|
|||
while(*env)
|
||||
{
|
||||
CELL string = tag_object(from_char_string(*env));
|
||||
GROWABLE_ADD(result,string);
|
||||
GROWABLE_ARRAY_ADD(result,string);
|
||||
env++;
|
||||
}
|
||||
|
||||
UNREGISTER_ROOT(result);
|
||||
GROWABLE_TRIM(result);
|
||||
GROWABLE_ARRAY_TRIM(result);
|
||||
dpush(result);
|
||||
}
|
||||
|
||||
|
|
|
@ -25,7 +25,7 @@ DEFINE_PRIMITIVE(os_envs)
|
|||
break;
|
||||
|
||||
CELL string = tag_object(from_u16_string(finger));
|
||||
GROWABLE_ADD(result,string);
|
||||
GROWABLE_ARRAY_ADD(result,string);
|
||||
|
||||
finger = scan + 1;
|
||||
}
|
||||
|
@ -33,7 +33,7 @@ DEFINE_PRIMITIVE(os_envs)
|
|||
FreeEnvironmentStrings(env);
|
||||
|
||||
UNREGISTER_ROOT(result);
|
||||
GROWABLE_TRIM(result);
|
||||
GROWABLE_ARRAY_TRIM(result);
|
||||
dpush(result);
|
||||
}
|
||||
|
||||
|
|
|
@ -152,14 +152,14 @@ DEFINE_PRIMITIVE(read_dir)
|
|||
CELL name = tag_object(from_u16_string(find_data.cFileName));
|
||||
CELL dirp = tag_boolean(find_data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
|
||||
CELL pair = allot_array_2(name,dirp);
|
||||
GROWABLE_ADD(result,pair);
|
||||
GROWABLE_ARRAY_ADD(result,pair);
|
||||
}
|
||||
while (FindNextFile(dir, &find_data));
|
||||
FindClose(dir);
|
||||
}
|
||||
|
||||
UNREGISTER_ROOT(result);
|
||||
GROWABLE_TRIM(result);
|
||||
GROWABLE_ARRAY_TRIM(result);
|
||||
|
||||
dpush(result);
|
||||
}
|
||||
|
|
|
@ -60,14 +60,9 @@ F_REL rel_to_emit(CELL name, CELL code_format, CELL code_length,
|
|||
|
||||
#define EMIT(name,rel_argument) { \
|
||||
bool rel_p; \
|
||||
F_REL rel = rel_to_emit(name,code_format,code_count, \
|
||||
rel_argument,&rel_p); \
|
||||
if(rel_p) \
|
||||
{ \
|
||||
GROWABLE_ADD(relocation,allot_cell(rel.type)); \
|
||||
GROWABLE_ADD(relocation,allot_cell(rel.offset)); \
|
||||
} \
|
||||
GROWABLE_APPEND(code,code_to_emit(name)); \
|
||||
F_REL rel = rel_to_emit(name,code_format,code_count,rel_argument,&rel_p); \
|
||||
if(rel_p) GROWABLE_BYTE_ARRAY_APPEND(relocation,&rel,sizeof(F_REL)); \
|
||||
GROWABLE_ARRAY_APPEND(code,code_to_emit(name)); \
|
||||
}
|
||||
|
||||
bool jit_stack_frame_p(F_ARRAY *array)
|
||||
|
@ -110,13 +105,13 @@ void jit_compile(CELL quot, bool relocate)
|
|||
GROWABLE_ARRAY(code);
|
||||
REGISTER_ROOT(code);
|
||||
|
||||
GROWABLE_ARRAY(relocation);
|
||||
GROWABLE_BYTE_ARRAY(relocation);
|
||||
REGISTER_ROOT(relocation);
|
||||
|
||||
GROWABLE_ARRAY(literals);
|
||||
REGISTER_ROOT(literals);
|
||||
|
||||
GROWABLE_ADD(literals,stack_traces_p() ? quot : F);
|
||||
GROWABLE_ARRAY_ADD(literals,stack_traces_p() ? quot : F);
|
||||
|
||||
bool stack_frame = jit_stack_frame_p(untag_object(array));
|
||||
|
||||
|
@ -141,7 +136,7 @@ void jit_compile(CELL quot, bool relocate)
|
|||
current stack frame. */
|
||||
word = untag_object(obj);
|
||||
|
||||
GROWABLE_ADD(literals,array_nth(untag_object(array),i));
|
||||
GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
|
||||
|
||||
if(i == length - 1)
|
||||
{
|
||||
|
@ -157,7 +152,7 @@ void jit_compile(CELL quot, bool relocate)
|
|||
break;
|
||||
case WRAPPER_TYPE:
|
||||
wrapper = untag_object(obj);
|
||||
GROWABLE_ADD(literals,wrapper->object);
|
||||
GROWABLE_ARRAY_ADD(literals,wrapper->object);
|
||||
EMIT(JIT_PUSH_LITERAL,literals_count - 1);
|
||||
break;
|
||||
case FIXNUM_TYPE:
|
||||
|
@ -176,8 +171,8 @@ void jit_compile(CELL quot, bool relocate)
|
|||
if(stack_frame)
|
||||
EMIT(JIT_EPILOG,0);
|
||||
|
||||
GROWABLE_ADD(literals,array_nth(untag_object(array),i));
|
||||
GROWABLE_ADD(literals,array_nth(untag_object(array),i + 1));
|
||||
GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
|
||||
GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i + 1));
|
||||
EMIT(JIT_IF_JUMP,literals_count - 2);
|
||||
|
||||
i += 2;
|
||||
|
@ -191,7 +186,7 @@ void jit_compile(CELL quot, bool relocate)
|
|||
if(stack_frame)
|
||||
EMIT(JIT_EPILOG,0);
|
||||
|
||||
GROWABLE_ADD(literals,array_nth(untag_object(array),i));
|
||||
GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
|
||||
EMIT(JIT_DISPATCH,literals_count - 1);
|
||||
|
||||
i++;
|
||||
|
@ -200,7 +195,7 @@ void jit_compile(CELL quot, bool relocate)
|
|||
break;
|
||||
}
|
||||
default:
|
||||
GROWABLE_ADD(literals,obj);
|
||||
GROWABLE_ARRAY_ADD(literals,obj);
|
||||
EMIT(JIT_PUSH_LITERAL,literals_count - 1);
|
||||
break;
|
||||
}
|
||||
|
@ -214,15 +209,15 @@ void jit_compile(CELL quot, bool relocate)
|
|||
EMIT(JIT_RETURN,0);
|
||||
}
|
||||
|
||||
GROWABLE_TRIM(code);
|
||||
GROWABLE_TRIM(relocation);
|
||||
GROWABLE_TRIM(literals);
|
||||
GROWABLE_ARRAY_TRIM(code);
|
||||
GROWABLE_ARRAY_TRIM(literals);
|
||||
GROWABLE_BYTE_ARRAY_TRIM(relocation);
|
||||
|
||||
F_COMPILED *compiled = add_compiled_block(
|
||||
QUOTATION_TYPE,
|
||||
untag_object(code),
|
||||
NULL,
|
||||
untag_object(relocation),
|
||||
relocation,
|
||||
untag_object(literals));
|
||||
|
||||
set_quot_xt(untag_object(quot),compiled);
|
||||
|
|
35
vm/types.c
35
vm/types.c
|
@ -197,7 +197,7 @@ DEFINE_PRIMITIVE(resize_array)
|
|||
dpush(tag_object(reallot_array(array,capacity,F)));
|
||||
}
|
||||
|
||||
F_ARRAY *growable_add(F_ARRAY *result, CELL elt, CELL *result_count)
|
||||
F_ARRAY *growable_array_add(F_ARRAY *result, CELL elt, CELL *result_count)
|
||||
{
|
||||
REGISTER_ROOT(elt);
|
||||
|
||||
|
@ -209,12 +209,12 @@ F_ARRAY *growable_add(F_ARRAY *result, CELL elt, CELL *result_count)
|
|||
|
||||
UNREGISTER_ROOT(elt);
|
||||
set_array_nth(result,*result_count,elt);
|
||||
*result_count = *result_count + 1;
|
||||
(*result_count)++;
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
F_ARRAY *growable_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_count)
|
||||
F_ARRAY *growable_array_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_count)
|
||||
{
|
||||
REGISTER_UNTAGGED(elts);
|
||||
|
||||
|
@ -228,7 +228,7 @@ F_ARRAY *growable_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_count)
|
|||
|
||||
write_barrier((CELL)result);
|
||||
|
||||
memcpy((void*)AREF(result,*result_count),(void*)AREF(elts,0),elts_size * CELLS);
|
||||
memcpy((void *)AREF(result,*result_count),(void *)AREF(elts,0),elts_size * CELLS);
|
||||
|
||||
*result_count += elts_size;
|
||||
|
||||
|
@ -283,6 +283,33 @@ DEFINE_PRIMITIVE(resize_byte_array)
|
|||
dpush(tag_object(reallot_byte_array(array,capacity)));
|
||||
}
|
||||
|
||||
F_BYTE_ARRAY *growable_byte_array_add(F_BYTE_ARRAY *result, CELL elt, CELL *result_count)
|
||||
{
|
||||
if(*result_count == byte_array_capacity(result))
|
||||
{
|
||||
result = reallot_byte_array(result,*result_count * 2);
|
||||
}
|
||||
|
||||
bput(BREF(result,*result_count),elt);
|
||||
*result_count++;
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
F_BYTE_ARRAY *growable_byte_array_append(F_BYTE_ARRAY *result, void *elts, CELL len, CELL *result_count)
|
||||
{
|
||||
CELL new_size = *result_count + len;
|
||||
|
||||
if(new_size >= byte_array_capacity(result))
|
||||
result = reallot_byte_array(result,new_size * 2);
|
||||
|
||||
memcpy((void *)BREF(result,*result_count),elts,len);
|
||||
|
||||
*result_count = new_size;
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/* Bit arrays */
|
||||
|
||||
/* size is in bits */
|
||||
|
|
33
vm/types.h
33
vm/types.h
|
@ -146,6 +146,7 @@ DECLARE_PRIMITIVE(float_array);
|
|||
DECLARE_PRIMITIVE(clone);
|
||||
|
||||
F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill);
|
||||
F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity);
|
||||
DECLARE_PRIMITIVE(resize_array);
|
||||
DECLARE_PRIMITIVE(resize_byte_array);
|
||||
DECLARE_PRIMITIVE(resize_bit_array);
|
||||
|
@ -193,15 +194,33 @@ DECLARE_PRIMITIVE(wrapper);
|
|||
CELL result##_count = 0; \
|
||||
CELL result = tag_object(allot_array(ARRAY_TYPE,100,F))
|
||||
|
||||
F_ARRAY *growable_add(F_ARRAY *result, CELL elt, CELL *result_count);
|
||||
F_ARRAY *growable_array_add(F_ARRAY *result, CELL elt, CELL *result_count);
|
||||
|
||||
#define GROWABLE_ADD(result,elt) \
|
||||
result = tag_object(growable_add(untag_object(result),elt,&result##_count))
|
||||
#define GROWABLE_ARRAY_ADD(result,elt) \
|
||||
result = tag_object(growable_array_add(untag_object(result),elt,&result##_count))
|
||||
|
||||
F_ARRAY *growable_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_count);
|
||||
F_ARRAY *growable_array_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_count);
|
||||
|
||||
#define GROWABLE_APPEND(result,elts) \
|
||||
result = tag_object(growable_append(untag_object(result),elts,&result##_count))
|
||||
#define GROWABLE_ARRAY_APPEND(result,elts) \
|
||||
result = tag_object(growable_array_append(untag_object(result),elts,&result##_count))
|
||||
|
||||
#define GROWABLE_TRIM(result) \
|
||||
#define GROWABLE_ARRAY_TRIM(result) \
|
||||
result = tag_object(reallot_array(untag_object(result),result##_count,F))
|
||||
|
||||
/* Macros to simulate a byte vector in C */
|
||||
#define GROWABLE_BYTE_ARRAY(result) \
|
||||
CELL result##_count = 0; \
|
||||
CELL result = tag_object(allot_byte_array(100))
|
||||
|
||||
F_ARRAY *growable_byte_array_add(F_BYTE_ARRAY *result, CELL elt, CELL *result_count);
|
||||
|
||||
#define GROWABLE_BYTE_ARRAY_ADD(result,elt) \
|
||||
result = tag_object(growable_byte_array_add(untag_object(result),elt,&result##_count))
|
||||
|
||||
F_ARRAY *growable_byte_array_append(F_BYTE_ARRAY *result, void *elts, CELL len, CELL *result_count);
|
||||
|
||||
#define GROWABLE_BYTE_ARRAY_APPEND(result,elts,len) \
|
||||
result = tag_object(growable_byte_array_append(untag_object(result),elts,len,&result##_count))
|
||||
|
||||
#define GROWABLE_BYTE_ARRAY_TRIM(result) \
|
||||
result = tag_object(reallot_byte_array(untag_object(result),result##_count))
|
||||
|
|
Loading…
Reference in New Issue