Starting work on record1 strings

db4
Slava Pestov 2008-01-31 20:11:46 -06:00
parent 92ebcc3619
commit 6530057512
11 changed files with 61 additions and 56 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel math namespaces sequences system
kernel.private tuples ;
kernel.private tuples bit-arrays byte-arrays float-arrays ;
IN: alien
! Some predicate classes used by the compiler for optimization
@ -9,16 +9,11 @@ IN: alien
PREDICATE: alien simple-alien
underlying-alien not ;
! These mixins are not intended to be extended by user code.
! They are not unions, because if they were we'd have a circular
! dependency between alien and {byte,bit,float}-arrays.
MIXIN: simple-c-ptr
INSTANCE: simple-alien simple-c-ptr
INSTANCE: f simple-c-ptr
UNION: simple-c-ptr
simple-alien POSTPONE: f byte-array bit-array float-array ;
MIXIN: c-ptr
INSTANCE: alien c-ptr
INSTANCE: f c-ptr
UNION: c-ptr
alien POSTPONE: f byte-array bit-array float-array ;
DEFER: pinned-c-ptr?

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math alien kernel kernel.private sequences
USING: math alien.accessors kernel kernel.private sequences
sequences.private ;
IN: bit-arrays
@ -52,5 +52,3 @@ M: bit-array resize
resize-bit-array ;
INSTANCE: bit-array sequence
INSTANCE: bit-array simple-c-ptr
INSTANCE: bit-array c-ptr

View File

@ -259,6 +259,7 @@ M: wrapper '
string type-number object tag-number [
dup length emit-fixnum
f ' emit
f ' emit
pack-string emit-chars
] emit-object ;

View File

@ -40,6 +40,7 @@ call
! classes will go
{
"alien"
"alien.accessors"
"arrays"
"bit-arrays"
"bit-vectors"
@ -190,6 +191,11 @@ num-types get f <array> builtins set
"length"
{ "length" "sequences" }
f
} {
{ "object" "kernel" }
"aux"
{ "string-aux" "strings.private" }
{ "set-string-aux" "strings.private" }
}
} define-builtin
@ -556,32 +562,32 @@ builtins get num-tags get tail f union-class define-class
{ "<byte-array>" "byte-arrays" }
{ "<bit-array>" "bit-arrays" }
{ "<displaced-alien>" "alien" }
{ "alien-signed-cell" "alien" }
{ "set-alien-signed-cell" "alien" }
{ "alien-unsigned-cell" "alien" }
{ "set-alien-unsigned-cell" "alien" }
{ "alien-signed-8" "alien" }
{ "set-alien-signed-8" "alien" }
{ "alien-unsigned-8" "alien" }
{ "set-alien-unsigned-8" "alien" }
{ "alien-signed-4" "alien" }
{ "set-alien-signed-4" "alien" }
{ "alien-unsigned-4" "alien" }
{ "set-alien-unsigned-4" "alien" }
{ "alien-signed-2" "alien" }
{ "set-alien-signed-2" "alien" }
{ "alien-unsigned-2" "alien" }
{ "set-alien-unsigned-2" "alien" }
{ "alien-signed-1" "alien" }
{ "set-alien-signed-1" "alien" }
{ "alien-unsigned-1" "alien" }
{ "set-alien-unsigned-1" "alien" }
{ "alien-float" "alien" }
{ "set-alien-float" "alien" }
{ "alien-double" "alien" }
{ "set-alien-double" "alien" }
{ "alien-cell" "alien" }
{ "set-alien-cell" "alien" }
{ "alien-signed-cell" "alien.accessors" }
{ "set-alien-signed-cell" "alien.accessors" }
{ "alien-unsigned-cell" "alien.accessors" }
{ "set-alien-unsigned-cell" "alien.accessors" }
{ "alien-signed-8" "alien.accessors" }
{ "set-alien-signed-8" "alien.accessors" }
{ "alien-unsigned-8" "alien.accessors" }
{ "set-alien-unsigned-8" "alien.accessors" }
{ "alien-signed-4" "alien.accessors" }
{ "set-alien-signed-4" "alien.accessors" }
{ "alien-unsigned-4" "alien.accessors" }
{ "set-alien-unsigned-4" "alien.accessors" }
{ "alien-signed-2" "alien.accessors" }
{ "set-alien-signed-2" "alien.accessors" }
{ "alien-unsigned-2" "alien.accessors" }
{ "set-alien-unsigned-2" "alien.accessors" }
{ "alien-signed-1" "alien.accessors" }
{ "set-alien-signed-1" "alien.accessors" }
{ "alien-unsigned-1" "alien.accessors" }
{ "set-alien-unsigned-1" "alien.accessors" }
{ "alien-float" "alien.accessors" }
{ "set-alien-float" "alien.accessors" }
{ "alien-double" "alien.accessors" }
{ "set-alien-double" "alien.accessors" }
{ "alien-cell" "alien.accessors" }
{ "set-alien-cell" "alien.accessors" }
{ "alien>char-string" "alien" }
{ "string>char-alien" "alien" }
{ "alien>u16-string" "alien" }

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel kernel.private alien sequences sequences.private
math ;
USING: kernel kernel.private alien.accessors sequences
sequences.private math ;
IN: byte-arrays
M: byte-array clone (clone) ;
@ -19,5 +19,3 @@ M: byte-array resize
resize-byte-array ;
INSTANCE: byte-array sequence
INSTANCE: byte-array simple-c-ptr
INSTANCE: byte-array c-ptr

