Skip to content

Commit ae31756

Browse files
authored
add ftype-scheme-object-pointer and related foreign-pointer extensions
An ftype pointer to a Scheme object is useful to communicate the address of a bytevector or flvector (like `object->reference-address`) in the same places that ftype pointers can be used. There's a key difference between using these new pointers and constructing a pointer with the result of `object->reference-address`: GC cooperation with a Scheme-object pointer ensures that the address does not go stale. Instead, the address is extracted just after moving into a context where a collection cannot occur (e.g., a foreign call without `__collect_safe`). With Scheme-object pointers as a way to unify GCable and foreign references through the ftype interface, some further additions give the ftype layer flexiblity similar to the lower-level `foreign-ref` API, which extracts data from a reference without a declared/checked foreign representation. The `ftype-any-ref` and `ftype-any-set!` forms cover pointer access and update, and `ftype-pointer` is allowed as a ftype-name for a generic pointer type. In addition, `ftype-scheme-object-pointer` works as an ftype-name for a pointer to a GCable object. In the case of an `(& <ftype>)` argument or result, `(& <ftype> ftype-pointer)` can be used to accept/allocate a generic pointer record instead of a <ftype>-specific pointer record, and similarly `(& <ftype> ftype-scheme-object-pointer)`. The key changes are fairly modest, but there are many additional changes just to expand plumbing. The most tedious change is that the internal `$make-record-type` function has a new argument that can turn on GC cooperation for Scheme-object ftype pointers. Most of the rest is about making foreign-call pointer arguments and results distinguish a predicate for argument checking from the rtd used to create pointer objects.
1 parent 003a1bf commit ae31756

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

42 files changed

+1203
-358
lines changed

boot/pb/equates.h

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
/* equates.h for Chez Scheme Version 10.2.0-pre-release.1 */
1+
/* equates.h for Chez Scheme Version 10.2.0-pre-release.2 */
22

33
/* Do not edit this file. It is automatically generated and */
44
/* specifically tailored to the version of Chez Scheme named */
@@ -1015,7 +1015,7 @@ typedef uint64_t U64;
10151015
#define rtd_sealed 0x4
10161016
#define sbwp (ptr)0x4E
10171017
#define scaled_shot_1_shot_flag -0x8
1018-
#define scheme_version 0xA020001
1018+
#define scheme_version 0xA020002
10191019
#define seginfo_generation_disp 0x1
10201020
#define seginfo_list_bits_disp 0x8
10211021
#define seginfo_space_disp 0x0

