Move relocation info out of the code heap and into the data heap

diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor
index 61752ac7d669208d6e3a76e34634fe78a20b9aa2..c65c01d2abf23abad24f3059863bff309b2c2833 100755 (executable)
--- a/core/combinators/combinators-docs.factor
+++ b/core/combinators/combinators-docs.factor
@@ -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* } ":"

diff --git a/core/generator/fixup/fixup-docs.factor b/core/generator/fixup/fixup-docs.factor
index f5d530dccbbba9632c13c899f8fed24c3eafe57c..a0f067fb9e75e09eed7a264a0199657cf63e8738 100644 (file)
--- a/core/generator/fixup/fixup-docs.factor
+++ b/core/generator/fixup/fixup-docs.factor
@@ -1,12 +1,12 @@
 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" } }
+{ $values { "arg" integer } { "class" "a relocation class" } { "type" "a relocation type" } { "offset" integer } { "byte-array" byte-array } }
 { $description "Creates a relocation instruction for the VM's runtime compiled code linker." } ;
 
 HELP: add-literal

diff --git a/core/generator/fixup/fixup.factor b/core/generator/fixup/fixup.factor
index b38d70fb80aaa697ae2f8350c396bc749e034604..a0961984ede64e2db8e898367122ab89972bccb2 100755 (executable)
--- a/core/generator/fixup/fixup.factor
+++ b/core/generator/fixup/fixup.factor
@@ -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 ;

diff --git a/core/io/binary/binary-docs.factor b/core/io/binary/binary-docs.factor
index 507571c04451863f823f6468d2694555181c7cf0..ab82abe146e289f585ab745747b0b6acc3fcd901 100644 (file)
--- a/core/io/binary/binary-docs.factor
+++ b/core/io/binary/binary-docs.factor
@@ -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

diff --git a/core/io/binary/binary.factor b/core/io/binary/binary.factor
index f2ede93fd5c0c8b104a08f00b25c40c8b0a2980c..f3d236433f1e0b72426242b3a70c427c2fdf9df1 100755 (executable)
--- a/core/io/binary/binary.factor
+++ b/core/io/binary/binary.factor
@@ -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

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 96c582a3e5fa418c4e0663e0165313d078d0a174..c39010f228f98d1578f781428a987a2dcc4aac4a 100755 (executable)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -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."

diff --git a/vm/callstack.c b/vm/callstack.c
index 25219d1569bc087b4db3303c96716f3d0571e263..df4063d149ac8361bd43b1e4332523b0a6740c30 100755 (executable)
--- a/vm/callstack.c
+++ b/vm/callstack.c
@@ -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);
 }

diff --git a/vm/code_gc.c b/vm/code_gc.c
index 141f4abbfe065a9942fec62c312d0b1ac15156e5..e0abdc5a61bbe3f7826099e303d5c6b2aea3a840 100755 (executable)
--- a/vm/code_gc.c
+++ b/vm/code_gc.c
@@ -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);
 }

diff --git a/vm/code_gc.h b/vm/code_gc.h
index ecc9f697f58972c1dcce98a3534cf3cc98d918f7..f93cba9c7aec3f6b8f2ce53ef3964ccd727960da 100644 (file)
--- a/vm/code_gc.h
+++ b/vm/code_gc.h
@@ -44,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)

diff --git a/vm/code_heap.c b/vm/code_heap.c
index 92915e49d151a1c45ad39ab213d0f514988e7835..69ffdeb2aa2a1fdb45b883c3827c375871d8e8d9 100755 (executable)
--- a/vm/code_heap.c
+++ b/vm/code_heap.c
@@ -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));
 

diff --git a/vm/code_heap.h b/vm/code_heap.h
index 4e65313d3beb5646bdc0e156789017b270968653..80605b1d28164d04a5393d9990d86225d0cae9a1 100755 (executable)
--- a/vm/code_heap.h
+++ b/vm/code_heap.h
@@ -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);

diff --git a/vm/data_gc.c b/vm/data_gc.c
index a52f2490e96978b81ec298835f098642a9872ced..54ad1168a08d25a3ad70d50558044b7f13659713 100755 (executable)
--- a/vm/data_gc.c
+++ b/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;
 }

diff --git a/vm/debug.c b/vm/debug.c
index b86ec808bc5ce1560326a2fd29a9637cf781f095..027842689562e2dc9ee8b1104743482d87cf5cd0 100755 (executable)
--- a/vm/debug.c
+++ b/vm/debug.c
@@ -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);
 

diff --git a/vm/image.c b/vm/image.c
index 653891fdfe8cda9863bb47b986345c3518740515..141594f01f44a5e00732a6922864d3f746a45747 100755 (executable)
--- a/vm/image.c
+++ b/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()

diff --git a/vm/layouts.h b/vm/layouts.h
index 89af0a306cb842e3ee29eba2190d5316b962e3ea..1aee94357bc74d49706326821e7da5be2dfc1773 100755 (executable)
--- a/vm/layouts.h
+++ b/vm/layouts.h
@@ -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 */

diff --git a/vm/os-unix.c b/vm/os-unix.c
index 6363ce68a9224ac76fa598e3e5423b98f3bbc5de..1f63ea7ab18f42b6f8fce9b880b10eba2a2b87ba 100755 (executable)
--- a/vm/os-unix.c
+++ b/vm/os-unix.c
@@ -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);
 }
 

diff --git a/vm/os-windows-nt.c b/vm/os-windows-nt.c
index cc7b128941a764dc93adf30fb1f17fc027210a83..4f5778d0c4e0e4d782da482999902fb4b73aa04a 100755 (executable)
--- a/vm/os-windows-nt.c
+++ b/vm/os-windows-nt.c
@@ -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);
 }
 

diff --git a/vm/os-windows.c b/vm/os-windows.c
index 59c14d98f5a47f6c821921f819298f54a9525604..dc931d31c807e64785773255dd91beb522779cde 100755 (executable)
--- a/vm/os-windows.c
+++ b/vm/os-windows.c
@@ -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);
 }

diff --git a/vm/quotations.c b/vm/quotations.c
index c3b50dbd472818ca9c09b7659c4c6c06412c8eb8..e092aab4bf455458a27271d97ebde7adc4958bdd 100755 (executable)
--- a/vm/quotations.c
+++ b/vm/quotations.c
@@ -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);

diff --git a/vm/types.c b/vm/types.c
index b4e5269f4e36e6d1661269168c141a29afcfec4c..adfdea41a5d8ed9b3e4f091a0514758b884684f5 100755 (executable)
--- a/vm/types.c
+++ b/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 */

diff --git a/vm/types.h b/vm/types.h
index 3ce1838b8b20b02ea11e40aca5ac31f9c3b20777..bbf7fb203d4e76b32a72ac1607bc6dd2faf6876f 100755 (executable)
--- a/vm/types.h
+++ b/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))