1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
/* $Id: //info.ravenbrook.com/project/mps/master/test/test/testlib/lofmt.c#4 $
lofmt.c
   A format for pool class LO
*/

#include "lofmt.h"
#include <string.h>

/* some options on the format are controlled by global
   variables. Of course for efficiency we'd do it in the
   pre-processor, but that would require recompilation...

 variable      default function

 alloclocomments  comment on allocation (0)
 allowlocopies    allow objects to be copied (1)
*/

int alloclocomments=0;
int allowlocopies=1;

long int nextid=0x2000000;

/* a cell can be one of four things, depending on its type:
  LOpadsingle - a single pad item, MPS_PF_ALIGN in size
  LOpadmulti  - a longer pad item, at least 2*MPS_PF_ALIGN in size
  LOheart     - a broken heart, aka forwarding object
  LOdata      - a real object
*/

static mps_res_t myscan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit);
static mps_addr_t myskip(mps_addr_t object);
static void myfwd(mps_addr_t object, mps_addr_t to);
static mps_addr_t myisfwd(mps_addr_t object);
static void mycopy(mps_addr_t object, mps_addr_t to);
static void mypad(mps_addr_t base, size_t size);

struct mps_fmt_A_s fmtLO =
{
 MPS_PF_ALIGN,
 &myscan,
 &myskip,
 &mycopy,
 &myfwd,
 &myisfwd,
 &mypad
};

/* in the following, size is the size_t of the data element
   of the lodata structure you want the object to have; i.e.
   the number of bytes of storage you get in the object on top
   of the headers.
*/

locell *alloclo(mps_ap_t ap, size_t size) {
 mps_addr_t p;
 locell *q;
 size_t bytes;
 size_t alignment;

 bytes = offsetof(struct lodata, data) + size;

 alignment = MPS_PF_ALIGN; /* needed to make it as wide as size_t */

/* twiddle the value of size to make it aligned */
 bytes = (bytes+alignment-1) & ~(alignment-1);

 do {
  die(mps_reserve(&p, ap, bytes), "Reserve: ");
  q=p;
  q->data.tag = LOdata;
  q->data.id = nextid;
  q->data.copycount = 0;
  q->data.size = bytes;
 }
 while (!mps_commit(ap, p, bytes));
 commentif(alloclocomments, "allocated id %li at %p.", nextid, q);
 nextid += 1;

 return q;
}

static mps_res_t myscan(mps_ss_t ss, mps_addr_t b, mps_addr_t l) {
 error("Scan method in LO format called!");
 return MPS_RES_OK;
}

static mps_addr_t myskip(mps_addr_t object) {
 locell *obj = object;

 switch(obj->tag)
 {
  case LOpadsingle:
   return (mps_addr_t) ((char *) obj + MPS_PF_ALIGN);
  case LOpadmany:
   return obj->padmulti.next;
  case LOheart:
   return (mps_addr_t) ((char *) obj + (obj->heart.size));
  case LOdata:
   return (mps_addr_t) ((char *) obj + (obj->data.size));
  default:
   asserts(0, "loskip: bizarre obj tag at %p.", obj);
   return 0; /* not reached */
 }
}

static void mycopy(mps_addr_t object, mps_addr_t to)
{
 locell *boj = object;
 locell *toj = to;

 asserts(allowlocopies, "locopy on LO object");
 asserts(boj->tag == LOdata, "locopy: non-data object");

 memmove(to, object, boj->data.size);
 toj->data.copycount = (toj->data.copycount)+1;
}

/* pad stores not its size but a pointer to the next object,
   because we know we'll never be asked to copy it
*/

static void mypad(mps_addr_t base, size_t size)
{
 locell *obj = base;

 asserts(size >= MPS_PF_ALIGN, "pad: size too small.");

 if (size == MPS_PF_ALIGN)
 {
  asserts(sizeof(obj->padsingle) <= MPS_PF_ALIGN, "impossible pad");
  obj->padsingle.tag = LOpadsingle;
 }
 else
 {
  asserts(size >= sizeof(struct lopadmulti), "pad: awkward size.");
  obj->padmulti.tag = LOpadmany;
  obj->padmulti.next = (mps_addr_t) ((char *) base + size);
 }
}

static mps_addr_t myisfwd(mps_addr_t object)
{
 locell *obj = object;

 if (obj->tag != LOheart)
 {
  return NULL;
 }
 else
 {
  return obj->heart.obj;
 }
}

static void myfwd(mps_addr_t object, mps_addr_t to)
{
 locell *obj = object;
 size_t size;

 asserts(obj->tag == LOdata || obj->tag == LOheart,
  "lofwd: unexpected object tag at %p.", obj);

 if (obj->tag == LOdata)
 {
  size = obj->data.size;
 }
 else /* obj->tag == LOheart */
 {
  size = obj->heart.size;
 }
 obj->data.tag = LOheart;
 obj->heart.obj = to;
 obj->heart.size = size;
}

long int getloid(locell *obj)
{
 asserts(obj->tag == LOdata, "getloid: non-data object.");
 return obj->data.id;
}

long int getlocopycount(locell *obj)
{
 asserts(obj->tag == LOdata, "getlocopycount: non-data object.");
 return obj->data.copycount;
}

size_t getlosize(locell *obj)
{
 asserts(obj->tag == LOdata, "getlosize: non-data object.");
 return obj->data.size - offsetof(struct lodata, data);
}