boot/pb/gc-ocd.inc

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -576,6 +576,15 @@ static void sweep(thread_gc *tgc, ptr p, IGEN from_g)
576576
}
577577
}
578578
}
579+
else if (num == Strue)
580+
{
581+
uptr offset = (uptr)(*((pp + 1)));
582+
{
583+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
584+
relocate_impure(&obj, from_g);
585+
*(pp) = TO_PTR((((uptr)obj) + offset));
586+
}
587+
}
579588
else
580589
{
581590
relocate_pure(&(RECORDDESCPM(rtd)));
@@ -1258,6 +1267,15 @@ static void sweep_object_in_old(thread_gc *tgc, ptr p)
12581267
}
12591268
}
12601269
}
1270+
else if (num == Strue)
1271+
{
1272+
uptr offset = (uptr)(*((pp + 1)));
1273+
{
1274+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
1275+
relocate_indirect(obj);
1276+
*(pp) = TO_PTR((((uptr)obj) + offset));
1277+
}
1278+
}
12611279
else
12621280
{
12631281
relocate_pure(&(RECORDDESCPM(rtd)));
@@ -1837,6 +1855,15 @@ static IGEN sweep_dirty_object(thread_gc *tgc, ptr p, IGEN youngest)
18371855
}
18381856
}
18391857
}
1858+
else if (num == Strue)
1859+
{
1860+
uptr offset = (uptr)(*((pp + 1)));
1861+
{
1862+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
1863+
relocate_dirty(&obj, youngest);
1864+
*(pp) = TO_PTR((((uptr)obj) + offset));
1865+
}
1866+
}
18401867
else
18411868
{
18421869
{
@@ -2095,6 +2122,15 @@ static void sweep_record(thread_gc *tgc, ptr p, IGEN from_g)
20952122
}
20962123
}
20972124
}
2125+
else if (num == Strue)
2126+
{
2127+
uptr offset = (uptr)(*((pp + 1)));
2128+
{
2129+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
2130+
relocate_impure(&obj, from_g);
2131+
*(pp) = TO_PTR((((uptr)obj) + offset));
2132+
}
2133+
}
20982134
else
20992135
{
21002136
relocate_pure(&(RECORDDESCPM(rtd)));
@@ -2157,6 +2193,15 @@ static IGEN sweep_dirty_record(thread_gc *tgc, ptr p, IGEN youngest)
21572193
}
21582194
}
21592195
}
2196+
else if (num == Strue)
2197+
{
2198+
uptr offset = (uptr)(*((pp + 1)));
2199+
{
2200+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
2201+
relocate_dirty(&obj, youngest);
2202+
*(pp) = TO_PTR((((uptr)obj) + offset));
2203+
}
2204+
}
21602205
else
21612206
{
21622207
{
@@ -3580,6 +3625,15 @@ static IBOOL object_directly_refers_to_self(ptr p)
35803625
}
35813626
}
35823627
}
3628+
else if (num == Strue)
3629+
{
3630+
uptr offset = (uptr)(*((pp + 1)));
3631+
{
3632+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
3633+
if (p == obj) return 1;
3634+
*(pp) = TO_PTR((((uptr)obj) + offset));
3635+
}
3636+
}
35833637
else
35843638
{
35853639
if (p == RECORDDESCPM(rtd)) return 1;

boot/pb/gc-oce.inc

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -696,6 +696,15 @@ static void sweep(thread_gc *tgc, ptr p, IGEN from_g)
696696
}
697697
}
698698
}
699+
else if (num == Strue)
700+
{
701+
uptr offset = (uptr)(*((pp + 1)));
702+
{
703+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
704+
relocate_impure(&obj, from_g);
705+
*(pp) = TO_PTR((((uptr)obj) + offset));
706+
}
707+
}
699708
else
700709
{
701710
relocate_pure(&(RECORDDESCPM(rtd)));
@@ -1381,6 +1390,15 @@ static void sweep_object_in_old(thread_gc *tgc, ptr p)
13811390
}
13821391
}
13831392
}
1393+
else if (num == Strue)
1394+
{
1395+
uptr offset = (uptr)(*((pp + 1)));
1396+
{
1397+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
1398+
relocate_indirect(obj);
1399+
*(pp) = TO_PTR((((uptr)obj) + offset));
1400+
}
1401+
}
13841402
else
13851403
{
13861404
relocate_pure(&(RECORDDESCPM(rtd)));
@@ -1961,6 +1979,15 @@ static IGEN sweep_dirty_object(thread_gc *tgc, ptr p, IGEN youngest)
19611979
}
19621980
}
19631981
}
1982+
else if (num == Strue)
1983+
{
1984+
uptr offset = (uptr)(*((pp + 1)));
1985+
{
1986+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
1987+
relocate_dirty(&obj, youngest);
1988+
*(pp) = TO_PTR((((uptr)obj) + offset));
1989+
}
1990+
}
19641991
else
19651992
{
19661993
{
@@ -2221,6 +2248,15 @@ static void sweep_record(thread_gc *tgc, ptr p, IGEN from_g)
22212248
}
22222249
}
22232250
}
2251+
else if (num == Strue)
2252+
{
2253+
uptr offset = (uptr)(*((pp + 1)));
2254+
{
2255+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
2256+
relocate_impure(&obj, from_g);
2257+
*(pp) = TO_PTR((((uptr)obj) + offset));
2258+
}
2259+
}
22242260
else
22252261
{
22262262
relocate_pure(&(RECORDDESCPM(rtd)));
@@ -2285,6 +2321,15 @@ static IGEN sweep_dirty_record(thread_gc *tgc, ptr p, IGEN youngest)
22852321
}
22862322
}
22872323
}
2324+
else if (num == Strue)
2325+
{
2326+
uptr offset = (uptr)(*((pp + 1)));
2327+
{
2328+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
2329+
relocate_dirty(&obj, youngest);
2330+
*(pp) = TO_PTR((((uptr)obj) + offset));
2331+
}
2332+
}
22882333
else
22892334
{
22902335
{
@@ -3823,6 +3868,15 @@ static IBOOL object_directly_refers_to_self(ptr p)
38233868
}
38243869
}
38253870
}
3871+
else if (num == Strue)
3872+
{
3873+
uptr offset = (uptr)(*((pp + 1)));
3874+
{
3875+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
3876+
if (p == obj) return 1;
3877+
*(pp) = TO_PTR((((uptr)obj) + offset));
3878+
}
3879+
}
38263880
else
38273881
{
38283882
if (p == RECORDDESCPM(rtd)) return 1;
@@ -4151,6 +4205,19 @@ static void measure(thread_gc *tgc, ptr p)
41514205
}
41524206
}
41534207
}
4208+
else if (num == Strue)
4209+
{
4210+
uptr offset = (uptr)(*((pp + 1)));
4211+
{
4212+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
4213+
{ /* measure */
4214+
ptr r_p = obj;
4215+
if (!FIXMEDIATE(r_p))
4216+
push_measure(tgc, r_p);
4217+
}
4218+
*(pp) = TO_PTR((((uptr)obj) + offset));
4219+
}
4220+
}
41544221
else
41554222
{
41564223
{

boot/pb/gc-par.inc

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -561,6 +561,15 @@ static void sweep(thread_gc *tgc, ptr p, IGEN from_g)
561561
}
562562
}
563563
}
564+
else if (num == Strue)
565+
{
566+
uptr offset = (uptr)(*((pp + 1)));
567+
{
568+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
569+
relocate_impure(&obj, from_g);
570+
*(pp) = TO_PTR((((uptr)obj) + offset));
571+
}
572+
}
564573
else
565574
{
566575
seginfo* pm_si = SegInfo((ptr_get_segment(num)));
@@ -1262,6 +1271,15 @@ static void sweep_object_in_old(thread_gc *tgc, ptr p)
12621271
}
12631272
}
12641273
}
1274+
else if (num == Strue)
1275+
{
1276+
uptr offset = (uptr)(*((pp + 1)));
1277+
{
1278+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
1279+
relocate_indirect(obj);
1280+
*(pp) = TO_PTR((((uptr)obj) + offset));
1281+
}
1282+
}
12651283
else
12661284
{
12671285
relocate_pure(&(RECORDDESCPM(rtd)));
@@ -1841,6 +1859,15 @@ static IGEN sweep_dirty_object(thread_gc *tgc, ptr p, IGEN youngest)
18411859
}
18421860
}
18431861
}
1862+
else if (num == Strue)
1863+
{
1864+
uptr offset = (uptr)(*((pp + 1)));
1865+
{
1866+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
1867+
relocate_dirty(&obj, youngest);
1868+
*(pp) = TO_PTR((((uptr)obj) + offset));
1869+
}
1870+
}
18441871
else
18451872
{
18461873
{
@@ -2109,6 +2136,15 @@ static void sweep_record(thread_gc *tgc, ptr p, IGEN from_g)
21092136
}
21102137
}
21112138
}
2139+
else if (num == Strue)
2140+
{
2141+
uptr offset = (uptr)(*((pp + 1)));
2142+
{
2143+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
2144+
relocate_impure(&obj, from_g);
2145+
*(pp) = TO_PTR((((uptr)obj) + offset));
2146+
}
2147+
}
21122148
else
21132149
{
21142150
seginfo* pm_si = SegInfo((ptr_get_segment(num)));
@@ -2180,6 +2216,15 @@ static IGEN sweep_dirty_record(thread_gc *tgc, ptr p, IGEN youngest)
21802216
}
21812217
}
21822218
}
2219+
else if (num == Strue)
2220+
{
2221+
uptr offset = (uptr)(*((pp + 1)));
2222+
{
2223+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
2224+
relocate_dirty(&obj, youngest);
2225+
*(pp) = TO_PTR((((uptr)obj) + offset));
2226+
}
2227+
}
21832228
else
21842229
{
21852230
{
@@ -3621,6 +3666,15 @@ static IBOOL object_directly_refers_to_self(ptr p)
36213666
}
36223667
}
36233668
}
3669+
else if (num == Strue)
3670+
{
3671+
uptr offset = (uptr)(*((pp + 1)));
3672+
{
3673+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
3674+
if (p == obj) return 1;
3675+
*(pp) = TO_PTR((((uptr)obj) + offset));
3676+
}
3677+
}
36243678
else
36253679
{
36263680
if (p == RECORDDESCPM(rtd)) return 1;

boot/pb/heapcheck.inc

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,15 @@ static void check_object(ptr p, uptr seg, ISPC s_in, IBOOL aftergc)
4343
}
4444
}
4545
}
46+
else if (num == Strue)
47+
{
48+
uptr offset = (uptr)(*((pp + 1)));
49+
{
50+
ptr obj = TO_PTR((((uptr)(*(pp))) - offset));
51+
check_pointer(&(obj), 0, 0, p, seg, s_in, aftergc);
52+
*(pp) = TO_PTR((((uptr)obj) + offset));
53+
}
54+
}
4655
else
4756
{
4857
check_pointer(&(num), 0, 0, p, seg, s_in, aftergc);

boot/pb/petite.boot

4.69 MB
Binary file not shown.

boot/pb/scheme.boot

3.74 MB
Binary file not shown.

boot/pb/scheme.h

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
/* scheme.h for Chez Scheme Version 10.2.0-pre-release.1 (pb) */
1+
/* scheme.h for Chez Scheme Version 10.2.0-pre-release.2 (pb) */
22

33
/* Do not edit this file. It is automatically generated and */
44
/* specifically tailored to the version of Chez Scheme named */
@@ -40,7 +40,7 @@
4040
#endif
4141

4242
/* Chez Scheme Version and machine type */
43-
#define VERSION "10.2.0-pre-release.1"
43+
#define VERSION "10.2.0-pre-release.2"
4444
#define MACHINE_TYPE "pb"
4545

4646
/* Integer typedefs */

0 commit comments

Comments
 (0)