mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

RTL compiler supports static bitvectors

Browse source 
* libguile/arrays.c (scm_from_contiguous_typed_array):
* libguile/bytevectors.c (scm_uniform_array_to_bytevector): For
  bitvectors, round up the length to 32-bit units, as they are stored
  internally.  Otherwise I think this probably does the wrong thing for
  the last word on big-endian systems.
* libguile/bitvectors.c (BITVECTOR_LENGTH, BITVECTOR_BITS):
  (scm_c_make_bitvector): Reorder the length and pointer words to match
  the layout of bytevectors.

* module/language/cps/primitives.scm (*branching-primcall-arities*):
* module/system/vm/assembler.scm (br-if-bitvector):
* module/system/vm/disassembler.scm (code-annotation): Add bitvector
  test support.

* module/system/vm/assembler.scm (<uniform-vector-backing-store>): Add
  an element-size field.
  (intern-constant): Adapt make-uniform-vector-backing-store call.  Use
  uniform-array->bytevector, as the old compiler did.
  (link-data): Add bitvector cases.
This commit is contained in:
Andy Wingo 2013-11-03 21:45:34 +01:00
parent 9ae9debbd3
commit d65514a2de
6 changed files with 38 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/arrays.c
View file

@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005,
* 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
* 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@ -242,8 +242,9 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
}
else if (sz < 8)
{
/* byte_len ?= ceil (rlen * sz / 8) */
if (byte_len != (rlen * sz + 7) / 8)
/* Elements of sub-byte size (bitvectors) are addressed in 32-bit
units. */
if (byte_len != ((rlen * sz + 31) / 32) * 4)
SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
}
else

8
libguile/bitvectors.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@ -39,8 +39,8 @@
*/
#define IS_BITVECTOR(obj) SCM_TYP16_PREDICATE(scm_tc7_bitvector,(obj))
#define BITVECTOR_BITS(obj) ((scm_t_uint32 *)SCM_CELL_WORD_1(obj))
#define BITVECTOR_LENGTH(obj) ((size_t)SCM_CELL_WORD_2(obj))
#define BITVECTOR_LENGTH(obj) ((size_t)SCM_CELL_WORD_1(obj))
#define BITVECTOR_BITS(obj) ((scm_t_uint32 *)SCM_CELL_WORD_2(obj))
int
scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
@ -110,7 +110,7 @@ scm_c_make_bitvector (size_t len, SCM fill)
bits = scm_gc_malloc_pointerless (sizeof (scm_t_uint32) * word_len,
"bitvector");
res = scm_double_cell (scm_tc7_bitvector, (scm_t_bits)bits, len, 0);
res = scm_double_cell (scm_tc7_bitvector, len, (scm_t_bits)bits, 0);
if (!SCM_UNBNDP (fill))
scm_bitvector_fill_x (res, fill);

5
libguile/bytevectors.c
View file

@ -649,8 +649,9 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
if (sz >= 8 && ((sz % 8) == 0))
byte_len = len * (sz / 8);
else if (sz < 8)
/* byte_len = ceil (len * sz / 8) */
byte_len = (len * sz + 7) / 8;
/* Elements of sub-byte size (bitvectors) are addressed in 32-bit
units. */
byte_len = ((len * sz + 31) / 32) * 4;
else
/* an internal guile error, really */
SCM_MISC_ERROR ("uniform elements larger than 8 bits must fill whole bytes", SCM_EOL);

1
module/language/cps/primitives.scm
View file

@ -75,6 +75,7 @@
(vector? . (1 . 1))
(symbol? . (1 . 1))
(variable? . (1 . 1))
(bitvector? . (1 . 1))
(bytevector? . (1 . 1))
(char? . (1 . 1))
(eq? . (1 . 2))

34
module/system/vm/assembler.scm
View file