View File

@ -10,7 +10,7 @@ IN: compiler.constants
! These constants must match vm/layouts.h
: header-offset object tag-number neg ;
: float-offset 8 float tag-number - ;
: string-offset 3 bootstrap-cells object tag-number - ;
: string-offset 4 bootstrap-cells object tag-number - ;
: profile-count-offset 7 bootstrap-cells object tag-number - ;
: byte-array-offset 2 bootstrap-cells object tag-number - ;
: alien-offset 3 bootstrap-cells object tag-number - ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel kernel.private alien sequences
USING: kernel kernel.private alien.accessors sequences
sequences.private math math.private ;
IN: float-arrays
@ -33,8 +33,6 @@ M: float-array resize
resize-float-array ;
INSTANCE: float-array sequence
INSTANCE: float-array simple-c-ptr
INSTANCE: float-array c-ptr
: 1float-array ( x -- array ) 1 swap <float-array> ; flushable

View File

@ -1,14 +1,20 @@
! Copyright (C) 2003, 2007 Slava Pestov.
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.private sequences kernel.private
math sequences.private slots.private ;
math sequences.private slots.private byte-arrays
alien.accessors ;
IN: strings
<PRIVATE
: string-hashcode 2 slot ; inline
: make-string-aux ( string -- aux )
dup string-aux
[ ] [ dup length <byte-array> dup rot set-string-aux ] ?if
{ byte-array } declare ; inline
: set-string-hashcode 2 set-slot ; inline
: string-hashcode 3 slot ; inline
: set-string-hashcode 3 set-slot ; inline
: reset-string-hashcode f swap set-string-hashcode ; inline

View File

@ -4,7 +4,7 @@ void print_chars(F_STRING* str)
{
CELL i;
for(i = 0; i < string_capacity(str); i++)
putchar(cget(SREF(str,i)));
putchar(string_nth(str,i));
}
void print_word(F_WORD* word, CELL nesting)

View File

@ -106,6 +106,8 @@ typedef struct {
/* tagged num of chars */
CELL length;
/* tagged */
CELL aux;
/* tagged */
CELL hashcode;
} F_STRING;

View File

@ -429,10 +429,11 @@ F_STRING* allot_string_internal(CELL capacity)
/* strings are null-terminated in memory, even though they also
have a length field. The null termination allows us to add
the sizeof(F_STRING) to a Factor string to get a C-style
UCS-2 string for C library calls. */
cput(SREF(string,capacity),(u16)'\0');
char* string for C library calls. */
set_string_nth(string,capacity,0);
string->length = tag_fixnum(capacity);
string->hashcode = F;
string->aux = F;
return string;
}
@ -446,7 +447,7 @@ void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
CELL i;
for(i = start; i < capacity; i++)
cput(SREF(string,i),fill);
set_string_nth(string,i,fill);
}
}
@ -499,7 +500,7 @@ DEFINE_PRIMITIVE(resize_string)
CELL i; \
for(i = 0; i < length; i++) \
{ \
cput(SREF(s,i),(utype)*string); \
set_string_nth(s,i,(utype)*string); \
string++; \
} \
return s; \