mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Add low-level support for unboxed 64-bit unsigned ints
* libguile/frames.c (enum stack_item_representation) * libguile/frames.c (scm_to_stack_item_representation): (scm_frame_local_ref, scm_frame_local_set_x): Support 'u64 slots. * libguile/frames.h (union scm_vm_stack_element): Add as_u64 member. * libguile/vm-engine.c (SP_REF_U64, SP_SET_U64): New helpers. (scm->u64, u64->scm): New instructions. * module/language/cps/cse.scm (compute-equivalent-subexpressions): Scalar replacement for u64->scm and scm->u64. * module/language/cps/effects-analysis.scm (scm->u64, u64->scm): Add cases. * module/language/cps/slot-allocation.scm (compute-var-representations): (allocate-slots): Represent the result of scm->u64 as a "u64" slot. * module/language/cps/types.scm (&u64): New type. (scm->u64, u64->scm): Add support for these ops. * module/system/vm/assembler.scm (write-arities): * module/system/vm/debug.scm (arity-definitions): Support u64 representations.
This commit is contained in:
Andy Wingo
parent
58153e3a08
commit
dfbe869e24
9 changed files with 73 additions and 10 deletions
|
|
@ -241,7 +241,8 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0, 0,
|
|||
enum stack_item_representation
|
||||
{
|
||||
STACK_ITEM_SCM = 0,
|
||||
STACK_ITEM_F64 = 1
|
||||
STACK_ITEM_F64 = 1,
|
||||
STACK_ITEM_U64 = 2
|
||||
};
|
||||
|
||||
static enum stack_item_representation
|
||||
|
|
@ -251,6 +252,8 @@ scm_to_stack_item_representation (SCM x, const char *subr, int pos)
|
|||
return STACK_ITEM_SCM;
|
||||
if (scm_is_eq (x, scm_from_latin1_symbol ("f64")))
|
||||
return STACK_ITEM_F64;
|
||||
if (scm_is_eq (x, scm_from_latin1_symbol ("u64")))
|
||||
return STACK_ITEM_U64;
|
||||
|
||||
scm_wrong_type_arg (subr, pos, x);
|
||||
return 0; /* Not reached. */
|
||||
|
|
@ -281,6 +284,8 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 3, 0, 0,
|
|||
return item->as_scm;
|
||||
case STACK_ITEM_F64:
|
||||
return scm_from_double (item->as_f64);
|
||||
case STACK_ITEM_U64:
|
||||
return scm_from_uint64 (item->as_u64);
|
||||
default:
|
||||
abort();
|
||||
}
|
||||
|
|
@ -318,6 +323,9 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 4, 0, 0,
|
|||
case STACK_ITEM_F64:
|
||||
item->as_f64 = scm_to_double (val);
|
||||
break;
|
||||
case STACK_ITEM_U64:
|
||||
item->as_u64 = scm_to_uint64 (val);
|
||||
break;
|
||||
default:
|
||||
abort();
|
||||
}
|
||||
|
|
|
|||
|
|
@ -92,6 +92,7 @@ union scm_vm_stack_element
|
|||
scm_t_uint32 *as_ip;
|
||||
SCM as_scm;
|
||||
double as_f64;
|
||||
scm_t_uint64 as_u64;
|
||||
|
||||
/* For GC purposes. */
|
||||
void *as_ptr;
|
||||
|
|
|
|||
|
|
@ -254,6 +254,9 @@
|
|||
#define SP_REF_F64(i) (sp[i].as_f64)
|
||||
#define SP_SET_F64(i,o) (sp[i].as_f64 = o)
|
||||
|
||||
#define SP_REF_U64(i) (sp[i].as_u64)
|
||||
#define SP_SET_U64(i,o) (sp[i].as_u64 = o)
|
||||
|
||||
#define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
|
||||
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
|
||||
#define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED))
|
||||
|
|
@ -3312,8 +3315,32 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
|
|||
NEXT (0);
|
||||
}
|
||||
|
||||
VM_DEFINE_OP (143, unused_143, NULL, NOP)
|
||||
VM_DEFINE_OP (144, unused_144, NULL, NOP)
|
||||
/* scm->u64 dst:12 src:12
|
||||
*
|
||||
* Unpack an unsigned 64-bit integer from SRC and place it in DST.
|
||||
*/
|
||||
VM_DEFINE_OP (143, scm_to_u64, "scm->u64", OP1 (X8_S12_S12) | OP_DST)
|
||||
{
|
||||
scm_t_uint16 dst, src;
|
||||
UNPACK_12_12 (op, dst, src);
|
||||
SYNC_IP ();
|
||||
SP_SET_U64 (dst, scm_to_uint64 (SP_REF (src)));
|
||||
NEXT (1);
|
||||
}
|
||||
|
||||
/* u64->scm dst:12 src:12
|
||||
*
|
||||
* Pack an unsigned 64-bit integer into a SCM value.
|
||||
*/
|
||||
VM_DEFINE_OP (144, u64_to_scm, "u64->scm", OP1 (X8_S12_S12) | OP_DST)
|
||||
{
|
||||
scm_t_uint16 dst, src;
|
||||
UNPACK_12_12 (op, dst, src);
|
||||
SYNC_IP ();
|
||||
SP_SET (dst, scm_from_uint64 (SP_REF_U64 (src)));
|
||||
NEXT (1);
|
||||
}
|
||||
|
||||
VM_DEFINE_OP (145, unused_145, NULL, NOP)
|
||||
VM_DEFINE_OP (146, unused_146, NULL, NOP)
|
||||
VM_DEFINE_OP (147, unused_147, NULL, NOP)
|
||||
|
|
|
|||
|
|
@ -307,6 +307,14 @@ false. It could be that both true and false proofs are available."
|
|||
(match defs
|
||||
((scm)
|
||||
(add-def! `(primcall scm->f64 ,scm) f64))))
|
||||
(('primcall 'scm->u64 scm)
|
||||
(match defs
|
||||
((u64)
|
||||
(add-def! `(primcall u64->scm ,u64) scm))))
|
||||
(('primcall 'u64->scm u64)
|
||||
(match defs
|
||||
((scm)
|
||||
(add-def! `(primcall scm->u64 ,scm) u64))))
|
||||
(_ #t))))
|
||||
|
||||
(define (visit-label label equiv-labels var-substs)
|
||||
|
|
|
|||
|
|
@ -351,10 +351,12 @@ is or might be a read or a write to the same location as A."
|
|||
((string->number _) (&read-object &string) &type-check)
|
||||
((string-length s) &type-check))
|
||||
|
||||
;; Unboxed floats.
|
||||
;; Unboxed floats and integers.
|
||||
(define-primitive-effects
|
||||
((scm->f64 _) &type-check)
|
||||
((f64->scm _)))
|
||||
((f64->scm _))
|
||||
((scm->u64 _) &type-check)
|
||||
((u64->scm _)))
|
||||
|
||||
;; Bytevectors.
|
||||
(define-primitive-effects
|
||||
|
|
|
|||
|
|
@ -53,8 +53,8 @@
|
|||
;;
|
||||
(slots allocation-slots)
|
||||
|
||||
;; A map of VAR to representation. A representation is either 'scm or
|
||||
;; 'f64.
|
||||
;; A map of VAR to representation. A representation is 'scm, 'f64, or
|
||||
;; 'u64.
|
||||
;;
|
||||
(representations allocation-representations)
|
||||
|
||||
|
|
@ -793,6 +793,8 @@ are comparable with eqv?. A tmp slot may be used."
|
|||
(($ $primcall (or 'scm->f64 'bv-f32-ref 'bv-f64-ref
|
||||
'fadd 'fsub 'fmul 'fdiv))
|
||||
(intmap-add representations var 'f64))
|
||||
(($ $primcall (or 'scm->u64))
|
||||
(intmap-add representations var 'u64))
|
||||
(_
|
||||
(intmap-add representations var 'scm))))
|
||||
(vars
|
||||
|
|
@ -874,7 +876,7 @@ are comparable with eqv?. A tmp slot may be used."
|
|||
(#f slot-map)
|
||||
(slot
|
||||
(let ((desc (match (intmap-ref representations var)
|
||||
('f64 slot-desc-live-raw)
|
||||
((or 'u64 'f64) slot-desc-live-raw)
|
||||
('scm slot-desc-live-scm))))
|
||||
(logior slot-map (ash desc (* 2 slot)))))))
|
||||
live-vars 0))
|
||||
|
|
|
|||
|
|
@ -119,6 +119,7 @@
|
|||
|
||||
;; Untagged types.
|
||||
&f64
|
||||
&u64
|
||||
|
||||
infer-types
|
||||
lookup-pre-type
|
||||
|
|
@ -169,7 +170,8 @@
|
|||
&array
|
||||
&hash-table
|
||||
|
||||
&f64)
|
||||
&f64
|
||||
&u64)
|
||||
|
||||
(define-syntax &no-type (identifier-syntax 0))
|
||||
|
||||
|
|
@ -678,7 +680,7 @@ minimum, and maximum."
|
|||
|
||||
|
||||
;;;
|
||||
;;; Unboxed double-precision floating-point numbers.
|
||||
;;; Unboxed numbers.
|
||||
;;;
|
||||
|
||||
(define-type-checker (scm->f64 scm)
|
||||
|
|
@ -692,6 +694,17 @@ minimum, and maximum."
|
|||
(define-type-inferrer (f64->scm f64 result)
|
||||
(define! result &flonum (&min f64) (&max f64)))
|
||||
|
||||
(define-type-checker (scm->u64 scm)
|
||||
(check-type scm &exact-integer 0 +inf.0))
|
||||
(define-type-inferrer (scm->u64 scm result)
|
||||
(restrict! scm &exact-integer 0 +inf.0)
|
||||
(define! result &u64 (&min scm) (&max scm)))
|
||||
|
||||
(define-type-checker (u64->scm u64)
|
||||
#t)
|
||||
(define-type-inferrer (u64->scm u64 result)
|
||||
(define! result &exact-integer (&min u64) (&max u64)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1895,6 +1895,7 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
|
|||
(let ((tag (case representation
|
||||
((scm) 0)
|
||||
((f64) 1)
|
||||
((u64) 2)
|
||||
(else (error "what!" representation)))))
|
||||
(put-uleb128 names-port (logior (ash slot 2) tag)))
|
||||
(lp definitions))))))
|
||||
|
|
|
|||
|
|
@ -386,6 +386,7 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
|
|||
(representation (case (logand slot+representation #x3)
|
||||
((0) 'scm)
|
||||
((1) 'f64)
|
||||
((2) 'u64)
|
||||
(else 'unknown))))
|
||||
(cons (vector name def-offset slot representation)
|
||||
(lp pos names)))))))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue