Tuple layouts are now arrays, instead of built-in types. The superclass
array is now part of the tuple layout object itself, and class hashcodes are stored alongside class words there. This removes 2 indirections when reading a superclass, and 3 when reading a superclass hashcode.db4
Slava Pestov
parent
4e98751ce0
commit
cc879fa9b7
|
|
@ -368,21 +368,6 @@ M: byte-array '
|
|||
|
||||
M: tuple ' emit-tuple ;
|
||||
|
||||
M: tuple-layout '
|
||||
[
|
||||
[
|
||||
{
|
||||
[ hashcode>> , ]
|
||||
[ class>> , ]
|
||||
[ size>> , ]
|
||||
[ superclasses>> , ]
|
||||
[ echelon>> , ]
|
||||
} cleave
|
||||
] { } make [ ' ] map
|
||||
\ tuple-layout type-number
|
||||
object tag-number [ emit-seq ] emit-object
|
||||
] cache-object ;
|
||||
|
||||
M: tombstone '
|
||||
state>> "((tombstone))" "((empty))" ?
|
||||
"hashtables.private" lookup def>> first
|
||||
|
|
|
|||
|
|
@ -16,14 +16,14 @@ IN: compiler.cfg.intrinsics.allot
|
|||
[ ##set-slots ] [ [ drop ] [ ds-push ] [ drop ] tri* ] 3bi ;
|
||||
|
||||
: tuple-slot-regs ( layout -- vregs )
|
||||
[ size>> ds-load ] [ ^^load-literal ] bi prefix ;
|
||||
[ second ds-load ] [ ^^load-literal ] bi prefix ;
|
||||
|
||||
: emit-<tuple-boa> ( node -- )
|
||||
dup node-input-infos peek literal>>
|
||||
dup tuple-layout? [
|
||||
dup array? [
|
||||
nip
|
||||
ds-drop
|
||||
[ tuple-slot-regs ] [ size>> ^^allot-tuple ] bi
|
||||
[ tuple-slot-regs ] [ second ^^allot-tuple ] bi
|
||||
[ tuple ##set-slots ] [ ds-push drop ] 2bi
|
||||
] [ drop emit-primitive ] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -307,5 +307,5 @@ SYMBOL: value-infos
|
|||
: immutable-tuple-boa? ( #call -- ? )
|
||||
dup word>> \ <tuple-boa> eq? [
|
||||
dup in-d>> peek node-value-info
|
||||
literal>> class>> immutable-tuple-class?
|
||||
literal>> first immutable-tuple-class?
|
||||
] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -281,7 +281,7 @@ generic-comparison-ops [
|
|||
|
||||
{ <tuple> <tuple-boa> } [
|
||||
[
|
||||
literal>> dup tuple-layout? [ class>> ] [ drop tuple ] if <class-info>
|
||||
literal>> dup array? [ first ] [ drop tuple ] if <class-info>
|
||||
[ clear ] dip
|
||||
] "outputs" set-word-prop
|
||||
] each
|
||||
|
|
|
|||
|
|
@ -379,7 +379,7 @@ TUPLE: mutable-tuple-test { x sequence } ;
|
|||
[ T{ mutable-tuple-test f "hey" } x>> ] final-classes
|
||||
] unit-test
|
||||
|
||||
[ V{ tuple-layout } ] [
|
||||
[ V{ array } ] [
|
||||
[ T{ mutable-tuple-test f "hey" } layout-of ] final-classes
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ UNION: fixed-length-sequence array byte-array string ;
|
|||
|
||||
: propagate-<tuple-boa> ( #call -- info )
|
||||
in-d>> unclip-last
|
||||
value-info literal>> class>> (propagate-tuple-constructor) ;
|
||||
value-info literal>> first (propagate-tuple-constructor) ;
|
||||
|
||||
: propagate-<complex> ( #call -- info )
|
||||
in-d>> [ value-info ] map complex <tuple-info> ;
|
||||
|
|
|
|||
|
|
@ -233,6 +233,3 @@ M: wrapper pprint*
|
|||
] [
|
||||
pprint-object
|
||||
] if ;
|
||||
|
||||
M: tuple-layout pprint*
|
||||
"( tuple layout )" swap present-text ;
|
||||
|
|
|
|||
|
|
@ -108,7 +108,7 @@ M: object infer-call*
|
|||
|
||||
: infer-<tuple-boa> ( -- )
|
||||
\ <tuple-boa>
|
||||
peek-d literal value>> size>> 1+ { tuple } <effect>
|
||||
peek-d literal value>> second 1+ { tuple } <effect>
|
||||
apply-word/effect ;
|
||||
|
||||
: infer-(throw) ( -- )
|
||||
|
|
@ -561,9 +561,6 @@ do-primitive alien-invoke alien-indirect alien-callback
|
|||
\ <tuple> { tuple-layout } { tuple } define-primitive
|
||||
\ <tuple> make-flushable
|
||||
|
||||
\ <tuple-layout> { word fixnum array fixnum } { tuple-layout } define-primitive
|
||||
\ <tuple-layout> make-foldable
|
||||
|
||||
\ datastack { } { array } define-primitive
|
||||
\ datastack make-flushable
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ BIN: 111 tag-mask set
|
|||
8 num-tags set
|
||||
3 tag-bits set
|
||||
|
||||
18 num-types set
|
||||
17 num-types set
|
||||
|
||||
H{
|
||||
{ fixnum BIN: 000 }
|
||||
|
|
@ -29,9 +29,8 @@ tag-numbers get H{
|
|||
{ byte-array 10 }
|
||||
{ callstack 11 }
|
||||
{ string 12 }
|
||||
{ tuple-layout 13 }
|
||||
{ word 13 }
|
||||
{ quotation 14 }
|
||||
{ dll 15 }
|
||||
{ alien 16 }
|
||||
{ word 17 }
|
||||
} assoc-union type-numbers set
|
||||
|
|
|
|||
|
|
@ -147,7 +147,6 @@ bootstrapping? on
|
|||
"alien" "alien" create register-builtin
|
||||
"word" "words" create register-builtin
|
||||
"byte-array" "byte-arrays" create register-builtin
|
||||
"tuple-layout" "classes.tuple.private" create register-builtin
|
||||
|
||||
! For predicate classes
|
||||
"predicate-instance?" "classes.predicate" create drop
|
||||
|
|
@ -272,14 +271,6 @@ bi
|
|||
|
||||
"callstack" "kernel" create { } define-builtin
|
||||
|
||||
"tuple-layout" "classes.tuple.private" create {
|
||||
{ "hashcode" { "fixnum" "math" } read-only }
|
||||
{ "class" { "word" "words" } initial: t read-only }
|
||||
{ "size" { "fixnum" "math" } read-only }
|
||||
{ "superclasses" { "array" "arrays" } initial: { } read-only }
|
||||
{ "echelon" { "fixnum" "math" } read-only }
|
||||
} define-builtin
|
||||
|
||||
"tuple" "kernel" create
|
||||
[ { } define-builtin ]
|
||||
[ define-tuple-layout ]
|
||||
|
|
@ -510,7 +501,6 @@ tuple
|
|||
{ "array>quotation" "quotations.private" }
|
||||
{ "quotation-xt" "quotations" }
|
||||
{ "<tuple>" "classes.tuple.private" }
|
||||
{ "<tuple-layout>" "classes.tuple.private" }
|
||||
{ "profiling" "tools.profiler.private" }
|
||||
{ "become" "kernel.private" }
|
||||
{ "(sleep)" "threads.private" }
|
||||
|
|
|
|||
|
|
@ -49,4 +49,5 @@ load-help? off
|
|||
1 exit
|
||||
] if
|
||||
] %
|
||||
] [ ] make bootstrap-boot-quot set
|
||||
] [ ] make
|
||||
bootstrap-boot-quot set
|
||||
|
|
|
|||
|
|
@ -348,7 +348,7 @@ $nl
|
|||
{ $list
|
||||
{ { $snippet "\"predicate\"" } " - a quotation which tests if the top of the stack is an instance of this tuple class" }
|
||||
{ { $snippet "\"slots\"" } " - a sequence of " { $link slot-spec } " instances" }
|
||||
{ { $snippet "\"tuple-layout\"" } " - a " { $link tuple-layout } " instance" }
|
||||
{ { $snippet "\"tuple-layout\"" } " - an array with the tuple size and superclasses encoded in a format amneable to fast method dispatch" }
|
||||
} } ;
|
||||
|
||||
HELP: define-tuple-predicate
|
||||
|
|
@ -405,11 +405,11 @@ HELP: tuple>array ( tuple -- array )
|
|||
{ $description "Outputs an array having the tuple's slots as elements. The first element is the tuple class word and remainder are declared slots." } ;
|
||||
|
||||
HELP: <tuple> ( layout -- tuple )
|
||||
{ $values { "layout" tuple-layout } { "tuple" tuple } }
|
||||
{ $values { "layout" "a tuple layout array" } { "tuple" tuple } }
|
||||
{ $description "Low-level tuple constructor. User code should never call this directly, and instead use " { $link new } "." } ;
|
||||
|
||||
HELP: <tuple-boa> ( ... layout -- tuple )
|
||||
{ $values { "..." "values" } { "layout" tuple-layout } { "tuple" tuple } }
|
||||
{ $values { "..." "values" } { "layout" "a tuple layout array" } { "tuple" tuple } }
|
||||
{ $description "Low-level tuple constructor. User code should never call this directly, and instead use " { $link boa } "." } ;
|
||||
|
||||
HELP: new
|
||||
|
|
|
|||
|
|
@ -94,7 +94,7 @@ TUPLE: size-test a b c d ;
|
|||
|
||||
[ t ] [
|
||||
T{ size-test } tuple-size
|
||||
size-test tuple-layout size>> =
|
||||
size-test tuple-layout second =
|
||||
] unit-test
|
||||
|
||||
GENERIC: <yo-momma>
|
||||
|
|
|
|||
|
|
@ -10,8 +10,6 @@ IN: classes.tuple
|
|||
PREDICATE: tuple-class < class
|
||||
"metaclass" word-prop tuple-class eq? ;
|
||||
|
||||
M: tuple class 1 slot 2 slot { word } declare ;
|
||||
|
||||
ERROR: not-a-tuple object ;
|
||||
|
||||
: check-tuple ( object -- tuple )
|
||||
|
|
@ -29,10 +27,12 @@ PREDICATE: immutable-tuple-class < tuple-class ( class -- ? )
|
|||
"layout" word-prop ;
|
||||
|
||||
: layout-of ( tuple -- layout )
|
||||
1 slot { tuple-layout } declare ; inline
|
||||
1 slot { array } declare ; inline
|
||||
|
||||
M: tuple class layout-of 2 slot { word } declare ;
|
||||
|
||||
: tuple-size ( tuple -- size )
|
||||
layout-of size>> ; inline
|
||||
layout-of second ; inline
|
||||
|
||||
: prepare-tuple>array ( tuple -- n tuple layout )
|
||||
check-tuple [ tuple-size ] [ ] [ layout-of ] tri ;
|
||||
|
|
@ -90,15 +90,19 @@ ERROR: bad-superclass class ;
|
|||
2drop f
|
||||
] if ; inline
|
||||
|
||||
: tuple-instance? ( object class echelon -- ? )
|
||||
: tuple-instance? ( object class offset -- ? )
|
||||
#! 4 slot == superclasses>>
|
||||
rot dup tuple? [
|
||||
layout-of 4 slot { array } declare
|
||||
2dup 1 slot fixnum< [ array-nth eq? ] [ 3drop f ] if
|
||||
layout-of
|
||||
2dup 1 slot fixnum<=
|
||||
[ swap slot eq? ] [ 3drop f ] if
|
||||
] [ 3drop f ] if ; inline
|
||||
|
||||
: layout-class-offset ( class -- n )
|
||||
tuple-layout third 2 * 5 + ;
|
||||
|
||||
: define-tuple-predicate ( class -- )
|
||||
dup dup tuple-layout echelon>>
|
||||
dup dup layout-class-offset
|
||||
[ tuple-instance? ] 2curry define-predicate ;
|
||||
|
||||
: class-size ( class -- n )
|
||||
|
|
@ -145,10 +149,14 @@ ERROR: bad-superclass class ;
|
|||
define-accessors ;
|
||||
|
||||
: make-tuple-layout ( class -- layout )
|
||||
[ ]
|
||||
[ [ superclass class-size ] [ "slots" word-prop length ] bi + ]
|
||||
[ superclasses dup length 1- ] tri
|
||||
<tuple-layout> ;
|
||||
[
|
||||
{
|
||||
[ , ]
|
||||
[ [ superclass class-size ] [ "slots" word-prop length ] bi + , ]
|
||||
[ superclasses length 1- , ]
|
||||
[ superclasses [ [ , ] [ hashcode , ] bi ] each ]
|
||||
} cleave
|
||||
] { } make ;
|
||||
|
||||
: define-tuple-layout ( class -- )
|
||||
dup make-tuple-layout "layout" set-word-prop ;
|
||||
|
|
@ -284,7 +292,7 @@ M: tuple-class reset-class
|
|||
M: tuple-class rank-class drop 0 ;
|
||||
|
||||
M: tuple-class instance?
|
||||
dup tuple-layout echelon>> tuple-instance? ;
|
||||
dup layout-class-offset tuple-instance? ;
|
||||
|
||||
M: tuple-class (flatten-class) dup set ;
|
||||
|
||||
|
|
|
|||
|
|
@ -7,18 +7,28 @@ classes.algebra math math.private kernel.private
|
|||
quotations arrays definitions ;
|
||||
IN: generic.standard.engines.tuple
|
||||
|
||||
: nth-superclass% ( n -- ) 2 * 5 + , \ slot , ; inline
|
||||
|
||||
: nth-hashcode% ( n -- ) 2 * 6 + , \ slot , ; inline
|
||||
|
||||
: tuple-layout% ( -- )
|
||||
[ { tuple } declare 1 slot { array } declare ] % ; inline
|
||||
|
||||
: tuple-layout-echelon% ( -- )
|
||||
[ 4 slot ] % ; inline
|
||||
|
||||
TUPLE: echelon-dispatch-engine n methods ;
|
||||
|
||||
C: <echelon-dispatch-engine> echelon-dispatch-engine
|
||||
|
||||
TUPLE: trivial-tuple-dispatch-engine methods ;
|
||||
TUPLE: trivial-tuple-dispatch-engine n methods ;
|
||||
|
||||
C: <trivial-tuple-dispatch-engine> trivial-tuple-dispatch-engine
|
||||
|
||||
TUPLE: tuple-dispatch-engine echelons ;
|
||||
|
||||
: push-echelon ( class method assoc -- )
|
||||
>r swap dup "layout" word-prop echelon>> r>
|
||||
[ swap dup "layout" word-prop third ] dip
|
||||
[ ?set-at ] change-at ;
|
||||
|
||||
: echelon-sort ( assoc -- assoc' )
|
||||
|
|
@ -38,19 +48,20 @@ TUPLE: tuple-dispatch-engine echelons ;
|
|||
\ <tuple-dispatch-engine> convert-methods ;
|
||||
|
||||
M: trivial-tuple-dispatch-engine engine>quot
|
||||
methods>> engines>quots* linear-dispatch-quot ;
|
||||
[
|
||||
[ n>> nth-superclass% ]
|
||||
[ methods>> engines>quots* linear-dispatch-quot % ] bi
|
||||
] [ ] make ;
|
||||
|
||||
: hash-methods ( methods -- buckets )
|
||||
: hash-methods ( n methods -- buckets )
|
||||
>alist V{ } clone [ hashcode 1array ] distribute-buckets
|
||||
[ <trivial-tuple-dispatch-engine> ] map ;
|
||||
[ <trivial-tuple-dispatch-engine> ] with map ;
|
||||
|
||||
: word-hashcode% ( -- ) [ 1 slot ] % ;
|
||||
|
||||
: class-hash-dispatch-quot ( methods -- quot )
|
||||
: class-hash-dispatch-quot ( n methods -- quot )
|
||||
[
|
||||
\ dup ,
|
||||
word-hashcode%
|
||||
hash-methods [ engine>quot ] map hash-dispatch-quot %
|
||||
[ drop nth-hashcode% ]
|
||||
[ hash-methods [ engine>quot ] map hash-dispatch-quot % ] 2bi
|
||||
] [ ] make ;
|
||||
|
||||
: engine-word-name ( -- string )
|
||||
|
|
@ -79,29 +90,16 @@ M: engine-word irrelevant? drop t ;
|
|||
dup generic get "tuple-dispatch-generic" set-word-prop ;
|
||||
|
||||
: define-engine-word ( quot -- word )
|
||||
>r <engine-word> dup r> define ;
|
||||
|
||||
: array-nth% ( n -- ) 2 + , [ slot { word } declare ] % ;
|
||||
|
||||
: tuple-layout-superclasses% ( -- )
|
||||
[
|
||||
{ tuple } declare
|
||||
1 slot { tuple-layout } declare
|
||||
4 slot { array } declare
|
||||
] % ; inline
|
||||
[ <engine-word> dup ] dip define ;
|
||||
|
||||
: tuple-dispatch-engine-body ( engine -- quot )
|
||||
[
|
||||
picker %
|
||||
tuple-layout-superclasses%
|
||||
[ n>> array-nth% ]
|
||||
[
|
||||
methods>> [
|
||||
<trivial-tuple-dispatch-engine> engine>quot
|
||||
] [
|
||||
class-hash-dispatch-quot
|
||||
] if-small? %
|
||||
] bi
|
||||
tuple-layout%
|
||||
[ n>> ] [ methods>> ] bi
|
||||
[ <trivial-tuple-dispatch-engine> engine>quot ]
|
||||
[ class-hash-dispatch-quot ]
|
||||
if-small? %
|
||||
] [ ] make ;
|
||||
|
||||
M: echelon-dispatch-engine engine>quot
|
||||
|
|
@ -109,18 +107,7 @@ M: echelon-dispatch-engine engine>quot
|
|||
methods>> dup assoc-empty?
|
||||
[ drop default get ] [ values first engine>quot ] if
|
||||
] [
|
||||
[
|
||||
picker %
|
||||
tuple-layout-superclasses%
|
||||
[ n>> array-nth% ]
|
||||
[
|
||||
methods>> [
|
||||
<trivial-tuple-dispatch-engine> engine>quot
|
||||
] [
|
||||
class-hash-dispatch-quot
|
||||
] if-small? %
|
||||
] bi
|
||||
] [ ] make
|
||||
tuple-dispatch-engine-body
|
||||
] if ;
|
||||
|
||||
: >=-case-quot ( default alist -- quot )
|
||||
|
|
@ -132,13 +119,6 @@ M: echelon-dispatch-engine engine>quot
|
|||
] assoc-map
|
||||
alist>quot ;
|
||||
|
||||
: tuple-layout-echelon-quot ( -- quot )
|
||||
[
|
||||
{ tuple } declare
|
||||
1 slot { tuple-layout } declare
|
||||
5 slot
|
||||
] ; inline
|
||||
|
||||
: echelon-case-quot ( alist -- quot )
|
||||
#! We don't have to test for echelon 1 since all tuple
|
||||
#! classes are at least at depth 1 in the inheritance
|
||||
|
|
@ -147,7 +127,8 @@ M: echelon-dispatch-engine engine>quot
|
|||
[
|
||||
[
|
||||
picker %
|
||||
tuple-layout-echelon-quot %
|
||||
tuple-layout%
|
||||
tuple-layout-echelon%
|
||||
>=-case-quot %
|
||||
] [ ] make
|
||||
] unless-empty ;
|
||||
|
|
|
|||
|
|
@ -244,8 +244,6 @@ CELL unaligned_object_size(CELL pointer)
|
|||
case CALLSTACK_TYPE:
|
||||
return callstack_size(
|
||||
untag_fixnum_fast(((F_CALLSTACK *)pointer)->length));
|
||||
case TUPLE_LAYOUT_TYPE:
|
||||
return sizeof(F_TUPLE_LAYOUT);
|
||||
default:
|
||||
critical_error("Invalid header",pointer);
|
||||
return -1; /* can't happen */
|
||||
|
|
|
|||
11
vm/debug.c
11
vm/debug.c
|
|
@ -1,5 +1,7 @@
|
|||
#include "master.h"
|
||||
|
||||
static bool full_output;
|
||||
|
||||
void print_chars(F_STRING* str)
|
||||
{
|
||||
CELL i;
|
||||
|
|
@ -39,7 +41,7 @@ void print_array(F_ARRAY* array, CELL nesting)
|
|||
CELL i;
|
||||
bool trimmed;
|
||||
|
||||
if(length > 10)
|
||||
if(length > 10 && !full_output)
|
||||
{
|
||||
trimmed = true;
|
||||
length = 10;
|
||||
|
|
@ -68,7 +70,7 @@ void print_tuple(F_TUPLE* tuple, CELL nesting)
|
|||
CELL i;
|
||||
bool trimmed;
|
||||
|
||||
if(length > 10)
|
||||
if(length > 10 && !full_output)
|
||||
{
|
||||
trimmed = true;
|
||||
length = 10;
|
||||
|
|
@ -88,7 +90,7 @@ void print_tuple(F_TUPLE* tuple, CELL nesting)
|
|||
|
||||
void print_nested_obj(CELL obj, F_FIXNUM nesting)
|
||||
{
|
||||
if(nesting <= 0)
|
||||
if(nesting <= 0 && !full_output)
|
||||
{
|
||||
printf(" ... ");
|
||||
return;
|
||||
|
|
@ -342,6 +344,7 @@ void factorbug(void)
|
|||
printf("d <addr> <count> -- dump memory\n");
|
||||
printf("u <addr> -- dump object at tagged <addr>\n");
|
||||
printf(". <addr> -- print object at tagged <addr>\n");
|
||||
printf("t -- toggle output trimming\n");
|
||||
printf("s r -- dump data, retain stacks\n");
|
||||
printf(".s .r .c -- print data, retain, call stacks\n");
|
||||
printf("e -- dump environment\n");
|
||||
|
|
@ -404,6 +407,8 @@ void factorbug(void)
|
|||
print_obj(addr);
|
||||
printf("\n");
|
||||
}
|
||||
else if(strcmp(cmd,"t") == 0)
|
||||
full_output = !full_output;
|
||||
else if(strcmp(cmd,"s") == 0)
|
||||
dump_memory(ds_bot,ds);
|
||||
else if(strcmp(cmd,"r") == 0)
|
||||
|
|
|
|||
16
vm/layouts.h
16
vm/layouts.h
|
|
@ -52,13 +52,12 @@ typedef signed long long s64;
|
|||
#define BYTE_ARRAY_TYPE 10
|
||||
#define CALLSTACK_TYPE 11
|
||||
#define STRING_TYPE 12
|
||||
#define TUPLE_LAYOUT_TYPE 13
|
||||
#define WORD_TYPE 13
|
||||
#define QUOTATION_TYPE 14
|
||||
#define DLL_TYPE 15
|
||||
#define ALIEN_TYPE 16
|
||||
#define WORD_TYPE 17
|
||||
|
||||
#define TYPE_COUNT 20
|
||||
#define TYPE_COUNT 17
|
||||
|
||||
INLINE bool immediate_p(CELL obj)
|
||||
{
|
||||
|
|
@ -154,7 +153,8 @@ typedef struct {
|
|||
|
||||
/* Assembly code makes assumptions about the layout of this struct */
|
||||
typedef struct {
|
||||
/* C sucks. */
|
||||
/* We use a union here to force the float value to be aligned on an
|
||||
8-byte boundary. */
|
||||
union {
|
||||
CELL header;
|
||||
long long padding;
|
||||
|
|
@ -222,17 +222,17 @@ typedef struct
|
|||
CELL size;
|
||||
} F_STACK_FRAME;
|
||||
|
||||
/* These are really just arrays, but certain elements have special
|
||||
significance */
|
||||
typedef struct
|
||||
{
|
||||
CELL header;
|
||||
/* tagged fixnum */
|
||||
CELL hashcode;
|
||||
/* tagged */
|
||||
CELL capacity;
|
||||
/* tagged */
|
||||
CELL class;
|
||||
/* tagged fixnum */
|
||||
CELL size;
|
||||
/* tagged array */
|
||||
CELL superclasses;
|
||||
/* tagged fixnum */
|
||||
CELL echelon;
|
||||
} F_TUPLE_LAYOUT;
|
||||
|
|
|
|||
|
|
@ -127,7 +127,6 @@ void *primitives[] = {
|
|||
primitive_array_to_quotation,
|
||||
primitive_quotation_xt,
|
||||
primitive_tuple,
|
||||
primitive_tuple_layout,
|
||||
primitive_profiling,
|
||||
primitive_become,
|
||||
primitive_sleep,
|
||||
|
|
|
|||
16
vm/types.c
16
vm/types.c
|
|
@ -298,18 +298,6 @@ F_BYTE_ARRAY *growable_byte_array_append(F_BYTE_ARRAY *result, void *elts, CELL
|
|||
return result;
|
||||
}
|
||||
|
||||
/* Tuple layouts */
|
||||
DEFINE_PRIMITIVE(tuple_layout)
|
||||
{
|
||||
F_TUPLE_LAYOUT *layout = allot_object(TUPLE_LAYOUT_TYPE,sizeof(F_TUPLE_LAYOUT));
|
||||
layout->echelon = dpop();
|
||||
layout->superclasses = dpop();
|
||||
layout->size = dpop();
|
||||
layout->class = dpop();
|
||||
layout->hashcode = untag_word(layout->class)->hashcode;
|
||||
dpush(tag_object(layout));
|
||||
}
|
||||
|
||||
/* Tuples */
|
||||
|
||||
/* push a new tuple on the stack */
|
||||
|
|
@ -325,7 +313,7 @@ F_TUPLE *allot_tuple(F_TUPLE_LAYOUT *layout)
|
|||
DEFINE_PRIMITIVE(tuple)
|
||||
{
|
||||
F_TUPLE_LAYOUT *layout = untag_object(dpop());
|
||||
F_FIXNUM size = to_fixnum(layout->size);
|
||||
F_FIXNUM size = untag_fixnum_fast(layout->size);
|
||||
|
||||
F_TUPLE *tuple = allot_tuple(layout);
|
||||
F_FIXNUM i;
|
||||
|
|
@ -339,7 +327,7 @@ DEFINE_PRIMITIVE(tuple)
|
|||
DEFINE_PRIMITIVE(tuple_boa)
|
||||
{
|
||||
F_TUPLE_LAYOUT *layout = untag_object(dpop());
|
||||
F_FIXNUM size = to_fixnum(layout->size);
|
||||
F_FIXNUM size = untag_fixnum_fast(layout->size);
|
||||
|
||||
REGISTER_UNTAGGED(layout);
|
||||
F_TUPLE *tuple = allot_tuple(layout);
|
||||
|
|
|
|||
Loading…
Reference in New Issue