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

Merge branch 'phantom' of github.com:mflatt/ChezScheme

Browse Source 
original commit: 743a56d8f1920620e8f6e14edca7984101425e14
This commit is contained in:
Matthew Flatt 2019-01-20 07:56:59 -07:00
commit b27f3c0a94
19 changed files with 336 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
LOG
View File

@ -1062,3 +1062,8 @@
- use the "single-valued" flag on primitives to simplify certain
call-with-values patterns
cp0.ss, cp0.ms
- added phantom bytevectors
cmacros.ss, primdata.ss, prims.ss, cpnanopass.ss, fasl.ss,
inspect.ss, prin.ss, mkheader.ss, misc.ms,
alloc.c, prim5.c, gc.c, fasl.c, externs.h,
smgmt.stex, system.stex, release_notes.stex

33
c/alloc.c
View File

@ -146,6 +146,7 @@ ptr S_compute_bytes_allocated(xg, xs) ptr xg; ptr xs; {
g = gmin;
while (g <= gmax) {
n += S_G.phantom_sizes[g];
for (s = smin; s <= smax; s++) {
/* add in bytes previously recorded */
n += S_G.bytes_of_space[s][g];
@ -170,7 +171,7 @@ static void maybe_fire_collector() {
ISPC s;
uptr bytes, fudge;
bytes = 0;
bytes = S_G.phantom_sizes[0];
for (s = 0; s <= max_real_space; s += 1) {
/* bytes already accounted for */
@ -928,3 +929,33 @@ ptr S_relocation_table(n) iptr n; {
RELOCSIZE(p) = n;
return p;
}
ptr S_phantom_bytevector(sz) uptr sz; {
ptr tc = get_thread_context();
ptr p;
thread_find_room(tc, type_typed_object, size_phantom, p);
PHANTOMTYPE(p) = type_phantom;
PHANTOMLEN(p) = 0;
S_phantom_bytevector_adjust(p, sz);
return p;
}
void S_phantom_bytevector_adjust(ph, new_sz) ptr ph; uptr new_sz; {
uptr old_sz = PHANTOMLEN(ph);
seginfo *si;
IGEN g;
tc_mutex_acquire()
si = SegInfo(ptr_get_segment(ph));
g = si->generation;
S_G.phantom_sizes[g] += (new_sz - old_sz);
PHANTOMLEN(ph) = new_sz;
tc_mutex_release()
}

2
c/externs.h
View File

@ -90,6 +90,8 @@ extern ptr S_string PROTO((const char *s, iptr n));
extern ptr S_bignum PROTO((iptr n, IBOOL sign));
extern ptr S_code PROTO((ptr tc, iptr type, iptr n));
extern ptr S_relocation_table PROTO((iptr n));
extern ptr S_phantom_bytevector PROTO((uptr sz));
extern void S_phantom_bytevector_adjust PROTO((ptr ph, uptr new_sz));
/* fasl.c */
extern void S_fasl_init PROTO((void));

3
c/fasl.c
View File

@ -937,6 +937,9 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
case fasl_type_library_code:
*x = CLOSCODE(S_lookup_library_entry(uptrin(f), 1));
return;
case fasl_type_phantom:
*x = S_phantom_bytevector(uptrin(f));
return;
case fasl_type_graph:
faslin(tc, x, S_vector(uptrin(f)), pstrbuf, f);
return;

14
c/gc.c
View File

@ -480,6 +480,11 @@ static ptr copy(pp, si) ptr pp; seginfo *si; {
#endif /* ENABLE_OBJECT_COUNTS */
find_room(space_data, tg, type_typed_object, size_rtd_counts, p);
copy_ptrs(type_typed_object, p, pp, size_rtd_counts);
} else if (TYPEP(tf, mask_phantom, type_phantom)) {
find_room(space_data, tg, type_typed_object, size_phantom, p);
PHANTOMTYPE(p) = PHANTOMTYPE(pp);
PHANTOMLEN(p) = PHANTOMLEN(pp);
S_G.phantom_sizes[tg] += PHANTOMLEN(p);
} else {
S_error_abort("copy(gc): illegal type");
return (ptr)0 /* not reached */;
@ -691,6 +696,8 @@ static void sweep(ptr tc, ptr p, IBOOL sweep_pure) {
sweep_thread(p);
} else if ((iptr)tf == type_rtd_counts) {
/* nothing to sweep */;
} else if ((iptr)tf == type_phantom) {
/* nothing to sweep */;
} else {
S_error_abort("sweep(gc): illegal type");
}
@ -913,6 +920,11 @@ void GCENTRY(ptr tc, IGEN mcg, IGEN tg) {
S_G.bytes_of_space[s][g] = 0;
}
/* reset phantom size in generations to be copied */
for (g = 0; g <= mcg; g++) {
S_G.phantom_sizes[g] = 0;
}
/* set up target generation sweep_loc and orig_next_loc pointers */
for (s = 0; s <= max_real_space; s++)
orig_next_loc[s] = sweep_loc[s] = S_G.next_loc[s][tg];
@ -1690,6 +1702,8 @@ static iptr size_object(p) ptr p; {
return size_thread;
} else if ((iptr)tf == type_rtd_counts) {
return size_rtd_counts;
} else if ((iptr)tf == type_phantom) {
return size_phantom;
} else {
S_error_abort("size_object(gc): illegal type");
return 0 /* not reached */;

1
c/globals.h
View File

@ -133,6 +133,7 @@ EXTERN struct {
ptr static_id;
ptr countof_names;
ptr gcbackreference[static_generation+1];
uptr phantom_sizes[static_generation+1];
/* intern.c */
iptr *oblist_length_pointer;

2
c/prim5.c
View File

@ -1574,6 +1574,8 @@ void S_prim5_init() {
Sforeign_symbol("(cs)bytevector_compress", (void*)S_bytevector_compress);
Sforeign_symbol("(cs)bytevector_uncompress", (void*)S_bytevector_uncompress);
Sforeign_symbol("(cs)phantom_bytevector_adjust", (void*)S_phantom_bytevector_adjust);
Sforeign_symbol("(cs)logand", (void *)S_logand);
Sforeign_symbol("(cs)logbitp", (void *)S_logbitp);
Sforeign_symbol("(cs)logbit0", (void *)S_logbit0);

85
csug/smgmt.stex
View File

@ -882,3 +882,88 @@ or objects that have been made static is unnecessary and ineffective but harmles
This predicate returns true if \var{obj} cannot be relocated or reclaimed
by the collector, including immediate values, such as fixnums,
booleans, and characters, and objects that have been made static.
\section{Phantom Bytevectors\label{SECTSMGMTPHANTOM}}
\index{phamtom bytevectors}A \emph{phantom bytevector} represents
memory that is allocated outside of the Scheme stroage management
system. A phantom bytevector itself uses a small amount of space, but
it contains a length that reflects external allocation. Representing
external allocation can be useful for reflecting memory consumption
and triggering garbage-collection heuristics based on consumption. For
example, for a program that allocates external objects and frees
through a guardian, representing the external object's memory use can
trigger earlier garbage collections when the external objects are
large. A phantom bytevector can also reflect external allocation to
tools like \scheme{compute-size}, since the length of a phantom
bytevector is included in the result of \scheme{compute-size} for the
phantom bytevector.
%----------------------------------------------------------------------------
\entryheader
\formdef{make-phantom-bytevector}{\categoryprocedure}{(make-phantom-bytevector \var{n})}
\returns a phantom bytevector
\listlibraries
\endentryheader
\noindent
\var{n} must be an exact nonnegative integer.
Creates a phantom bytevector that reflects \var{n} bytes of external
allocation.
The value \var{n} must reflect actual allocation in the sense of
consuming a portion of the process's address space. Claiming
significantly more bytes than are actually allocated introduces the
possibility of overflow within the store management system's
calculations.
%----------------------------------------------------------------------------
\entryheader
\formdef{phantom-bytevector?}{\categoryprocedure}{(phantom-bytevector? \var{obj})}
\returns \scheme{#t} if obj is a phantom bytevector, \scheme{#f} otherwise
\listlibraries
\endentryheader
\schemedisplay
(phantom-bytevector? (make-phantom-bytevector 1024)) ;=> #t
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{phantom-bytevector-length}{\categoryprocedure}{(phantom-bytevector-length \var{pbv})}
\returns the length of the phantom bytevector
\listlibraries
\endentryheader
\noindent
\var{pbv} must be a phantom bytevector.
Returns the number of bytes of external allocation that \var{pbv}
represents.
\schemedisplay
(phantom-bytevector-length (make-phantom-bytevector 1024)) ;=> 1024
\endschemedisplay
%----------------------------------------------------------------------------
\entryheader
\formdef{set-phantom-bytevector-length!}{\categoryprocedure}{(set-phantom-bytevector-length! \var{pbv} \var{n})}
\returns unspecified
\listlibraries
\endentryheader
\noindent
\var{pbv} must be a phantom bytevector, and \var{n} must be an exact nonnegative integer.
Adjusts the allocation represented by \var{pbv} to \var{n} bytes. For
example, when an externally allocated object represented by \var{pbv}
is deallocated, then \var{pbv}'s length should be set to \scheme{0}.
\schemedisplay
(define pbv (make-phantom-bytevector 1024))
(phantom-bytevector-length pbv) ;=> 1024
(set-phantom-bytevector-length! pbv 1)
(phantom-bytevector-length pbv) ;=> 1
\endschemedisplay

9
csug/system.stex
View File

@ -4498,7 +4498,9 @@ See also \scheme{current-time}, which returns more precise information.
\endentryheader
If \var{g} is supplied, \scheme{bytes-allocated} returns the number of
bytes currently allocated for Scheme objects in the specified generation.
bytes currently allocated for Scheme objects in the specified generation
plus externally allocated bytes as represented by phantom bytevectors in
the generation.
\var{g} must be a nonnegative exact integer no greater than the
maximum nonstatic generation, i.e., the
value returned by \scheme{collect-maximum-generation}, or the symbol
@ -4506,7 +4508,6 @@ value returned by \scheme{collect-maximum-generation}, or the symbol
If \var{g} is not supplied, \scheme{bytes-allocated} returns the total
number of bytes allocated in all generations.
%----------------------------------------------------------------------------
\entryheader
\formdef{initial-bytes-allocated}{\categoryprocedure}{(initial-bytes-allocated)}
@ -4539,7 +4540,9 @@ in bytes, including not only the bytes occupied for Scheme objects
but also various forms of overhead, including fragmentation and
reserved but not currently occupied memory, and is thus an accurate
measure of the amount of heap memory currently reserved from the
operating system for the current process.
operating system for the current process. The result is only for
Scheme's storage management, however, so it does not include sizes
for externally allocated objects that are represented by phantom bytevectors.
%----------------------------------------------------------------------------
\entryheader

82
mats/misc.ms
View File

@ -5376,4 +5376,84 @@
(expand-omit-library-invocations #f)
(not (expand-omit-library-invocations)))
(find-define-m-as-one (expand '(let () (import (define-m-as-one)) m)))
)
)
(mat phantom-bytevector
(phantom-bytevector? (make-phantom-bytevector 0))
(not (phantom-bytevector? 10))
(not (phantom-bytevector? (vector 1 2 3)))
(error? (make-phantom-bytevector -1))
(error? (make-phantom-bytevector (expt 2 100)))
(error? (make-phantom-bytevector 'x))
(begin
(define $ph (make-phantom-bytevector 0))
(phantom-bytevector? $ph))
(eqv? 0 (phantom-bytevector-length $ph))
(eqv? (void) (set-phantom-bytevector-length! $ph 1))
(eqv? 1 (phantom-bytevector-length $ph))
(eqv? (void) (set-phantom-bytevector-length! $ph 100))
(eqv? 100 (phantom-bytevector-length $ph))
(begin
(collect (collect-maximum-generation))
(define $pre-allocated (bytes-allocated))
(define $pre-memory (current-memory-bytes))
(set-phantom-bytevector-length! $ph $pre-allocated)
#t)
;; Big change to `(bytes-allocated)`
(< (* 1.75 $pre-allocated)
(bytes-allocated)
(* 2.25 $pre-allocated))
;; No big change to `(current-memory-bytes)`
(< (* 0.75 $pre-memory)
(current-memory-bytes)
(* 1.25 $pre-memory))
;; Same change after GC
(begin
(collect (collect-maximum-generation))
(< (* 1.75 $pre-allocated)
(bytes-allocated)
(* 2.25 $pre-allocated)))
;; fasl => another jump by `$pre-allocated` bytes
(begin
(define $ph2
(let-values ([(o get) (open-bytevector-output-port)])
(fasl-write $ph o)
(fasl-read (open-bytevector-input-port (get)))))
(phantom-bytevector? $ph2))
(< (* 2.75 $pre-allocated)
(bytes-allocated)
(* 3.25 $pre-allocated))
;; Try GC again
(begin
(collect (collect-maximum-generation))
(< (* 2.75 $pre-allocated)
(bytes-allocated)
(* 3.25 $pre-allocated)))
;; Let GC reclaim $ph2, and `(byte-allocated)` should go down
(begin
(set! $ph2 #f)
(collect (collect-maximum-generation))
(< (* 1.75 $pre-allocated)
(bytes-allocated)
(* 2.25 $pre-allocated)))
(> (compute-size $ph) (phantom-bytevector-length $ph))
;; Change length of `$ph`, and `(byte-allocated)` should go down
(begin
(set-phantom-bytevector-length! $ph 0)
(< (* 0.75 $pre-allocated)
(bytes-allocated)
(* 1.25 $pre-allocated)))
)

7
release_notes/release_notes.stex
View File

@ -58,6 +58,13 @@ Online versions of both books can be found at
%-----------------------------------------------------------------------------
\section{Functionality Changes}\label{section:functionality}
\subsection{Phantom bytevectors (9.5.1)}
Phantom bytevectors reflect externally allocated memory use in an
object. A phamtom bytevector is recognized by \scheme{compute-size},
and it can affect garbage-collection heuristics to trigger earlier
finalization of the external object through a guardian.
\subsection{Counting reachable objects from multiple sources (9.5.1)}
The new procedure \scheme{compute-size-increments} is like

7
s/cmacros.ss
View File

@ -456,6 +456,7 @@
(define-constant fasl-type-immutable-box 40)
(define-constant fasl-type-begin 41)
(define-constant fasl-type-phantom 42)
(define-constant fasl-fld-ptr 0)
(define-constant fasl-fld-u8 1)
@ -749,6 +750,7 @@
(define-constant type-thread #b01001110)
(define-constant type-tlc #b01011110)
(define-constant type-rtd-counts #b01101110)
(define-constant type-phantom #b01111110)
(define-constant type-record #b111)
(define-constant code-flag-system #b0001)
@ -932,6 +934,7 @@
(fx- (fxsll 1 (constant code-flags-offset)) 1)))
(define-constant mask-thread (constant byte-constant-mask))
(define-constant mask-tlc (constant byte-constant-mask))
(define-constant mask-phantom (constant byte-constant-mask))
(define-constant type-mutable-vector (constant type-vector))
(define-constant type-immutable-vector
@ -1467,6 +1470,10 @@
[ptr ordered?] ; boolean to indicate finalization mode
[ptr pending])) ; for the GC's use
(define-primitive-structure-disps phantom type-typed-object
([iptr type]
[uptr length]))
;;; forwarding addresses are recorded with a single forward-marker
;;; bit pattern (a special Scheme object) followed by the forwarding
;;; address, a ptr to the forwarded object.

17
s/cpnanopass.ss
View File

@ -4941,6 +4941,7 @@
(typed-object-pred immutable-fxvector? mask-mutable-fxvector type-immutable-fxvector)
(typed-object-pred $inexactnum? mask-inexactnum type-inexactnum)
(typed-object-pred $rtd-counts? mask-rtd-counts type-rtd-counts)
(typed-object-pred phantom-bytevector? mask-phantom type-phantom)
(typed-object-pred input-port? mask-input-port type-input-port)
(typed-object-pred output-port? mask-output-port type-output-port)
(typed-object-pred port? mask-port type-port)
@ -5733,6 +5734,22 @@
(set! ,(%mref ,t ,(constant guardian-entry-pending-disp)) ,(%constant snil))
(set! ,(%tc-ref guardian-entries) ,t))))])
(define-inline 3 $make-phantom-bytevector
[()
(bind #f ()
(bind #t ([t (%constant-alloc type-typed-object (constant size-phantom))])
(%seq
(set! ,(%mref ,t ,(constant phantom-type-disp))
,(%constant type-phantom))
(set! ,(%mref ,t ,(constant phantom-length-disp))
(immediate 0))
,t)))])
(define-inline 3 phantom-bytevector-length
[(e-ph)
(bind #f (e-ph)
(unsigned->ptr (%mref ,e-ph ,(constant phantom-length-disp))
(constant ptr-bits)))])
(define-inline 2 virtual-register-count
[() `(quote ,(constant virtual-register-count))])
(let ()

6
s/fasl.ss
View File

@ -524,6 +524,11 @@
(put-uptr p (ash n -32))
(put-uptr p (logand n #xFFFFFFFF)))))
(define wrf-phantom
(lambda (x p)
(put-u8 p (constant fasl-type-phantom))
(put-uptr p (phantom-bytevector-length x))))
(define wrf-graph
(lambda (x p t a? handler)
(let ([a (eq-hashtable-ref (table-hash t) x #f)])
@ -572,6 +577,7 @@
[(eq? x (void)) (wrf-immediate (constant svoid) p)]
[(eq? x '#0=#0#) (wrf-immediate (constant black-hole) p)]
[($rtd-counts? x) (wrf-immediate (constant sfalse) p)]
[(phantom-bytevector? x) (wrf-phantom x p)]
[else ($oops 'fasl-write "invalid fasl object ~s" x)])))
(module (start)

28
s/inspect.ss
View File

@ -509,6 +509,7 @@
[(char? x) char-dispatch-table]
[else empty-dispatch-table]))]
[(tlc) tlc-dispatch-table]
[(phantom-bytevector) phantom-dispatch-table]
[(ftype-struct) ftype-struct-dispatch-table]
[(ftype-union) ftype-union-dispatch-table]
[(ftype-array) ftype-array-dispatch-table]
@ -1723,6 +1724,15 @@
(name-line-display ((object) 'next) "next"))]
))
(define phantom-dispatch-table
(make-dispatch-table
["content-size"
"show size field"
(() (name-line-display ((object) 'content-size) "content-size"))]
))
(set! inspect
(lambda (x)
(let ([t (set-timer 0)])
@ -1885,6 +1895,14 @@
[write (p) (write x p)]
[print (p) (pretty-print x p)]))
(define make-phantom-object
(make-object-maker phantom-bytevector (x)
[value () x]
[length () (phantom-bytevector-length x)]
[size (g) (compute-size x g)]
[write (p) (write x p)]
[print (p) (pretty-print x p)]))
(define make-ftype-pointer-object
(lambda (x)
(define (unrecognized-ux ux)
@ -2382,6 +2400,7 @@
[(port? x) (make-port-object x)]
[($unbound-object? x) (make-unbound-object x)]
[($tlc? x) (make-tlc-object x)]
[(phantom-bytevector? x) (make-phantom-object x)]
[else (make-simple-object x)])))
(make-object x)))
@ -2659,6 +2678,9 @@
(compute-size ($tlc-keyval x))
(compute-size ($tlc-next x)))]
[($rtd-counts? x) (constant size-rtd-counts)]
[(phantom-bytevector? x)
(fx+ (constant size-tlc)
(phantom-bytevector-length x))]
[else ($oops who "missing case for ~s" x)])))
(cond
[single-inspect-mode?
@ -2716,7 +2738,7 @@
(define-counters (type-names type-counts incr!)
pair symbol vector fxvector bytevector string box flonum bignum ratnum exactnum
inexactnum continuation stack procedure code-object reloc-table port thread tlc
rtd-counts)
rtd-counts phantom)
(define compute-composition!
(lambda (x)
(unless (or ($immediate? x)
@ -2837,6 +2859,8 @@
(compute-composition! ($tlc-keyval x))
(compute-composition! ($tlc-next x))]
[($rtd-counts? x) (incr! rtd-counts (constant size-rtd-counts))]
[(phantom-bytevector? x) (incr! phantom (fx+ (constant size-phantom)
(phantom-bytevector-length x)))]
[else ($oops who "missing case for ~s" x)])))
; ensure hashtables aren't counted
(eq-hashtable-set! seen-ht seen-ht #t)
@ -2905,7 +2929,7 @@
(construct-proc ($object-ref 'scheme-object x (fld-byte fld)) (f (cdr flds)))
(f (cdr flds))))))))]
[(or (fxvector? x) (bytevector? x) (string? x) (flonum? x) (bignum? x)
($inexactnum? x) ($rtd-counts? x))
($inexactnum? x) ($rtd-counts? x) (phantom-bytevector? x))
next-proc]
[(box? x) (construct-proc (unbox x) next-proc)]
[(ratnum? x) (construct-proc ($ratio-numerator x) ($ratio-denominator x) next-proc)]

3
s/mkheader.ss
View File

@ -805,6 +805,9 @@
(definit INITTLCNEXT tlc next)
(defset SETTLCNEXT tlc next)
(defref PHANTOMTYPE phantom type)
(defref PHANTOMLEN phantom length)
(defref SYMVAL symbol value)
(defref SYMPVAL symbol pvalue)
(defref SYMPLIST symbol plist)

5
s/primdata.ss
View File

@ -1452,6 +1452,7 @@
(make-object-finder [sig [(procedure) (procedure ptr) (procedure ptr sub-ufixnum) -> (procedure)]] [flags alloc])
(make-output-port [sig [(procedure string) -> (textual-output-port)]] [flags alloc])
(make-parameter [sig [(ptr) (ptr procedure) -> (procedure)]] [flags true cp02 cp03])
(make-phantom-bytevector [sig [(uptr) -> (ptr)]] [flags true])
(make-record-type [sig [(sub-ptr sub-list) (maybe-rtd sub-ptr sub-list) -> (rtd)]] [flags pure alloc cp02])
(make-source-condition [sig [(ptr) -> (condition)]] [flags pure unrestricted mifoldable discard])
(make-source-file-descriptor [sig [(string binary-input-port) (string binary-input-port ptr) (string binary-input-port ptr ptr) -> (sfd)]] [flags true])
@ -1503,6 +1504,8 @@
(path-parent [sig [(pathname) -> (pathname)]] [flags true #;cp02])
(path-rest [sig [(pathname) -> (pathname)]] [flags true #;cp02])
(path-root [sig [(pathname) -> (pathname)]] [flags true #;cp02])
(phantom-bytevector? [sig [(ptr) -> (boolean)]] [flags pure mifoldable discard])
(phantom-bytevector-length [sig [(ptr) -> (ptr)]] [flags true])
(port-bol? [sig [(textual-output-port) -> (boolean)]] [flags discard])
(port-closed? [sig [(port) -> (boolean)]] [flags discard])
(port-file-descriptor [sig [(port) -> (ufixnum)]] [flags discard])
@ -1581,6 +1584,7 @@
(set-binary-port-output-index! [sig [(binary-output-port sub-index) -> (void)]] [flags true])
(set-binary-port-output-size! [sig [(binary-output-port sub-length) -> (void)]] [flags true])
(set-box! [sig [(box ptr) -> (void)]] [flags true])
(set-phantom-bytevector-length! [sig [(ptr ptr) -> (void)]] [flags true])
(set-port-bol! [sig [(textual-output-port ptr) -> (void)]] [flags true])
(set-port-eof! [sig [(input-port ptr) -> (void)]] [flags true])
(set-port-input-buffer! [sig [(input-port sub-ptr) -> (void)]] [flags true])
@ -2107,6 +2111,7 @@
($make-library-requirements-options [flags pure discard true])
($make-load-binary [flags])
($make-object-finder [flags])
($make-phantom-bytevector [flags])
($make-promise [flags alloc])
($make-read [flags])
($make-recompile-condition [flags])

33
s/prims.ss
View File

@ -1785,6 +1785,7 @@
(define-tlc-parameter $tlc-next $set-tlc-next!)
)
(define $generation
(lambda (x)
($generation x)))
@ -1798,6 +1799,38 @@
(lambda (x)
($seginfo-space x)))
(let ()
(define $phantom-bytevector-adjust!
(foreign-procedure "(cs)phantom_bytevector_adjust"
(scheme-object uptr)
void))
(set-who! phantom-bytevector?
(lambda (v) (phantom-bytevector? v)))
(set-who! $make-phantom-bytevector
(lambda () (#3%$make-phantom-bytevector)))
(set-who! make-phantom-bytevector
(lambda (n)
(unless (and ($integer-64? n) (>= n 0))
($oops who "~s is not a valid phantom bytevector length" n))
(let ([ph ($make-phantom-bytevector)])
($phantom-bytevector-adjust! ph n)
ph)))
(set-who! phantom-bytevector-length
(lambda (ph)
(unless (phantom-bytevector? ph) ($oops who "~s is not a phantom bytevector" ph))
(#3%phantom-bytevector-length ph)))
(set-who! set-phantom-bytevector-length!
(lambda (ph n)
(unless (phantom-bytevector? ph) ($oops who "~s is not a phantom bytevector" ph))
(unless (and ($integer-64? n) (>= n 0))
($oops who "~s is not a valid phantom bytevector length" n))
($phantom-bytevector-adjust! ph n))))
(define ($fxaddress x) (#3%$fxaddress x))
(define $logand

1
s/print.ss
View File

@ -691,6 +691,7 @@ floating point returns with (1 0 -1 ...).
[($tlc?) (display-string "#<tlc>" p)]
[(thread?) (wrthread x p)]
[($rtd-counts?) (display-string "#<rtd-counts>" p)]
[(phantom-bytevector?) (display-string "#<phantom-bytevector>" p)]
[else (display-string "#<garbage>" p)])]
[else (display-string "#<foreign>" p)])))