suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add stencil vectors and fxpopcount

Browse Source 
original commit: ec766fca869b5e0407c4f54230b72619af73b40b
This commit is contained in:
Matthew Flatt 2020-01-03 17:09:28 -07:00
parent 27883d2749
commit 81ea967aea
67 changed files with 1446 additions and 285 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
c/Mf-base
View File

@ -41,7 +41,7 @@ kernelsrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-ocd.c gc-
kernelobj=${kernelsrc:%.c=%.$o} ${mdobj}
kernelhdr=system.h types.h version.h globals.h externs.h segment.h gc.c sort.h thread.h config.h compress-io.h itest.c nocurses.h
kernelhdr=system.h types.h version.h globals.h externs.h segment.h gc.c sort.h thread.h config.h compress-io.h itest.c nocurses.h popcount.h
mainsrc=main.c
@ -64,7 +64,7 @@ endif
scheme.o: itest.c
scheme.o main.o: config.h
${kernelobj}: system.h types.h version.h externs.h globals.h segment.h thread.h sort.h compress-io.h nocurses.h
${kernelobj}: system.h types.h version.h externs.h globals.h segment.h thread.h sort.h compress-io.h nocurses.h popcount.h
${kernelobj}: ${Include}/equates.h ${Include}/scheme.h
${mainobj}: ${Include}/scheme.h
${kernelobj}: ${zlibHeaderDep} ${LZ4HeaderDep}

14
c/alloc.c
View File

@ -15,6 +15,7 @@
*/
#include "system.h"
#include "popcount.h"
/* locally defined functions */
static void maybe_fire_collector PROTO((void));
@ -596,6 +597,19 @@ ptr S_null_immutable_string() {
return v;
}
ptr S_stencil_vector(mask) uptr mask; {
ptr tc;
ptr p; iptr d;
iptr n = Spopcount(mask);
tc = get_thread_context();
d = size_stencil_vector(n);
thread_find_room(tc, type_typed_object, d, p);
VECTTYPE(p) = (mask << stencil_vector_mask_offset) | type_stencil_vector;
return p;
}
ptr S_record(n) iptr n; {
ptr tc = get_thread_context();
ptr p;

1
c/externs.h
View File

@ -82,6 +82,7 @@ extern ptr S_null_immutable_vector PROTO((void));
extern ptr S_null_immutable_fxvector PROTO((void));
extern ptr S_null_immutable_bytevector PROTO((void));
extern ptr S_null_immutable_string PROTO((void));
extern ptr S_stencil_vector PROTO((uptr mask));
extern ptr S_record PROTO((iptr n));
extern ptr S_closure PROTO((ptr cod, iptr n));
extern ptr S_mkcontinuation PROTO((ISPC s, IGEN g, ptr nuate, ptr stack,

10
c/fasl.c
View File

@ -178,6 +178,7 @@
#include "system.h"
#include "zlib.h"
#include "popcount.h"
#ifdef WIN32
#include <io.h>
@ -721,6 +722,15 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
}
return;
}
case fasl_type_stencil_vector: {
uptr mask; iptr n; ptr *p;
mask = uptrin(f);
*x = S_stencil_vector(mask);
p = &INITSTENVECTIT(*x, 0);
n = Spopcount(mask);
while (n--) faslin(tc, p++, t, pstrbuf, f);
return;
}
case fasl_type_base_rtd: {
ptr rtd;
if ((rtd = S_G.base_rtd) == Sfalse) {

26
c/gc.c
View File

@ -19,6 +19,7 @@
#ifndef WIN32
#include <sys/wait.h>
#endif /* WIN32 */
#include "popcount.h"
#define enable_object_counts do_not_use_enable_object_counts_in_this_file_use_ifdef_ENABLE_OBJECT_COUNTS_instead
@ -390,6 +391,21 @@ static ptr copy(pp, si) ptr pp; seginfo *si; {
copy_ptrs(type_typed_object, p, pp, n);
/* pad if necessary */
if ((len & 1) == 0) INITVECTIT(p, len) = FIX(0);
} else if (TYPEP(tf, mask_stencil_vector, type_stencil_vector)) {
iptr len, n;
ISPC s;
len = Sstencil_vector_length(pp);
n = size_stencil_vector(len);
#ifdef ENABLE_OBJECT_COUNTS
S_G.countof[tg][countof_stencil_vector] += 1;
S_G.bytesof[tg][countof_stencil_vector] += n;
#endif /* ENABLE_OBJECT_COUNTS */
/* assumes stencil types look like immediate; if not, stencil vectors will need their own space */
s = (BACKREFERENCES_ENABLED ? space_impure_typed_object : space_impure);
find_room(s, tg, type_typed_object, n, p);
copy_ptrs(type_typed_object, p, pp, n);
/* pad if necessary */
if ((len & 1) == 0) INITSTENVECTIT(p, len) = FIX(0);
} else if (TYPEP(tf, mask_string, type_string)) {
iptr n;
n = size_string(Sstring_length(pp));
@ -733,6 +749,8 @@ static void sweep(ptr tc, ptr p, IBOOL sweep_pure) {
/* typed objects */
} else if (tf = TYPEFIELD(p), TYPEP(tf, mask_vector, type_vector)) {
sweep_ptrs(&INITVECTIT(p, 0), Svector_length(p));
} else if (tf = TYPEFIELD(p), TYPEP(tf, mask_stencil_vector, type_stencil_vector)) {
sweep_ptrs(&INITVECTIT(p, 0), Sstencil_vector_length(p));
} else if (TYPEP(tf, mask_string, type_string) || TYPEP(tf, mask_bytevector, type_bytevector) || TYPEP(tf, mask_fxvector, type_fxvector)) {
/* nothing to sweep */;
} else if (TYPEP(tf, mask_record, type_record)) {
@ -831,6 +849,11 @@ static void sweep_in_old(ptr tc, ptr p) {
relocate(&p)
return;
}
} else if (tf = TYPEFIELD(p), TYPEP(tf, mask_stencil_vector, type_stencil_vector)) {
if (scan_ptrs_for_self(&INITSTENVECTIT(p, 0), Sstencil_vector_length(p), p)) {
relocate(&p)
return;
}
} else if (TYPEP(tf, mask_string, type_string) || TYPEP(tf, mask_bytevector, type_bytevector) || TYPEP(tf, mask_fxvector, type_fxvector)) {
/* nothing to sweep */
return;
@ -1741,6 +1764,8 @@ static iptr size_object(p) ptr p; {
/* typed objects */
} else if (tf = TYPEFIELD(p), TYPEP(tf, mask_vector, type_vector)) {
return size_vector(Svector_length(p));
} else if (tf = TYPEFIELD(p), TYPEP(tf, mask_stencil_vector, type_stencil_vector)) {
return size_vector(Sstencil_vector_length(p));
} else if (TYPEP(tf, mask_string, type_string)) {
return size_string(Sstring_length(p));
} else if (TYPEP(tf, mask_bytevector, type_bytevector)) {
@ -2503,6 +2528,7 @@ IGEN sweep_dirty_intersecting(ptr lst, ptr *pp, ptr *ppend, IGEN tg, IGEN younge
} else {
ptr tf = TYPEFIELD(p);
if (TYPEP(tf, mask_vector, type_vector)
|| TYPEP(tf, mask_stencil_vector, type_stencil_vector)
|| TYPEP(tf, mask_box, type_box)
|| ((iptr)tf == type_tlc)) {
/* impure objects */

4
c/gcwrapper.c
View File

@ -126,8 +126,10 @@ void S_gc_init() {
S_G.countof_size[countof_guardian] = size_guardian_entry;
INITVECTIT(S_G.countof_names, countof_oblist) = S_intern((const unsigned char *)"oblist");
S_G.countof_size[countof_guardian] = 0;
INITVECTIT(S_G.countof_names, countof_ephemeron) = S_intern((const unsigned char *)"ephemron");
INITVECTIT(S_G.countof_names, countof_ephemeron) = S_intern((const unsigned char *)"ephemeron");
S_G.countof_size[countof_ephemeron] = 0;
INITVECTIT(S_G.countof_names, countof_stencil_vector) = S_intern((const unsigned char *)"stencil-vector");
S_G.countof_size[countof_stencil_vector] = 0;
for (i = 0; i < countof_types; i += 1) {
if (Svector_ref(S_G.countof_names, i) == FIX(0)) {
fprintf(stderr, "uninitialized countof_name at index %d\n", i);

35
c/popcount.h Normal file
View File

@ -0,0 +1,35 @@
#if __GNUC__ >= 5
static int Spopcount_32(U32 x)
{
return __builtin_popcount(x);
}
#else
static int Spopcount_32(U32 x)
{
/* http://bits.stephan-brumme.com/countBits.html */
/* count bits of each 2-bit chunk */
x = x - ((x >> 1) & 0x55555555);
/* count bits of each 4-bit chunk */
x = (x & 0x33333333) + ((x >> 2) & 0x33333333);
/* count bits of each 8-bit chunk */
x = x + (x >> 4);
/* mask out junk */
x &= 0xF0F0F0F;
/* add all four 8-bit chunks */
return (x * 0x01010101) >> 24;
}
#endif
#if ptr_bits == 32
static int Spopcount(uptr x)
{
return Spopcount_32((U32)x);
}
#elif ptr_bits == 64
static int Spopcount(uptr x)
{
return Spopcount_32((U32)(x & 0xFFFFFFFF)) + Spopcount_32((U32)(x >> 32));
}
#endif

1
c/types.h
View File

@ -227,6 +227,7 @@ typedef struct _bucket_pointer_list {
/* size macros for variable-sized objects */
#define size_vector(n) ptr_align(header_size_vector + (n)*ptr_bytes)
#define size_stencil_vector(n) ptr_align(header_size_stencil_vector + (n)*ptr_bytes)
#define size_closure(n) ptr_align(header_size_closure + (n)*ptr_bytes)
#define size_string(n) ptr_align(header_size_string + (n)*string_char_bytes)
#define size_fxvector(n) ptr_align(header_size_fxvector + (n)*ptr_bytes)

13
c/vfasl.c
View File

@ -15,6 +15,7 @@
*/
#include "system.h"
#include "popcount.h"
/*
@ -1030,6 +1031,14 @@ static ptr copy(vfasl_info *vfi, ptr pp, seginfo *si) {
copy_ptrs(type_typed_object, p, pp, n);
/* pad if necessary */
if ((len & 1) == 0) INITVECTIT(p, len) = FIX(0);
} else if (TYPEP(tf, mask_stencil_vector, type_stencil_vector)) {
iptr len, n;
len = Sstencil_vector_length(pp);
n = size_stencil_vector(len);
FIND_ROOM(vfi, vspace_impure, type_typed_object, n, p);
copy_ptrs(type_typed_object, p, pp, n);
/* pad if necessary */
if ((len & 1) == 0) INITSTENVECTIT(p, len) = FIX(0);
} else if (TYPEP(tf, mask_string, type_string)) {
iptr n;
n = size_string(Sstring_length(pp));
@ -1238,6 +1247,10 @@ static uptr sweep(vfasl_info *vfi, ptr p) {
uptr len = Svector_length(p);
sweep_ptrs(vfi, &INITVECTIT(p, 0), len);
return size_vector(len);
} else if (tf = TYPEFIELD(p), TYPEP(tf, mask_stencil_vector, type_stencil_vector)) {
uptr len = Sstencil_vector_length(p);
sweep_ptrs(vfi, &INITSTENVECTIT(p, 0), len);
return size_stencil_vector(len);
} else if (TYPEP(tf, mask_record, type_record)) {
return sweep_record(vfi, p);
} else if (TYPEP(tf, mask_box, type_box)) {

15
csug/numeric.stex
View File

@ -1376,6 +1376,21 @@ bits in a fixnum, i.e.,
(fxsra -64 3) ;=> -8
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{fxpopcount}{\categoryprocedure}{(fxpopcount \var{fixnum} \dots)}
\formdef{fxpopcount32}{\categoryprocedure}{(fxpopcount32 \var{fixnum} \dots)}
\formdef{fxpopcount16}{\categoryprocedure}{(fxpopcount16 \var{fixnum} \dots)}
\returns number of bits set in \var{fixnum}
\listlibraries
\endentryheader
\noindent
\var{fixnum} must be non-negative, and it must have a width of no more than 32 for
\scheme{fxpopcount32} or no more than 16 for \scheme{fxpopcount16}.
\var{fixnum} is treated as a two's complement integer, regardless
of the underlying representation.
\section{Random Number Generation\label{SECTNUMERICRANDOM}}

142
csug/objects.stex
View File

@ -1211,6 +1211,148 @@ Uncompresses a \var{bytevector} produced by
as the original given to \scheme{bytevector-compress}.
\section{Stencil Vectors}
\index{stencil vectors}Stencil vectors are like vectors, but a stencil
vector has a mask fixnum that is accessible via
\scheme{stencil-vector-mask} and that also determines the stencil
vector's size. Since the size is limited to
\scheme{(stencil-vector-mask-width)}, which is no more than the number
of bits in a fixnum, the size of a stencil vector is limited.
A stencil vector provides a more compact representation than a vector
with one element dedicated to the mask. It also provides more
efficient functional update through the \scheme{stencil-vector-update}
function. A stencil vector is useful, for example, to implement
sparse nodes in a trie.
\index{\scheme{#stencil}}Stencil vectors are written with
the prefix \scheme{#stencil}, followed by a hexadecimal mask mask in square
brackets, and followed by a parenthesized sequence of elements.
%----------------------------------------------------------------------------
\entryheader
\formdef{stencil-vector-mask-width}{\categoryprocedure}{(stencil-vector-mask-width)}
\returns a fixnum: the number of bits in a stencil vector mask
\listlibraries
\endentryheader
\noindent
The result is always less than \scheme{(fixnum-width)]}.
%----------------------------------------------------------------------------
\entryheader
\formdef{stencil-vector?}{\categoryprocedure}{(stencil-vector? \var{obj})}
\returns \scheme{#t} if \var{obj} is a stencil vector, \scheme{#f} otherwise
\listlibraries
\endentryheader
%----------------------------------------------------------------------------
\entryheader
\formdef{stencil-vector}{\categoryprocedure}{(stencil-vector \var{mask} \var{obj} \dots)}
\returns a stencil vector with the given mask and content
\listlibraries
\endentryheader
\noindent
\var{mask} must be a nonnegative fixnum less than
\scheme{(fxsll 1 (stencil-vector-mask-width))},
and the number of supplied \var{obj}s must be the
same as \scheme{(fxpopcount mask)}.
%----------------------------------------------------------------------------
\entryheader
\formdef{stencil-vector-mask}{\categoryprocedure}{(stencil-vector-mask \var{stencil-vector})}
\formdef{stencil-vector-length}{\categoryprocedure}{(stencil-vector-length \var{stencil-vector})}
\returns the mask or length (as determined by the mask) of \var{stencil-vector}
\listlibraries
\endentryheader
%----------------------------------------------------------------------------
\entryheader
\formdef{stencil-vector-ref}{\categoryprocedure}{(stencil-vector-ref \var{stencil-vector} \var{n})}
\returns the object at position \var{n} in \var{stencil-vector}
\listlibraries
\endentryheader
\noindent
\var{n} must be a nonnegative fixnum that is less than the length of \var{stencil-vector}.
Stencil vector elements are accessed by position---unrelated to the
stencil vector's mask, except that the number of valid positions is
determined by the mask.
Conceptually, each stensil vector element corresponds to a bit in the
stencil vector's mask. To convert a a bit position \var{bit} to an
index, where the lowest set bit corresponds to the first element of
the stencil vector, use the following calculation:
\scheme{(fxpopcount (fxand (stencil-vector-mask \var{stencil-vector}) (fx- \var{bit} 1)))}
%----------------------------------------------------------------------------
\entryheader
\formdef{stencil-vector-set!}{\categoryprocedure}{(stencil-vector-set! \var{stencil-vector} \var{n} \var{obj})}
\returns unspecified
\listlibraries
\endentryheader
\noindent
\var{n} must be a nonnegative fixnum that is less than the length of \var{stencil-vector}.
Installs \var{obj} at position \var{n} within \var{stencil-vector}.
See \scheme{stencil-vector-ref} for more information about positions
in stencil vectors.
%----------------------------------------------------------------------------
\entryheader
\formdef{stencil-vector-update}{\categoryprocedure}{(stencil-vector-update \var{stencil-vector} \var{remove-bits} \var{add-bits} \var{obj} \dots)}
\returns a new stencil vector adapted frmo \var{stencil-vector}
\listlibraries
\endentryheader
\noindent
\var{remove-bits} and \var{add-bits} must be nonnegative fixnums, and then must be less
than \scheme{(fxsll 1 (stencil-vector-mask-width))}. Furthermore:
\begin{itemize}
\item \var{remove-bits}
must have a subset of the bits in the mask of \var{stencil-vector},
\item \var{add-bits} must have a set of bits that do not overlap the
subtraction of \var{remove-bits} from the mask of
\var{stencil-vector}, and
\item the number of supplied \var{obj}s must match \scheme{(fxpopcount add-bits)}.
\end{itemize}
Returns a new stencil vector that has all of the elements of
\var{stencil-vector}, except the ones identified by the bits in
\var{remove-bits}. The new stencil vector also has the given \var{obj}s at
positions determined by \var{add-bits}. Elements copied from \var{stencil-vector}
to the new vector retain their relative positions corresponding to their
bits in the \var{stencil-vector} mask. Individual bits in a mask, \var{remove-bits},
and \var{add-bits} are mapped to element positions as described in the documentation
of \scheme{stencil-vector-ref}. The mask of the new stencil mask is the mask of
\var{stencil-vector} minus \var{remove-bits} plus \var{add-bits}.
%----------------------------------------------------------------------------
\entryheader
\formdef{stencil-vector-truncate!}{\categoryprocedure}{(stencil-vector-truncate! \var{stencil-vector} \var{mask})}
\returns unspecified
\listlibraries
\endentryheader
\noindent
\var{mask} must be a nonnegative fixnum that has fewer bits set than in the current mask of \var{stencil-vector}.
Changes the mask of \var{stencil-vector} to \var{mask}, discarding any
elements of the vector beyond the first \scheme{(fxpopcount \var{mask})} elements.
There is no requirement that \var{mask} has any bits in common with
the current mask of \var{stencil-vector}.
\section{Boxes\label{SECTBOXES}}
\index{boxes}Boxes are single-cell objects that are primarily useful for providing

2
makefiles/Mf-install.in
View File

@ -62,7 +62,7 @@ InstallLZ4Target=
# no changes should be needed below this point #
###############################################################################
Version=csv9.5.3.9
Version=csv9.5.3.10
Include=boot/$m
PetiteBoot=boot/$m/petite.boot
SchemeBoot=boot/$m/scheme.boot

27
mats/5_3.ms
View File

@ -6484,3 +6484,30 @@
'((0 . 3/5) (0 . -3/5) (0 . 3/5) (0 . -3/5)
(5 . 2/7) (-5 . -2/7) (-5 . 2/7) (5 . -2/7)))
)
(mat popcount
(error? (fxpopcount #f))
(error? (fxpopcount 1.0))
(error? (fxpopcount (expt 2 100)))
(error? (fxpopcount -1))
(error? (fxpopcount32 #f))
(error? (fxpopcount32 1.0))
(error? (fxpopcount32 (expt 2 100)))
(error? (fxpopcount32 -1))
(error? (fxpopcount16 #f))
(error? (fxpopcount16 1.0))
(error? (fxpopcount16 (expt 2 100)))
(error? (fxpopcount16 (expt 2 20)))
(error? (fxpopcount16 -1))
(eqv? 0 (fxpopcount 0))
(eqv? 0 (fxpopcount32 0))
(eqv? 0 (fxpopcount16 0))
(eqv? 3 (fxpopcount #b1001001))
(eqv? 3 (fxpopcount32 #b1001001))
(eqv? 3 (fxpopcount16 #b1001001))
(eqv? 28 (fxpopcount #b1111111111111111111111111111))
(eqv? 28 (fxpopcount32 #b1111111111111111111111111111))
(eqv? 16 (fxpopcount #b1111111111111111))
(eqv? 16 (fxpopcount32 #b1111111111111111))
(eqv? 16 (fxpopcount16 #b1111111111111111))
)

150
mats/5_6.ms
View File

@ -1300,3 +1300,153 @@
(collect 0)
(eq? g1 (vector-ref vec2 2))))))
)
(mat stencil-vector
(>= (stencil-vector-mask-width) 24)
(stencil-vector? (stencil-vector 1 0))
(not (stencil-vector? 10))
(begin
(define alphabet-sv (stencil-vector #b10101010101010101010 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j))
(define mod-sv (stencil-vector #b1001 'a 'b))
(and (stencil-vector? alphabet-sv)
(stencil-vector? mod-sv)))
(error? (stencil-vector 'x))
(error? (stencil-vector -1))
(error? (stencil-vector 0 'apple))
(error? (stencil-vector 3 'apple))
(error? (stencil-vector 3 'apple))
(error? (stencil-vector (expt 2 (stencil-vector-mask-width)) 'a))
(error? (stencil-vector-length 3))
(error? (stencil-vector-mask 3))
(error? (stencil-vector-ref 3 0))
(eqv? 2 (stencil-vector-length (stencil-vector 3 'apple 'banana)))
(eqv? 3 (stencil-vector-mask (stencil-vector 3 'apple 'banana)))
(eqv? 2 (stencil-vector-length (stencil-vector 514 'apple 'banana)))
(eqv? 514 (stencil-vector-mask (stencil-vector 514 'apple 'banana)))
(eqv? 10 (stencil-vector-length (stencil-vector 1023 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j)))
(eqv? 1 (stencil-vector-length (stencil-vector (expt 2 (sub1 (stencil-vector-mask-width))) 'a)))
(eqv? 1 (stencil-vector-length (stencil-vector (expt 2 (- (stencil-vector-mask-width) 2)) 'a)))
(error? (stencil-vector-ref (stencil-vector 0) 0))
(error? (stencil-vector-ref (stencil-vector 3 'apple 'banana) 2))
(error? (stencil-vector-ref (stencil-vector 3 'apple 'banana) -1))
(error? (stencil-vector-ref (stencil-vector 3 'apple 'banana) (expt 2 100)))
(error? (stencil-vector-ref (stencil-vector 3 'apple 'banana) 1.0))
(eq? 'a (stencil-vector-ref alphabet-sv 0))
(eq? 'f (stencil-vector-ref alphabet-sv 5))
(eq? 'j (stencil-vector-ref alphabet-sv 9))
(error? (stencil-vector-set! (stencil-vector 0) 0 'x))
(error? (stencil-vector-set! (stencil-vector 3 'apple 'banana) 2 'x))
(error? (stencil-vector-set! (stencil-vector 3 'apple 'banana) -1 'x))
(error? (stencil-vector-set! (stencil-vector 3 'apple 'banana) (expt 2 100) 'x))
(error? (stencil-vector-set! (stencil-vector 3 'apple 'banana) 1.0 'x))
(equal? '(ok b) (begin
(stencil-vector-set! mod-sv 0 'ok)
(list (stencil-vector-ref mod-sv 0)
(stencil-vector-ref mod-sv 1))))
(error? (stencil-vector-update 1 0 1 'z))
(error? (stencil-vector-update alphabet-sv 0 2 'z))
(error? (stencil-vector-update alphabet-sv 1 0))
(error? (stencil-vector-update alphabet-sv 0 1))
(error? (stencil-vector-update alphabet-sv 0 1 'a 'b))
;; add 1
(let ([v (stencil-vector-update alphabet-sv 0 1 'z)])
(and (eqv? 11 (stencil-vector-length v))
(eq? 'z (stencil-vector-ref v 0))
(eq? 'a (stencil-vector-ref v 1))
(eq? 'b (stencil-vector-ref v 2))
(eq? 'j (stencil-vector-ref v 10))))
;; add 2
(let ([v (stencil-vector-update alphabet-sv 0 #b10001 'z 'w)])
(and (eqv? 12 (stencil-vector-length v))
(eq? 'z (stencil-vector-ref v 0))
(eq? 'a (stencil-vector-ref v 1))
(eq? 'b (stencil-vector-ref v 2))
(eq? 'w (stencil-vector-ref v 3))
(eq? 'c (stencil-vector-ref v 4))
(eq? 'j (stencil-vector-ref v 11))))
;; remove 1
(let ([v (stencil-vector-update alphabet-sv 2 0)])
(and (eqv? 9 (stencil-vector-length v))
(eq? 'b (stencil-vector-ref v 0))
(eq? 'c (stencil-vector-ref v 1))
(eq? 'j (stencil-vector-ref v 8))))
;; remove 2
(let ([v (stencil-vector-update alphabet-sv #b10000010 0)])
(and (eqv? 8 (stencil-vector-length v))
(eq? 'b (stencil-vector-ref v 0))
(eq? 'c (stencil-vector-ref v 1))
(eq? 'e (stencil-vector-ref v 2))
(eq? 'j (stencil-vector-ref v 7))))
;; add 2 and remove 2
(let ([v (stencil-vector-update alphabet-sv #b10000010 #b10001 'z 'w)])
(and (eqv? 10 (stencil-vector-length v))
(eq? 'z (stencil-vector-ref v 0))
(eq? 'b (stencil-vector-ref v 1))
(eq? 'w (stencil-vector-ref v 2))
(eq? 'c (stencil-vector-ref v 3))
(eq? 'e (stencil-vector-ref v 4))
(eq? 'j (stencil-vector-ref v 9))))
;; remove all
(eqv? 0 (stencil-vector-length (stencil-vector-update alphabet-sv #b10101010101010101010 0)))
(error? (stencil-vector-truncate! 1 0))
(error? (stencil-vector-truncate! (stencil-vector 0) 1))
(error? (stencil-vector-truncate! (stencil-vector 7) 15))
(error? (stencil-vector-truncate! (stencil-vector 6) 7))
(let ([sv (stencil-vector 7 1 2 3)])
(stencil-vector-truncate! sv 3)
(and (stencil-vector? sv)
(eqv? (stencil-vector-mask sv) 3)
(eqv? (stencil-vector-ref sv 0) 1)
(eqv? (stencil-vector-ref sv 1) 2)))
(let ([sv (stencil-vector 7 1 2 3)])
(stencil-vector-truncate! sv 6)
(and (stencil-vector? sv)
(eqv? (stencil-vector-mask sv) 6)
(eqv? (stencil-vector-ref sv 0) 1)
(eqv? (stencil-vector-ref sv 1) 2)))
;; check fasl:
(let ([s (stencil-vector 42 'a 'b 'c)])
(define-values (o get) (open-bytevector-output-port))
(fasl-write s o)
(equal? s (fasl-read (open-bytevector-input-port (get)))))
;; try to check GC interaction
(let loop ([n 100000]
[v1 (stencil-vector 7 'a 'b 'c)]
[v2 (stencil-vector 28 "a" "b" "c")]
[v3 (stencil-vector 15 (vector 'x) (vector 'y) (vector 'z) (vector 'w))])
(or (fx= n 0)
(and
(fx= (stencil-vector-mask v1) 7)
(eqv? (stencil-vector-ref v1 1) 'b)
(fx= (stencil-vector-mask v2) 28)
(equal? (stencil-vector-ref v2 0) "a")
(equal? (stencil-vector-ref v2 1) "b")
(equal? (stencil-vector-ref v2 2) "c")
(fx= (stencil-vector-mask v3) 15)
(equal? (stencil-vector-ref v3 0) '#(x))
(equal? (stencil-vector-ref v3 1) '#(y))
(equal? (stencil-vector-ref v3 2) '#(z))
(equal? (stencil-vector-ref v3 3) '#(w))
(loop (fx- n 1)
(stencil-vector-update
(stencil-vector-update v1 3 1 'a)
0 2 'b)
(stencil-vector-update v2 12 12 (string #\a) (string #\b))
(stencil-vector-update
(stencil-vector-update v3 6 16 (vector 'extra))
16 6 (vector 'y) (vector 'z))))))
)

5
mats/hash.ms
View File

@ -3828,6 +3828,11 @@
(exact? hc)
(>= hc 0)
(= (string-ci-hash "HelLo") hc)))
(let ([hc (equal-hash (stencil-vector 3 'one 'two))])
(and (integer? hc)
(exact? hc)
(>= hc 0)
(= (equal-hash (stencil-vector 3 'one 'two)) hc)))
(let f ([ls (oblist)])
(define okay?
(lambda (x)

8
mats/misc.ms
View File

@ -2511,6 +2511,7 @@
"apple" 'banana
(make-vfasl-demo 10 "11")
(vector 1 'two "three")
(stencil-vector 30 'one 2.0 0+3i "four")
(box 88)
"" '#() '#vu8() (make-fxvector 0)
(string->immutable-string "") (vector->immutable-vector '#())
@ -2523,7 +2524,8 @@
(positive? (string-length a)))
(and (vector? a)
(positive? (vector-length a)))
(box? a))
(box? a)
(stencil-vector? a))
(equal? a b))
(and (vfasl-demo? a)
(vfasl-demo? b)
@ -2531,7 +2533,9 @@
(vfasl-demo-x b))
(equal? (vfasl-demo-y a)
(vfasl-demo-y b)))
(printf "~s ~s\n" a b)))
(begin
(printf "~s ~s\n" a b)
#f)))
vfasl-content
v))
(compile-to-file (list `(define (vfasled) ',vfasl-content)

524
mats/patch-compile-0-t-f-f
View File

File diff suppressed because it is too large Load Diff

1
mats/primvars.ms
View File

@ -473,6 +473,7 @@
[(uptr) 0 -1 'a (+ *max-uptr 1) #f]
[(uptr/iptr) -1 'q (+ *max-uptr 1) (- *min-iptr 1) #f]
[(vector) '#(a) "a" #f]
[(stencil-vector) (stencil-vector 7 1 2 3) "a" #f]
[(who-condition) (make-who-condition 'me) (make-message-condition "hello") 'the-who])
(meta-cond
[(memq 'pthreads feature*)

41
mats/root-experr-compile-0-f-f-f
View File

@ -1725,6 +1725,19 @@ primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #<input
5_3.mo:Expected error in mat div0-and-mod0: "mod0: undefined for 0".
5_3.mo:Expected error in mat div0-and-mod0: "mod0: undefined for a".
5_3.mo:Expected error in mat div0-and-mod0: "mod0: undefined for (a)".
5_3.mo:Expected error in mat popcount: "fxpopcount32: #f is not a non-negative fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount32: 1.0 is not a non-negative fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount32: 1267650600228229401496703205376 is not a non-negative fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount32: -1 is not a non-negative fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount32: #f is not a 32-bit fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount32: 1.0 is not a 32-bit fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount32: 1267650600228229401496703205376 is not a 32-bit fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount32: -1 is not a 32-bit fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount16: #f is not a 16-bit fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount16: 1.0 is not a 16-bit fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount16: 1267650600228229401496703205376 is not a 16-bit fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount16: 1048576 is not a 16-bit fixnum".
5_3.mo:Expected error in mat popcount: "fxpopcount16: -1 is not a 16-bit fixnum".
5_4.mo:Expected error in mat char=?/char-ci=?: "incorrect argument count in call (char=?)".
5_4.mo:Expected error in mat char=?/char-ci=?: "char=?: a is not a character".
5_4.mo:Expected error in mat char=?/char-ci=?: "char=?: a is not a character".
@ -4068,6 +4081,34 @@ cp0.mo:Expected error in mat expand/optimize-output: "expand/optimize-output: #<
5_6.mo:Expected error in mat vector-cas!: "vector-cas!: 1267650600228229401496703205376 is not a valid index for #(4 5 3)".
5_6.mo:Expected error in mat vector-cas!: "vector-cas!: -1 is not a valid index for #(4 5 3)".
5_6.mo:Expected error in mat vector-cas!: "vector-cas!: 5 is not a valid index for #(4 5 3)".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector: invalid mask x".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector: invalid mask -1".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector: mask 0 does not match given number of items 1".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector: mask 3 does not match given number of items 1".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector: mask 3 does not match given number of items 1".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector: invalid mask 288230376151711744".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-length: 3 is not a stencil vector".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-mask: 3 is not a vector".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-ref: 3 is not a stencil vector".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-ref: invalid index 0".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-ref: invalid index 2".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-ref: invalid index -1".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-ref: invalid index 1267650600228229401496703205376".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-ref: invalid index 1.0".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-set!: invalid index 0".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-set!: invalid index 2".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-set!: invalid index -1".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-set!: invalid index 1267650600228229401496703205376".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-set!: invalid index 1.0".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-update: 1 is not a stencil vector".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-update: stencil already has bits in 2".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-update: stencil does not have all bits in 1".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-update: addition mask 1 does not match given number of items 0".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-update: addition mask 1 does not match given number of items 2".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-truncate!: 1 is not a stencil vector".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector-truncate!: new mask 1 is larger than old mask 0".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector: mask 7 does not match given number of items 0".
5_6.mo:Expected error in mat stencil-vector: "stencil-vector: mask 6 does not match given number of items 0".
5_7.mo:Expected error in mat string->symbol: "string->symbol: 3 is not a string".
5_7.mo:Expected error in mat string->symbol: "string->symbol: a is not a string".
5_7.mo:Expected error in mat gensym: "gensym: #(a b c) is not a string".

32
s/5_1.ss
View File

@ -136,6 +136,17 @@
k
(let ([k (e? (vector-ref x i) (vector-ref y i) k)])
(and k (f (fx+ i 1) k)))))))))]
[(stencil-vector? x)
(and (stencil-vector? y)
(fx= (stencil-vector-mask x) (stencil-vector-mask y))
(let ([n (stencil-vector-length x)])
(if (union-find ht x y)
0
(let f ([i 0] [k (fx- k 1)])
(if (fx= i n)
k
(let ([k (e? (stencil-vector-ref x i) (stencil-vector-ref y i) k)])
(and k (f (fx+ i 1) k))))))))]
[(string? x) (and (string? y) (string=? x y) k)]
[(flonum? x) (and (flonum? y) ($fleqv? x y) k)]
[($inexactnum? x)
@ -195,6 +206,15 @@
k
(let ([k (e? (vector-ref x i) (vector-ref y i) k)])
(and k (f (fx+ i 1) k))))))))]
[(stencil-vector? x)
(and (stencil-vector? y)
(fx= (stencil-vector-mask x) (stencil-vector-mask y))
(let ([n (stencil-vector-length x)])
(let f ([i 0] [k k])
(if (fx= i n)
k
(let ([k (e? (stencil-vector-ref x i) (stencil-vector-ref y i) k)])
(and k (f (fx+ i 1) k)))))))]
[(string? x) (and (string? y) (string=? x y) k)]
[(flonum? x) (and (flonum? y) ($fleqv? x y) k)]
[($inexactnum? x)
@ -252,6 +272,18 @@
(vector-ref y i)
(fx- k 1))])
(and k (f (fx+ i 1) k))))))))]
[(stencil-vector? x)
(and (stencil-vector? y)
(fx= (stencil-vector-mask x) (stencil-vector-mask y))
(let ([n (stencil-vector-length x)])
(let f ([i 0] [k k])
(if (or (fx= i n) (fx<= k 0))
k
(let ([k (precheck?
(stencil-vector-ref x i)
(stencil-vector-ref y i)
(fx- k 1))])
(and k (f (fx+ i 1) k)))))))]
[(string? x) (and (string? y) (string=? x y) k)]
[(flonum? x) (and (flonum? y) ($fleqv? x y) k)]
[($inexactnum? x)

178
s/5_6.ss
View File

@ -424,3 +424,181 @@
($list-length ls2 who)
(dolmerge! elt< ls1 ls2 (list '())))))
)
;; compiled with generate-interrupt-trap #f and optimize-level 3 so
;; that stencil updates won't be interrupted by a GC while a newly
;; allocated stencil is filled in
(eval-when (compile)
(generate-interrupt-trap #f)
(optimize-level 3))
(let ()
;; Call with non-zero n
(define (stencil-vector-copy! to-v to-i from-v from-i n)
(cond
[(fx= n 1)
($stencil-vector-set! to-v to-i (stencil-vector-ref from-v from-i))]
[else
($stencil-vector-set! to-v to-i (stencil-vector-ref from-v from-i))
($stencil-vector-set! to-v (fx+ to-i 1) (stencil-vector-ref from-v (fx+ from-i 1)))
(let ([n (fx- n 2)])
(unless (fx= n 0)
(stencil-vector-copy! to-v (fx+ to-i 2) from-v (fx+ from-i 2) n)))]))
(define (do-stencil-vector-update v mask remove-bits add-bits vals)
(let* ([new-n (fxpopcount (fxior (fx- mask remove-bits) add-bits))]
[new-v ($make-stencil-vector new-n (fxior (fx- mask remove-bits) add-bits))])
;; `new-v` is not initialized, so don't let a GC happen until we're done filling it in
(let loop ([to-i 0] [from-i 0] [mask mask] [remove-bits remove-bits] [add-bits add-bits] [vals vals])
(unless (fx= to-i new-n)
(let* ([pre-remove-mask (fx- (fxxor remove-bits (fxand remove-bits (fx- remove-bits 1))) 1)]
[pre-add-mask (fx- (fxxor add-bits (fxand add-bits (fx- add-bits 1))) 1)]
[keep-mask (fxand mask pre-remove-mask pre-add-mask)]
[kept-n (cond
[(fx= 0 keep-mask) 0]
[else
(let ([keep-n (fxpopcount keep-mask)])
(stencil-vector-copy! new-v to-i v from-i keep-n)
keep-n)])])
(let ([to-i (fx+ to-i kept-n)]
[from-i (fx+ from-i kept-n)]
[mask (fx- mask keep-mask)])
(cond
[($fxu< pre-add-mask pre-remove-mask)
;; an add bit happens before a remove bit
($stencil-vector-set! new-v to-i (car vals))
(loop (fx+ to-i 1) from-i mask remove-bits (fx- add-bits (fx+ pre-add-mask 1)) (cdr vals))]
[else
;; a remove bit happens before an add bit (or we're at the end)
(let ([remove-bit (fx+ pre-remove-mask 1)])
(loop to-i (fx+ from-i 1) (fx- mask remove-bit) (fx- remove-bits remove-bit) add-bits vals))])))))
new-v))
(define (stencil-vector-replace-one v bit val)
(let* ([mask (stencil-vector-mask v)]
[n (fxpopcount mask)]
[new-v ($make-stencil-vector n mask)])
;; `new-v` is not initialized, so don't let a GC happen until we're done filling it in
(stencil-vector-copy! new-v 0 v 0 n)
(let ([i (fxpopcount (fxand mask (fx- bit 1)))])
($stencil-vector-set! new-v i val))
new-v))
(define (stencil-vector-replace-two v bits val1 val2)
(let* ([mask (stencil-vector-mask v)]
[n (fxpopcount mask)]
[new-v ($make-stencil-vector n mask)])
;; `new-v` is not initialized, so don't let a GC happen until we're done filling it in
(stencil-vector-copy! new-v 0 v 0 n)
(let ([i1 (fxpopcount (fxand mask (fx- (fxxor bits (fxand bits (fx- bits 1))) 1)))])
($stencil-vector-set! new-v i1 val1)
(let ([i2 (fxpopcount (fxand mask (fx- (fxand bits (fx- bits 1)) 1)))])
($stencil-vector-set! new-v i2 val2)))
new-v))
(set-who! stencil-vector-mask-width (lambda () (constant stencil-vector-mask-bits)))
(set-who! stencil-vector-length
(lambda (v)
(unless (stencil-vector? v)
($oops who "~s is not a stencil vector" v))
(fxpopcount (stencil-vector-mask v))))
(set-who! stencil-vector-ref
(lambda (v i)
(unless (stencil-vector? v)
($oops who "~s is not a stencil vector" v))
(unless (and (fixnum? i)
(fx< -1 i (fxpopcount (stencil-vector-mask v))))
($oops who "invalid index ~s" i))
(#3%stencil-vector-ref v i)))
(set-who! stencil-vector-set!
(lambda (v i val)
(unless (stencil-vector? v)
($oops who "~s is not a stencil vector" v))
(unless (and (fixnum? i)
(fx< -1 i (fxpopcount (stencil-vector-mask v))))
($oops who "invalid index ~s" i))
(#3%stencil-vector-set! v i val)))
(set-who! stencil-vector
(lambda (mask . vals)
(unless (and (fixnum? mask)
(fx< -1 mask (fxsll 1 (constant stencil-vector-mask-bits))))
($oops who "invalid mask ~s" mask))
(let ([n (fxpopcount mask)])
(unless (fx= (length vals) n)
($oops who "mask ~s does not match given number of items ~s" mask (length vals)))
(let ([v ($make-stencil-vector n mask)])
;; `new-v` is not initialized, so don't let a GC happen until we're done filling it in
(let loop ([i 0] [vals vals])
(unless (fx= i n)
($stencil-vector-set! v i (car vals))
(loop (fx+ i 1) (cdr vals))))
v))))
(set-who! stencil-vector-update
(lambda (v remove-bits add-bits . vals)
(unless (stencil-vector? v)
($oops who "~s is not a stencil vector" v))
(let ([mask (stencil-vector-mask v)])
(unless (and (fixnum? remove-bits)
(fx< -1 remove-bits (fxsll 1 (constant stencil-vector-mask-bits))))
($oops who "invalid removal mask ~s" remove-bits))
(unless (fx= remove-bits (fxand remove-bits mask))
($oops who "stencil does not have all bits in ~s" remove-bits))
(unless (and (fixnum? add-bits)
(fx< -1 add-bits (fxsll 1 (constant stencil-vector-mask-bits))))
($oops who "invalid addition mask ~s" add-bits))
(unless (fx= 0 (fxand add-bits (fx- mask remove-bits)))
($oops who "stencil already has bits in ~s" add-bits))
(unless (fx= (fxpopcount add-bits) (length vals))
($oops who "addition mask ~s does not match given number of items ~s" add-bits (length vals)))
(do-stencil-vector-update v mask remove-bits add-bits vals))))
(set-who! stencil-vector-truncate!
(lambda (v new-mask)
(unless (stencil-vector? v)
($oops who "~s is not a stencil vector" v))
(unless (and (fixnum? new-mask)
(fx< -1 new-mask (fxsll 1 (constant stencil-vector-mask-bits))))
($oops who "invalid mask ~s" new-mask))
(let ([old-mask (stencil-vector-mask v)])
(unless (fx<= (fxpopcount new-mask) (fxpopcount old-mask))
($oops who "new mask ~s is larger than old mask ~s" new-mask old-mask))
(stencil-vector-truncate! v new-mask))))
;; unsafe variant, which assumes that the arguments are consistent;
;; recognize the case where all slots are replaced
(set-who! $stencil-vector-update
(case-lambda
[(v remove-bits add-bits x)
(let ([mask (stencil-vector-mask v)])
(cond
[(fx= 0 (fx- mask remove-bits))
;; not using any data from `v`
(stencil-vector add-bits x)]
[(fx= add-bits remove-bits)
;; updating one element of `v`:
(stencil-vector-replace-one v add-bits x)]
[else
(do-stencil-vector-update v mask remove-bits add-bits (list x))]))]
[(v remove-bits add-bits x y)
(let ([mask (stencil-vector-mask v)])
(cond
[(fx= 0 (fx- mask remove-bits))
;; not using any data from `v`
(stencil-vector add-bits x y)]
[(fx= add-bits remove-bits)
;; updating two elements of `v`:
(stencil-vector-replace-two v add-bits x y)]
[else
(do-stencil-vector-update v mask remove-bits add-bits (list x y))]))]
[(v remove-bits add-bits x y z)
(let ([mask (stencil-vector-mask v)])
(if (fx= 0 (fx- mask remove-bits))
(stencil-vector add-bits x y z)
(do-stencil-vector-update v mask remove-bits add-bits (list x y z))))]
[(v remove-bits add-bits . vals)
(do-stencil-vector-update v (stencil-vector-mask v) remove-bits add-bits vals)])))

1
s/a6fb.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor)

1
s/a6le.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor)

1
s/a6nb.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor)

1
s/a6nt.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor windows)

1
s/a6ob.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor)

1
s/a6osx.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor)

1
s/a6s2.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor)

1
s/arm32le.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #f)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #f)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor)

33
s/cmacros.ss
View File

@ -328,7 +328,7 @@
[(_ foo e1 e2) e1] ...
[(_ bar e1 e2) e2]))))])))
(define-constant scheme-version #x09050309)
(define-constant scheme-version #x0905030A)
(define-syntax define-machine-types
(lambda (x)
@ -455,9 +455,11 @@
(define-constant fasl-type-immutable-bytevector 39)
(define-constant fasl-type-immutable-box 40)
(define-constant fasl-type-begin 41)
(define-constant fasl-type-phantom 42)
(define-constant fasl-type-uninterned-symbol 43)
(define-constant fasl-type-stencil-vector 41)
(define-constant fasl-type-begin 42)
(define-constant fasl-type-phantom 43)
(define-constant fasl-type-uninterned-symbol 44)
(define-constant fasl-fld-ptr 0)
(define-constant fasl-fld-u8 1)
@ -695,7 +697,8 @@
(define-constant countof-guardian 23)
(define-constant countof-oblist 24)
(define-constant countof-ephemeron 25)
(define-constant countof-types 26)
(define-constant countof-stencil-vector 26)
(define-constant countof-types 27)
;;; type-fixnum is assumed to be all zeros by at least by vector, fxvector,
;;; and bytevector index checks
@ -745,7 +748,6 @@
(define-constant type-string #b010)
(define-constant type-fxvector #b011)
; #b100 occupied by vectors on 32-bit machines, unused on 64-bit machines
; #b101 occupied by type-immutable-bytevector
(define-constant type-other-number #b0110) ; bit 3 reset for numbers
(define-constant type-bignum #b00110) ; bit 4 reset for bignums
(define-constant type-positive-bignum #b000110)
@ -755,11 +757,12 @@
(define-constant type-exactnum #b01010110)
(define-constant type-box #b0001110) ; bit 3 set for non-numbers
(define-constant type-immutable-box #b10001110) ; low 7 bits match `type-box`
(define-constant type-port #b00011110)
(define-constant type-stencil-vector #b011110) ; remianing bits for stencil; type looks like immediate
; #b00101110 (forward_marker) must not be used
(define-constant type-code #b00111110)
(define-constant type-port #b11001110)
(define-constant type-thread #b01001110)
(define-constant type-tlc #b01011110)
(define-constant type-tlc #b10111110)
(define-constant type-rtd-counts #b01101110)
(define-constant type-phantom #b01111110)
(define-constant type-record #b111)
@ -917,6 +920,7 @@
(define-constant mask-rtd-counts (constant byte-constant-mask))
(define-constant mask-record #b111)
(define-constant mask-port #xFF)
(define-constant mask-stencil-vector #x3F)
(define-constant mask-binary-port
(fxlogor (fxsll (constant port-flag-binary) (constant port-flags-offset))
(constant mask-port)))
@ -991,6 +995,10 @@
(define-constant bytevector-length-factor (expt 2 (constant bytevector-length-offset)))
(define-constant char-factor (expt 2 (constant char-data-offset)))
(define-constant stencil-vector-mask-offset (integer-length (constant mask-stencil-vector)))
(define-constant stencil-vector-mask-bits (fx- (constant ptr-bits)
(constant stencil-vector-mask-offset)))
;;; record-datatype must be defined before we include layout.ss
;;; (maybe should move into that file??)
;;; We allow Scheme inputs for both signed and unsigned integers to range from
@ -1271,6 +1279,10 @@
([iptr type]
[octet data 0]))])
(define-primitive-structure-disps stencil-vector type-typed-object
([iptr type]
[ptr data 0]))
; WARNING: implementation of real-part and imag-part assumes that
; flonums are subobjects of inexactnums.
(define-primitive-structure-disps flonum type-flonum
@ -2652,6 +2664,9 @@
(bitwise-bit-set? #f 2 #f #t)
(fxbit-set? #f 2 #f #t)
(fxcopy-bit #f 2 #t #t)
(fxpopcount #f 1 #t #t)
(fxpopcount16 #f 1 #t #t)
(fxpopcount32 #f 1 #t #t)
(reverse #f 1 #f #t)
(andmap1 #f 2 #f #t)
(ormap1 #f 2 #f #t)
@ -2687,6 +2702,8 @@
(safe-put-u8 #f 2 #f #t)
(safe-put-char #f 2 #f #t)
(safe-unread-char #f 2 #f #t)
(stencil-vector-mask #f 1 #t #t)
(stencil-vector-tag #f 1 #t #t)
(dorest0 #f 0 #f #t)
(dorest1 #f 0 #f #t)
(dorest2 #f 0 #f #t)

6
s/cp0.ss
View File

@ -2171,7 +2171,8 @@
(define-inline-constant-parameter (most-negative-fixnum least-fixnum) (constant most-negative-fixnum))
(define-inline-constant-parameter (most-positive-fixnum greatest-fixnum) (constant most-positive-fixnum))
(define-inline-constant-parameter (fixnum-width) (constant fixnum-bits))
(define-inline-constant-parameter (virtual-register-count) (constant virtual-register-count)))
(define-inline-constant-parameter (virtual-register-count) (constant virtual-register-count))
(define-inline-constant-parameter (stencil-vector-mask-width) (constant stencil-vector-mask-bits)))
(define-inline 2 directory-separator?
[(c) (visit-and-maybe-extract* char? ([dc c])
@ -2755,6 +2756,9 @@
(fold (fxlogbit? tfixnum? tfixnum?) boolean? #2%logbit?)
(fold (fxlogbit0 u<fxwidth-1? tfixnum?) tfixnum? #2%logbit0)
(fold (fxlogbit1 u<fxwidth-1? tfixnum?) tfixnum? #2%logbit1)
(fold (fxpopcount tfixnum?) tfixnum? #2%fxpopcount)
(fold (fxpopcount32 tfixnum?) tfixnum? #2%fxpopcount32)
(fold (fxpopcount16 tfixnum?) tfixnum? #2%fxpopcount16)
(fold (fxarithmetic-shift tfixnum? s<fxwidth?) tfixnum? #2%bitwise-arithmetic-shift handle-shift)
(fold (fxarithmetic-shift-left tfixnum? u<fxwidth?) tfixnum? #2%bitwise-arithmetic-shift-left handle-shift)

197
s/cpnanopass.ss
View File

@ -4480,7 +4480,103 @@
(%inline - ,e1
,(build-fx*
(build-fx/ src sexpr e1 e2)
e2 #f)))]))))
e2 #f)))]))
(let ()
(define-syntax build-fx
(lambda (x)
(syntax-case x ()
[(_ op a1 a2)
#`(%inline op
#,(if (number? (syntax->datum #'a1))
#`(immediate a1)
#`,a1)
#,(if (number? (syntax->datum #'a2))
#`(immediate a2)
#`,a2))])))
(define (build-popcount16 e)
(constant-case popcount-instruction
[(#t) (build-fix (%inline popcount ,e))] ; no unfix needed, since not specialized to 16-bit
[else
(let ([x (make-tmp 'x 'uptr)]
[x2 (make-tmp 'x2 'uptr)]
[x3 (make-tmp 'x3 'uptr)]
[x4 (make-tmp 'x4 'uptr)])
`(let ([,x ,(build-unfix e)])
(let ([,x2 ,(build-fx - x (build-fx logand (build-fx srl x 1) #x5555))])
(let ([,x3 ,(build-fx + (build-fx logand x2 #x3333) (build-fx logand (build-fx srl x2 2) #x3333))])
(let ([,x4 ,(build-fx logand (build-fx + x3 (build-fx srl x3 4)) #x0f0f)])
,(build-fix (build-fx logand (build-fx + x4 (build-fx srl x4 8)) #x1f)))))))]))
(define (build-popcount32 e)
(constant-case popcount-instruction
[(#t) (build-fix (%inline popcount ,e))] ; no unfix needed, since not specialized to 32-bit
[else
(let ([x (make-tmp 'x 'uptr)]
[x2 (make-tmp 'x2 'uptr)]
[x3 (make-tmp 'x3 'uptr)]
[x4 (make-tmp 'x4 'uptr)])
`(let ([,x ,(build-unfix e)])
(let ([,x2 ,(build-fx - x (build-fx logand (build-fx srl x 1) #x55555555))])
(let ([,x3 ,(build-fx + (build-fx logand x2 #x33333333) (build-fx logand (build-fx srl x2 2) #x33333333))])
(let ([,x4 ,(build-fx logand (build-fx + x3 (build-fx srl x3 4)) #x0f0f0f0f)])
,(build-fix (build-fx logand (build-fx srl (build-fx * x4 #x01010101) 24) #x3f)))))))]))
(define (build-popcount e)
(constant-case popcount-instruction
[(#t) (build-fix (%inline popcount ,e))] ; no unfix needed
[else
(constant-case ptr-bits
[(32) (build-popcount32 e)]
[(64)
(let ([x (make-tmp 'x 'uptr)]
[x2 (make-tmp 'x2 'uptr)]
[x3 (make-tmp 'x3 'uptr)]
[x4 (make-tmp 'x4 'uptr)]
[x5 (make-tmp 'x5 'uptr)])
`(let ([,x ,e]) ; no unfix needed
(let ([,x2 ,(build-fx - x (build-fx logand (build-fx srl x 1) #x5555555555555555))])
(let ([,x3 ,(build-fx + (build-fx logand x2 #x3333333333333333) (build-fx logand (build-fx srl x2 2) #x3333333333333333))])
(let ([,x4 ,(build-fx logand (build-fx + x3 (build-fx srl x3 4)) #x0f0f0f0f0f0f0f0f)])
(let ([,x5 ,(build-fx logand (build-fx + x4 (build-fx srl x4 8)) #x00ff00ff00ff00ff)])
,(build-fix (build-fx logand (build-fx srl (build-fx * x5 #x0101010101010101) 56) #x7f))))))))])]))
(define-inline 3 fxpopcount
[(e)
(bind #f (e)
(build-popcount e))])
(define-inline 2 fxpopcount
[(e)
(bind #t (e)
`(if ,(build-and
(%type-check mask-fixnum type-fixnum ,e)
(%inline >= ,e (immediate ,0)))
,(build-popcount e)
,(build-libcall #t #f sexpr fxpopcount e)))])
(define-inline 3 fxpopcount32
[(e)
(bind #f (e)
(build-popcount32 e))])
(define-inline 2 fxpopcount32
[(e)
(bind #t (e)
`(if ,(constant-case ptr-bits
[(32)
(build-and (%type-check mask-fixnum type-fixnum ,e)
(%inline >= ,e (immediate ,0)))]
[(64)
(build-and (%type-check mask-fixnum type-fixnum ,e)
(%inline u< ,e (immediate ,(fix #x100000000))))])
,(build-popcount32 e)
,(build-libcall #t #f sexpr fxpopcount32 e)))])
(define-inline 3 fxpopcount16
[(e)
(bind #f (e)
(build-popcount16 e))])
(define-inline 2 fxpopcount16
[(e)
(bind #f (e)
`(if ,(build-and
(%type-check mask-fixnum type-fixnum ,e)
(%inline u< ,e (immediate ,(fix #x10000))))
,(build-popcount16 e)
,(build-libcall #t #f sexpr fxpopcount16 e)))]))))
(let ()
(define do-fxsll
(lambda (e1 e2)
@ -4989,6 +5085,7 @@
(typed-object-pred vector? mask-vector type-vector)
(typed-object-pred mutable-vector? mask-mutable-vector type-mutable-vector)
(typed-object-pred immutable-vector? mask-mutable-vector type-immutable-vector)
(typed-object-pred stencil-vector? mask-stencil-vector type-stencil-vector)
(typed-object-pred thread? mask-thread type-thread))
(define-inline 3 $bigpositive?
[(e) (%type-check mask-signed-bignum type-positive-bignum
@ -5377,7 +5474,8 @@
(def-len fxvector-length fxvector-type-disp fxvector-length-offset)
(def-len string-length string-type-disp string-length-offset)
(def-len bytevector-length bytevector-type-disp bytevector-length-offset)
(def-len $bignum-length bignum-type-disp bignum-length-offset))
(def-len $bignum-length bignum-type-disp bignum-length-offset)
(def-len stencil-vector-mask stencil-vector-type-disp stencil-vector-mask-offset))
(let ()
(define-syntax def-len
(syntax-rules ()
@ -5394,7 +5492,8 @@
(def-len vector-length mask-vector type-vector vector-type-disp vector-length-offset)
(def-len fxvector-length mask-fxvector type-fxvector fxvector-type-disp fxvector-length-offset)
(def-len string-length mask-string type-string string-type-disp string-length-offset)
(def-len bytevector-length mask-bytevector type-bytevector bytevector-type-disp bytevector-length-offset))
(def-len bytevector-length mask-bytevector type-bytevector bytevector-type-disp bytevector-length-offset)
(def-len stencil-vector-mask mask-stencil-vector type-stencil-vector stencil-vector-type-disp stencil-vector-mask-offset))
; TODO: consider adding integer?, integer-valued?, rational?, rational-valued?,
; real?, and real-valued?
(let ()
@ -8399,6 +8498,35 @@
`(if ,(build-vector-set!-check e-v e-i e-new)
,(go e-v e-i e-new)
,(build-libcall #t src sexpr vector-set-fixnum! e-v e-i e-new)))])))
(let ()
(define (go e-v e-i)
(nanopass-case (L7 Expr) e-i
[(quote ,d)
(guard (target-fixnum? d))
(%mref ,e-v ,(+ (fix d) (constant stencil-vector-data-disp)))]
[else (%mref ,e-v ,e-i ,(constant stencil-vector-data-disp))]))
(define-inline 3 stencil-vector-ref
[(e-v e-i) (go e-v e-i)]))
(let ()
(define (go e-v e-i e-new)
(nanopass-case (L7 Expr) e-i
[(quote ,d)
(guard (target-fixnum? d))
(build-dirty-store e-v (+ (fix d) (constant stencil-vector-data-disp)) e-new)]
[else (build-dirty-store e-v e-i (constant stencil-vector-data-disp) e-new)]))
(define-inline 3 stencil-vector-set!
[(e-v e-i e-new) (go e-v e-i e-new)]))
(let ()
(define (go e-v e-i e-new)
`(set!
,(nanopass-case (L7 Expr) e-i
[(quote ,d)
(guard (target-fixnum? d))
(%mref ,e-v ,(+ (fix d) (constant stencil-vector-data-disp)))]
[else (%mref ,e-v ,e-i ,(constant stencil-vector-data-disp))])
,e-new))
(define-inline 3 $stencil-vector-set!
[(e-v e-i e-new) (go e-v e-i e-new)]))
(let ()
(define (go e-v e-i)
(nanopass-case (L7 Expr) e-i
@ -9182,6 +9310,69 @@
(constant? fixnum? e-fill)
(do-make-vector e-length e-fill))]))))
(let ()
(meta-assert (= (constant log2-ptr-bytes) (constant fixnum-offset)))
(let ()
(define build-stencil-vector-type
(lambda (e-mask) ; e-mask is used only once
(%inline logor
(immediate ,(constant type-stencil-vector))
,(%inline sll ,e-mask (immediate ,(fx- (constant stencil-vector-mask-offset)
(constant fixnum-offset)))))))
(define do-stencil-vector
(lambda (e-mask e-val*)
(list-bind #f (e-val*)
(bind #f (e-mask)
(let ([t-vec (make-tmp 'tvec)])
`(let ([,t-vec ,(%constant-alloc type-typed-object
(fx+ (constant header-size-stencil-vector)
(fx* (length e-val*) (constant ptr-bytes))))])
,(let loop ([e-val* e-val*] [i 0])
(if (null? e-val*)
`(seq
(set! ,(%mref ,t-vec ,(constant stencil-vector-type-disp))
,(build-stencil-vector-type e-mask))
,t-vec)
`(seq
(set! ,(%mref ,t-vec ,(fx+ i (constant stencil-vector-data-disp))) ,(car e-val*))
,(loop (cdr e-val*) (fx+ i (constant ptr-bytes))))))))))))
(define do-make-stencil-vector
(lambda (e-length e-mask)
(bind #t (e-length)
(bind #f (e-mask)
(let ([t-vec (make-tmp 'tvec)])
`(let ([,t-vec (alloc ,(make-info-alloc (constant type-typed-object) #f #f)
,(%inline logand
,(%inline + ,e-length
(immediate ,(fx+ (constant header-size-stencil-vector)
(fx- (constant byte-alignment) 1))))
(immediate ,(- (constant byte-alignment)))))])
,(%seq
(set! ,(%mref ,t-vec ,(constant stencil-vector-type-disp))
,(build-stencil-vector-type e-mask))
;; Content not filled! This function is meant to be called by
;; `$stencil-vector-update`, which has GC disabled between
;; allocation and filling in the data
,t-vec)))))))
(define-inline 3 stencil-vector
[(e-mask . e-val*)
(do-stencil-vector e-mask e-val*)])
(define-inline 2 $make-stencil-vector
[(e-length e-mask) (do-make-stencil-vector e-length e-mask)])
(define-inline 3 $make-stencil-vector
[(e-length e-mask) (do-make-stencil-vector e-length e-mask)])
(define-inline 3 stencil-vector-update
[(e-vec e-sub-mask e-add-mask . e-val*)
`(call ,(make-info-call src sexpr #f #f #f) #f
,(lookup-primref 3 '$stencil-vector-update)
,e-vec ,e-sub-mask ,e-add-mask ,e-val* ...)])
(define-inline 3 stencil-vector-truncate!
[(e-vec e-mask)
(bind #f (e-vec e-mask)
`(seq
(set! ,(%mref ,e-vec ,(constant stencil-vector-type-disp))
,(build-stencil-vector-type e-mask))
,(%constant svoid)))])))
(let ()
(meta-assert (= (constant log2-ptr-bytes) (constant fixnum-offset)))
(define-inline 3 $make-eqhash-vector

20
s/fasl.ss
View File

@ -65,6 +65,14 @@
(bld (vector-ref x i) t a? d)
(bldvec (fx+ i 1)))))))
(define bld-stencil-vector
(lambda (x t a? d)
(let ([len (stencil-vector-length x)])
(let bldvec ([i 0])
(unless (fx= i len)
(bld (stencil-vector-ref x i) t a? d)
(bldvec (fx+ i 1)))))))
(define bld-record
(lambda (x t a? d)
(unless (eq? x #!base-rtd)
@ -163,6 +171,7 @@
(cond
[(pair? x) (bld-graph x t a? d #t bld-pair)]
[(vector? x) (bld-graph x t a? d #t bld-vector)]
[(stencil-vector? x) (bld-graph x t a? d #t bld-stencil-vector)]
[(or (symbol? x) (string? x)) (bld-graph x t a? d #t bld-simple)]
[(and (annotation? x) (not a?))
(bld (annotation-stripped x) t a? d)]
@ -309,6 +318,16 @@
(put-u8 p x)
(wrf-bytevector-loop (fx+ i 1))))))))
(define wrf-stencil-vector
(lambda (x p t a?)
(put-u8 p (constant fasl-type-stencil-vector))
(put-uptr p (stencil-vector-mask x))
(let ([n (stencil-vector-length x)])
(let wrf-stencil-vector-loop ([i 0])
(unless (fx= i n)
(wrf (stencil-vector-ref x i) p t a?)
(wrf-stencil-vector-loop (fx+ i 1)))))))
; Written as: fasl-tag rtd field ...
(module (wrf-record really-wrf-record)
(define maybe-remake-rtd
@ -571,6 +590,7 @@
[(hashtable? x) ($oops 'fasl-write "invalid fasl object ~s" x)]
[($record? x) (wrf-graph x p t a? wrf-record)]
[(vector? x) (wrf-graph x p t a? wrf-vector)]
[(stencil-vector? x) (wrf-graph x p t a? wrf-stencil-vector)]
[(char? x) (wrf-char x p)]
[(box? x) (wrf-graph x p t a? wrf-box)]
[(large-integer? x) (wrf-graph x p t a? wrf-large-integer)]

1
s/i3fb.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor)

1
s/i3le.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor)

1
s/i3nb.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor)

1
s/i3nt.def
View File

@ -46,6 +46,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor windows)

1
s/i3ob.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor)

1
s/i3osx.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor)

1
s/i3qnx.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 2)
(features iconv expeditor)

1
s/i3s2.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor)

64
s/inspect.ss
View File

@ -457,7 +457,7 @@
(case ((object) 'type)
[(pair) (ref-list n)]
[(continuation procedure vector fxvector bytevector string record
ftype-struct ftype-union ftype-array ftype-bits)
ftype-struct ftype-union ftype-array ftype-bits stencil-vector)
(ref n)]
[else (invalid-movement)]))))
@ -496,6 +496,7 @@
[(vector) vector-dispatch-table]
[(fxvector) fxvector-dispatch-table]
[(bytevector) bytevector-dispatch-table]
[(stencil-vector) stencil-vector-dispatch-table]
[(record) record-dispatch-table]
[(string) string-dispatch-table]
[(box) box-dispatch-table]
@ -1024,6 +1025,31 @@
))
(define stencil-vector-dispatch-table
(make-dispatch-table
[("length" . "l")
"display stencil vector length"
(() (show " ~d elements" ((object) 'length)))]
[("mask" . "m")
"display stencil vector mask"
(() (show " #x~x" ((object) 'mask)))]
[("ref" . "r")
"inspect [nth] element"
(() (ref 0))
((n) (ref n))]
[("show" . "s")
"show [n] elements"
(() (display-refs ((object) 'length)))
((n)
(range-check n ((object) 'length))
(display-refs n))]
))
(define ftype-struct-dispatch-table
(make-dispatch-table
["fields"
@ -1895,6 +1921,19 @@
[write (p) (write x p)]
[print (p) (pretty-print x p)]))
(define make-stencil-vector-object
(make-object-maker stencil-vector (x)
[value () x]
[length () (stencil-vector-length x)]
[mask () (stencil-vector-mask x)]
[ref (i)
(unless (and (fixnum? i) (fx< -1 i (stencil-vector-length x)))
($oops 'stencil-vector-object "invalid index ~s" i))
(make-object (stencil-vector-ref x i))]
[size (g) (compute-size x g)]
[write (p) (write x p)]
[print (p) (pretty-print x p)]))
(define make-phantom-object
(make-object-maker phantom-bytevector (x)
[value () x]
@ -2383,6 +2422,7 @@
[(vector? x) (make-vector-object x)]
[(fxvector? x) (make-fxvector-object x)]
[(bytevector? x) (make-bytevector-object x)]
[(stencil-vector? x) (make-stencil-vector-object x)]
; ftype-pointer? test must come before record? test
[($ftype-pointer? x) (make-ftype-pointer-object x)]
[(or (record? x) (and (eq? (subset-mode) 'system) ($record? x)))
@ -2587,6 +2627,12 @@
((fx= i n) size)))]
[(fxvector? x) (align (fx+ (constant header-size-fxvector) (fx* (fxvector-length x) (constant ptr-bytes))))]
[(bytevector? x) (align (fx+ (constant header-size-bytevector) (bytevector-length x)))]
[(stencil-vector? x)
(let ([n (stencil-vector-length x)])
(do ([i 0 (fx+ i 1)]
[size (align (fx+ (constant header-size-stencil-vector) (fx* (stencil-vector-length x) (constant ptr-bytes))))
(fx+ size (compute-size (stencil-vector-ref x i)))])
((fx= i n) size)))]
[($record? x)
(let ([rtd ($record-type-descriptor x)])
(fold-left (lambda (size fld)
@ -2736,7 +2782,7 @@
(vector-set! count-vec i (cons 1 size))))]
...))))])))
(define-counters (type-names type-counts incr!)
pair symbol vector fxvector bytevector string box flonum bignum ratnum exactnum
pair symbol vector fxvector bytevector stencil-vector string box flonum bignum ratnum exactnum
inexactnum continuation stack procedure code-object reloc-table port thread tlc
rtd-counts phantom)
(define compute-composition!
@ -2766,6 +2812,14 @@
(vector-for-each compute-composition! x)]
[(fxvector? x) (incr! fxvector (align (fx+ (constant header-size-fxvector) (fx* (fxvector-length x) (constant ptr-bytes)))))]
[(bytevector? x) (incr! bytevector (align (fx+ (constant header-size-bytevector) (bytevector-length x))))]
[(stencil-vector? x)
(let ([len (stencil-vector-length x)])
(incr! stencil-vector (align (fx+ (constant header-size-stencil-vector) (fx* len (constant ptr-bytes)))))
(let loop ([i len])
(unless (fx= i 0)
(let ([i (fx- i 1)])
(compute-composition! (stencil-vector-ref x i))
(loop i)))))]
[($record? x)
(let ([rtd ($record-type-descriptor x)])
(let ([p (eq-hashtable-ref rtd-ht rtd #f)] [size (align (rtd-size rtd))])
@ -2918,6 +2972,12 @@
(if (fx= i n)
next-proc
(construct-proc (vector-ref x i) (f (fx+ i 1))))))]
[(stencil-vector? x)
(let ([n (stencil-vector-length x)])
(let f ([i 0])
(if (fx= i n)
next-proc
(construct-proc (stencil-vector-ref x i) (f (fx+ i 1))))))]
[($record? x)
(let ([rtd ($record-type-descriptor x)])
(construct-proc rtd

9
s/library.ss
View File

@ -298,6 +298,9 @@
(define index-oops
(lambda (who x i)
($oops who "~s is not a valid index for ~s" i x)))
(define stencil-vector-oops
(lambda (who x)
($oops who "~s is not a vector" x)))
(define-library-entry (char->integer x) (char-oops 'char->integer x))
@ -389,6 +392,9 @@
(define-library-entry (bytevector-length v)
(bytevector-oops 'bytevector-length v))
(define-library-entry (stencil-vector-mask v)
(stencil-vector-oops 'stencil-vector-mask v))
(define-library-entry (char=? x y) (char-oops 'char=? (if (char? x) y x)))
(define-library-entry (char<? x y) (char-oops 'char<? (if (char? x) y x)))
(define-library-entry (char>? x y) (char-oops 'char>? (if (char? x) y x)))
@ -512,6 +518,9 @@
(define-library-entry (fxxor x y) (fxnonfixnum2 'fxxor x y))
(define-library-entry (fxand x y) (fxnonfixnum2 'fxand x y))
(define-library-entry (fxnot x) (fxnonfixnum1 'fxnot x))
(define-library-entry (fxpopcount x) ($oops 'fxpopcount32 "~s is not a non-negative fixnum" x))
(define-library-entry (fxpopcount32 x) ($oops 'fxpopcount32 "~s is not a 32-bit fixnum" x))
(define-library-entry (fxpopcount16 x) ($oops 'fxpopcount16 "~s is not a 16-bit fixnum" x))
(define-library-entry (fxsll x y)
(cond

12
s/mathprims.ss
View File

@ -581,6 +581,18 @@
[(1) (#3%fxlogbit1 k n)]
[else ($oops who "invalid bit value ~s" b)])))
(set! fxpopcount
(lambda (x)
(#2%fxpopcount x)))
(set! fxpopcount32
(lambda (x)
(#2%fxpopcount32 x)))
(set! fxpopcount16
(lambda (x)
(#2%fxpopcount16 x)))
(set! fxeven?
(lambda (x)
(#2%fxeven? x)))

10
s/mkheader.ss
View File

@ -248,6 +248,7 @@
(deftotypep "Sfxvectorp" ($ mask-fxvector) ($ type-fxvector))
(deftotypep "Sbytevectorp" ($ mask-bytevector) ($ type-bytevector))
(deftotypep "Sstringp" ($ mask-string) ($ type-string))
(deftotypep "Sstencil_vectorp" ($ mask-stencil-vector) ($ type-stencil-vector))
(deftotypep "Sbignump" ($ mask-bignum) ($ type-bignum))
(deftotypep "Sboxp" ($ mask-box) ($ type-box))
(deftotypep "Sinexactnump" ($ mask-inexactnum) ($ type-inexactnum))
@ -297,6 +298,12 @@
(defref Sunbox box ref)
(def "Sstencil_vector_length(x)"
(format "Spopcount(((uptr)~a)>>~d)"
(access "x" vector type)
($ stencil-vector-mask-offset)))
(defref Sstencil_vector_ref vector data)
(export "iptr" "Sinteger_value" "(ptr)")
(def "Sunsigned_value(x)" "(uptr)Sinteger_value(x)")
(export (constant typedef-i32) "Sinteger32_value" "(ptr)")
@ -846,6 +853,9 @@
(defref BYTEVECTOR_TYPE bytevector type)
(defref BVIT bytevector data)
(defref STENVECTTYPE stencil-vector type)
(definit INITSTENVECTIT stencil-vector data)
(defref INEXACTNUM_TYPE inexactnum type)
(defref INEXACTNUM_REAL_PART inexactnum real)
(defref INEXACTNUM_IMAG_PART inexactnum imag)

10
s/newhash.ss
View File

@ -1064,6 +1064,16 @@ Documentation notes:
(let ([i/2 (fxsrl (fx+ i 1) 1)])
(let-values ([(hc i^) (f (vector-ref x j) hc i/2)])
(g (fx+ j 1) hc (fx+ (fx- i i/2) i^))))))))]
[(stencil-vector? x)
(let ([n (stencil-vector-length x)] [hc (update hc 517766377)])
(if (fx= n 0)
(values hc i)
(let g ([j 0] [hc hc] [i i])
(if (or (fx= j n) (fx= i 0))
(values hc i)
(let ([i/2 (fxsrl (fx+ i 1) 1)])
(let-values ([(hc i^) (f (stencil-vector-ref x j) hc i/2)])
(g (fx+ j 1) hc (fx+ (fx- i i/2) i^))))))))]
[(null? x) (values (update hc 496904691) i)]
[(box? x) (f (unbox x) (update hc 410225874) i)]
[(symbol? x) (values (update hc (symbol-hash x)) i)]

1
s/np-languages.ss
View File

@ -573,6 +573,7 @@
(declare-primitive logor value #t)
(declare-primitive logxor value #t)
(declare-primitive lognot value #t)
(declare-primitive popcount value #t) ; x86_64 only
(declare-primitive move value #t)
(declare-primitive * value #t)
(declare-primitive */ovfl value #f)

1
s/ppc32le.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #f)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #f)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor)

15
s/primdata.ss
View File

@ -1366,6 +1366,9 @@
(fxmodulo [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op cp02])
(fxnonnegative? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs])
(fxnonpositive? [sig [(fixnum) -> (boolean)]] [flags pure cp02 safeongoodargs])
(fxpopcount [sig [(sub-fixnum) -> (fixnum)]] [flags arith-op cp02 safeongoodargs])
(fxpopcount32 [sig [(sub-fixnum) -> (fixnum)]] [flags arith-op cp02 safeongoodargs])
(fxpopcount16 [sig [(sub-fixnum) -> (fixnum)]] [flags arith-op cp02 safeongoodargs])
(fxquotient [sig [(fixnum fixnum ...) -> (fixnum)]] [flags arith-op partial-folder])
(fxremainder [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op cp02])
(fxsll [sig [(fixnum sub-ufixnum) -> (fixnum)]] [flags arith-op cp02])
@ -1668,6 +1671,15 @@
(standard-output-port [sig [() (sub-symbol) (sub-symbol maybe-transcoder) -> (output-port)]] [flags true])
(standard-error-port [sig [() (sub-symbol) (sub-symbol maybe-transcoder) -> (output-port)]] [flags true])
(statistics [sig [() -> (sstats)]] [flags unrestricted alloc])
(stencil-vector [sig [(uptr ptr ...) -> (stencil-vector)]] [flags true])
(stencil-vector? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard])
(stencil-vector-length [sig [(stencil-vector) -> (uptr)]] [flags true])
(stencil-vector-mask [sig [(stencil-vector) -> (uptr)]] [flags true])
(stencil-vector-mask-width [sig [() -> (fixnum)]] [flags pure unrestricted true cp02])
(stencil-vector-ref [sig [(stencil-vector uptr) -> (ptr)]] [flags pure])
(stencil-vector-set! [sig [(stencil-vector uptr ptr) -> (void)]] [flags true])
(stencil-vector-truncate! [sig [(stencil-vector uptr) -> (void)]] [flags true])
(stencil-vector-update [sig [(stencil-vector uptr uptr ptr ...) -> (stencil-vector)]] [flags true])
(string->multibyte [feature windows] [sig [(sub-uint string) -> (bytevector)]] [flags true discard])
(string->number [sig [(string) (string sub-ufixnum) -> (maybe-number)]] [flags discard]) ; radix not restricted to 2, 4, 8, 16
(string-append-immutable [sig [(string ...) -> (string)]] [flags alloc safeongoodargs ieee r5rs])
@ -2156,6 +2168,7 @@
($make-rnrs-libraries [flags single-valued])
($make-source-oops [flags single-valued])
($make-src-condition [flags single-valued])
($make-stencil-vector [sig [(uptr uptr) -> (stencil-vector)]] [flags single-valued])
($make-textual-input/output-port [sig [(string port-handler string string) (string port-handler string string ptr) -> (textual-input/output-port)]] [flags alloc])
($make-textual-input-port [sig [(string port-handler string) (string port-handler string ptr) -> (textual-input-port)]] [flags alloc])
($make-textual-output-port [sig [(string port-handler string) (string port-handler string ptr) -> (textual-output-port)]] [flags alloc])
@ -2265,6 +2278,8 @@
($src-condition-src [flags single-valued])
($src-condition-start [flags single-valued])
($sremprop [flags single-valued])
($stencil-vector-set! [sig [(stencil-vector uptr ptr) -> (void)]] [flags true])
($stencil-vector-update [sig [(stencil-vector uptr uptr ptr ...) -> (stencil-vector)]] [flags true])
($string-char-foldcase [flags single-valued])
($string-ref-check? [sig [(ptr ptr) -> (boolean)]] [flags unrestricted pure])
($string-set!-check? [sig [(ptr ptr) -> (boolean)]] [flags unrestricted discard])

15
s/prims.ss
View File

@ -1195,6 +1195,19 @@
(lambda (s)
(#3%immutable-fxvector? s)))
(define stencil-vector-mask
(lambda (v)
(#2%stencil-vector-mask v)))
(define-who $make-stencil-vector
(lambda (len mask)
($oops who "should only be used as inlined with GC disabled")))
; not safe; assumes `val` is older than `v`
(define $stencil-vector-set!
(lambda (v i val)
($stencil-vector-set! v i val)))
; not safe
(define $record-ref
(lambda (v i)
@ -1280,6 +1293,8 @@
(define fxvector? (lambda (x) (fxvector? x)))
(define stencil-vector? (lambda (x) (stencil-vector? x)))
(define procedure? (lambda (x) (procedure? x)))
(define flonum? (lambda (x) (flonum? x)))

29
s/print.ss
View File

@ -101,6 +101,7 @@
($object-in-heap? x)
(or (pair? x)
(vector? x)
(stencil-vector? x)
(box? x)
(and ($record? x) (not (eq? x #!base-rtd)))
(fxvector? x)
@ -160,6 +161,14 @@
(unless (or (fx> i m) (limit? veclen))
(find-dupls (vector-ref x i) lev len)
(f (fx+ i 1) (decr veclen))))))]
[(stencil-vector? x)
(unless (fx= (stencil-vector-length x) 0)
(let ([m (fx- (stencil-vector-length x) 1)]
[lev (decr lev)])
(let f ([i 0] [veclen len])
(unless (or (fx> i m) (limit? veclen))
(find-dupls (stencil-vector-ref x i) lev len)
(f (fx+ i 1) (decr veclen))))))]
[(and ($record? x) (not (eq? x #!base-rtd)))
(when (print-record)
((record-writer ($record-type-descriptor x)) x (bit-sink)
@ -197,6 +206,7 @@
(cond
[(pair? x) (cyclic-structure? x curlev lstlen cyclic-pair?)]
[(vector? x) (cyclic-structure? x curlev 0 cyclic-vector?)]
[(stencil-vector? x) (cyclic-structure? x curlev 0 cyclic-stencil-vector?)]
[(and ($record? x) (not (eq? x #!base-rtd)))
(and (print-record)
(cyclic-structure? x curlev lstlen
@ -238,6 +248,14 @@
(or (cyclic? (vector-ref x i) curlev 0)
(across (fx- i 1))))))))
(define cyclic-stencil-vector?
(lambda (x curlev lstlen)
(let ([n (stencil-vector-length x)] [curlev (fx+ curlev 1)])
(let across ([i (fx- (if len (fxmin len n) n) 1)])
(and (fx>= i 0)
(or (cyclic? (stencil-vector-ref x i) curlev 0)
(across (fx- i 1))))))))
(define cyclic-box?
(lambda (x curlev lstlen)
(cyclic? (unbox x) (fx+ curlev 1) 0)))
@ -278,6 +296,12 @@
(and (fx>= i 0)
(or (down (vector-ref x i) (fx- xlev 1))
(across (fx- i 1))))))]
[(stencil-vector? x)
(let ([n (stencil-vector-length x)])
(let across ([i (fx- (if len (fxmin len n) n) 1)])
(and (fx>= i 0)
(or (down (stencil-vector-ref x i) (fx- xlev 1))
(across (fx- i 1))))))]
[(and ($record? x) (not (eq? x #!base-rtd)))
(and (print-record)
(call/cc
@ -294,7 +318,7 @@
(and (if ($immediate? x)
(eq? x black-hole)
(and ($object-in-heap? x)
(or (pair? x) (vector? x) (box? x) (and ($record? x) (not (eq? x #!base-rtd))))))
(or (pair? x) (vector? x) (stencil-vector? x) (box? x) (and ($record? x) (not (eq? x #!base-rtd))))))
(or (print-graph)
(and (not (and lev len))
(maybe-cyclic? x lev len)
@ -651,6 +675,9 @@ floating point returns with (1 0 -1 ...).
[(pair?) (wrpair x r lev len d? env p)]
[(string?) (if d? (display-string x p) (wrstring x p))]
[(vector?) (wrvector vector-length vector-ref #f x r lev len d? env p)]
[(stencil-vector?) (wrvector stencil-vector-length stencil-vector-ref
(string-append "stencil[" (number->string (stencil-vector-mask x) 16) "]")
x r lev len d? env p)]
[(fxvector?) (wrvector fxvector-length fxvector-ref "vfx" x r lev len d? env p)]
[(bytevector?) (wrvector bytevector-length bytevector-u8-ref "vu8" x r lev len d? env p)]
[(flonum?) (wrflonum #f x r d? p)]

1
s/ta6fb.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor pthreads)

1
s/ta6le.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor pthreads)

1
s/ta6nb.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor pthreads)

1
s/ta6nt.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor pthreads windows)

1
s/ta6ob.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor pthreads)

1
s/ta6osx.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor pthreads)

1
s/ta6s2.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 3)
(features iconv expeditor pthreads)

1
s/ti3fb.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor pthreads)

1
s/ti3le.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor pthreads)

1
s/ti3nb.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor pthreads)

1
s/ti3nt.def
View File

@ -46,6 +46,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor pthreads windows)

1
s/ti3ob.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor pthreads)

1
s/ti3osx.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor pthreads)

1
s/ti3s2.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #t)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #t)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor pthreads)

1
s/tppc32le.def
View File

@ -45,6 +45,7 @@
(define-constant unaligned-floats #f)
(define-constant unaligned-integers #t)
(define-constant integer-divide-instruction #f)
(define-constant popcount-instruction #f)
(define-constant software-floating-point #f)
(define-constant segment-table-levels 1)
(features iconv expeditor pthreads)

45
s/x86_64.ss
View File

@ -699,6 +699,9 @@
(go info op t t y)
`(set! ,(make-live-info) ,z ,t)))])
(define-instruction value popcount
[(op (z ur) (x ur mem)) `(set! ,(make-live-info) ,z (asm ,info ,asm-popcount ,x))])
(define-instruction value move
[(op (z mem) (x ur imm32))
`(set! ,(make-live-info) ,z ,x)]
@ -997,7 +1000,7 @@
asm-logtest asm-fl-relop asm-relop asm-push asm-indirect-jump asm-literal-jump
asm-direct-jump asm-return-address asm-jump asm-conditional-jump asm-data-label asm-rp-header
asm-lea1 asm-lea2 asm-indirect-call asm-condition-code
asm-fl-cvt asm-fl-store asm-fl-load asm-flt asm-trunc asm-div
asm-fl-cvt asm-fl-store asm-fl-load asm-flt asm-trunc asm-div asm-popcount
asm-exchange asm-pause asm-locked-incr asm-locked-decr asm-locked-cmpxchg
asm-flop-2 asm-flsqrt asm-c-simple-call
asm-save-flrv asm-restore-flrv asm-return asm-c-return asm-size
@ -1138,6 +1141,8 @@
(define-op locked-cmpxchg (*) locked-cmpxchg-op)
(define-op popcount (*) popcount-op)
; also do inc-reg dec-reg
; the following are forms of the call instruction and push the return address
@ -1145,7 +1150,7 @@
#;(define-op bsrl branch-always-op long #b11101000) ; pc-relative
(define-op bsr bsr-op)
; the following are forms of the jmp instruction
; the followin<g are forms of the jmp instruction
(define-op jmp jump-op #b100) ; reg/mem indirect
(define-op bra bra-op)
@ -1577,6 +1582,18 @@
[3 op-code]
[0 (fxlogand (ax-ea-reg-code reg) 7)]))))))
(define popcount-op
(lambda (op size dest-reg src-ea code*)
(begin
(emit-code (op dest-reg src-ea code*)
(build byte #xF3)
(ax-ea-rex (if (eq? size 'quad) 1 0) src-ea dest-reg size)
(build byte #x0F)
(build byte #xB8)
(ax-ea-modrm-reg src-ea dest-reg)
(ax-ea-sib src-ea)
(ax-ea-addr-disp src-ea)))))
(define-syntax emit-code
(lambda (x)
(define build-maybe-cons*
@ -1590,6 +1607,25 @@
(build-maybe-cons* #'(chunk ...)
#'(aop-cons* `(asm ,op ,opnd ...) ?code*))])))
(define-syntax emit-literal-code
(lambda (x)
(syntax-case x ()
[(_ (op opnd ... ?code*) hexlike ...)
#`(emit-code (op opnd ... ?code*) (encode-hex-like hexlike) ...)])))
(define-syntax encode-hex-like
(lambda (x)
(syntax-case x ()
[(k hexlike)
(let ([n (let ([v (syntax->datum #'hexlike)])
(if (number? v)
;; parsed as decimal; reparse as hex
(string->number (number->string v) 16)
;; parsed as ymbol
(string->number (symbol->string v) 16)))])
(with-syntax ([n (datum->syntax #'k n)])
#`(build byte n)))])))
(define-who ax-size-code
(lambda (x)
(case x
@ -1947,6 +1983,11 @@
(Trivit (dest src0 src1)
(emit mulsi src1 src0 dest code*))))
(define asm-popcount
(lambda (code* dest src)
(Trivit (src)
(emit popcount (cons 'reg dest) src code*))))
(define-who asm-addop
(lambda (op)
(case op