@ -531,9 +531,10 @@ list of lists. This procedure can be called many times before calling
(code static-procedure-code))
(define-record-type <uniform-vector-backing-store>
(make-uniform-vector-backing-store bytes)
(make-uniform-vector-backing-store bytes element-size)
uniform-vector-backing-store?
(bytes uniform-vector-backing-store-bytes))
(bytes uniform-vector-backing-store-bytes)
(element-size uniform-vector-backing-store-element-size))
(define-record-type <cache-cell>
(make-cache-cell scope key)
@ -603,7 +604,13 @@ table, its existing label is used directly."
((uniform-vector-backing-store? obj) '())
((simple-uniform-vector? obj)
`((static-patch! ,label 2
,(recur (make-uniform-vector-backing-store obj)))))
,(recur (make-uniform-vector-backing-store
(uniform-array->bytevector obj)
(if (bitvector? obj)
;; Bitvectors are addressed in
;; 32-bit units.
4
(uniform-vector-element-size obj)))))))
(else
(error "don't know how to intern" obj))))
(cond
@ -709,7 +716,7 @@ returned instead."
;(define-tc7-macro-assembler br-if-weak-set 85)
;(define-tc7-macro-assembler br-if-weak-table 87)
;(define-tc7-macro-assembler br-if-array 93)
;(define-tc7-macro-assembler br-if-bitvector 95)
(define-tc7-macro-assembler br-if-bitvector 95)
;(define-tc7-macro-assembler br-if-port 125)
;(define-tc7-macro-assembler br-if-smob 127)
@ -901,6 +908,7 @@ should be .data or .rodata), and return the resulting linker object.
(define tc7-ro-string (+ 21 #x200))
(define tc7-rtl-program 69)
(define tc7-bytevector 77)
(define tc7-bitvector 95)
(let ((word-size (asm-word-size asm))
(endianness (asm-endianness asm)))
@ -1023,18 +1031,26 @@ should be .data or .rodata), and return the resulting linker object.
(write-immediate asm buf pos #f))
((simple-uniform-vector? obj)
(let ((tag (logior tc7-bytevector
(ash (uniform-vector-element-type-code obj) 7))))
(let ((tag (if (bitvector? obj)
tc7-bitvector
(let ((type-code (uniform-vector-element-type-code obj)))
(logior tc7-bytevector (ash type-code 7))))))
(case word-size
((4)
(bytevector-u32-set! buf pos tag endianness)
(bytevector-u32-set! buf (+ pos 4) (bytevector-length obj)
(bytevector-u32-set! buf (+ pos 4)
(if (bitvector? obj)
(bitvector-length obj)
(bytevector-length obj))
endianness) ; length
(bytevector-u32-set! buf (+ pos 8) 0 endianness) ; pointer
(write-immediate asm buf (+ pos 12) #f)) ; owner
((8)
(bytevector-u64-set! buf pos tag endianness)
(bytevector-u64-set! buf (+ pos 8) (bytevector-length obj)
(bytevector-u64-set! buf (+ pos 8)
(if (bitvector? obj)
(bitvector-length obj)
(bytevector-length obj))
endianness) ; length
(bytevector-u64-set! buf (+ pos 16) 0 endianness) ; pointer
(write-immediate asm buf (+ pos 24) #f)) ; owner
@ -1043,7 +1059,7 @@ should be .data or .rodata), and return the resulting linker object.
((uniform-vector-backing-store? obj)
(let ((bv (uniform-vector-backing-store-bytes obj)))
(bytevector-copy! bv 0 buf pos (bytevector-length bv))
(unless (or (= 1 (uniform-vector-element-size bv))
(unless (or (= 1 (uniform-vector-backing-store-element-size obj))
(eq? endianness (native-endianness)))
;; Need to swap units of element-size bytes
(error "FIXME: Implement byte order swap"))))

1
module/system/vm/disassembler.scm
View file

@ -225,6 +225,7 @@ address of that offset."
((13) "vector?")
((15) "string?")
((77) "bytevector?")
((95) "bitvector?")
(else (number->string tc7)))))
(if invert? (string-append "not " tag) tag))
(vector-ref labels (- (+ offset target) start))))