DBM-Deep-Blue
view release on metacpan or search on metacpan
clearMemory(*m, a, 1<<l);
setAllocLength(*m, a, l);
// Return result
return a;
}
/*
------------------------------------------------------------------------
Block position: returns 0 for a lower block and 1 for an upper block
------------------------------------------------------------------------
*/
long getAllocPosition(UL a, UL l)
{
long b = a % (1<<(l+1));
if (b >= 1<<l)
{
return 1;
}
return 0;
}
/*
------------------------------------------------------------------------
Check whether an offset is a free block, return its log2(size) if it is.
------------------------------------------------------------------------
*/
UL findFree(M *m, UL p, UL l)
{
UL i;
for(i = 1; i <= l; ++i) // Search free areas
{if (getFreeAddress(m, i) == p)
{
return i;
}
}
return 0;
}
/*
------------------------------------------------------------------------
Copy memory area from a to b
------------------------------------------------------------------------
*/
void allocCopy(M **m, UL a, UL b, UL l)
{
UL L = 1<<l; // Length of object to copy
UL V = (*m)->centralVector; // Central Vector
UL S = (*m)->spona; // Spona
UL nV = V; // In case Central Vector is relocated
UL nS = S; // In case Spona is relocated
// Relocate allocated areas contained in this block
if (V != MMU)
{UL p = a;
for(; p < a+L;)
{UL fb = findFree(*m, p, l); // Is this a free area
if (fb > 0)
{setFreeAddress2(*m, p + b - a, fb); // Update position of free area
p += 1<<fb; // Skip over free area
continue;
}
// Block size of allocated area
UL B = getAllocLength(*m, p);
// Skip Central Vector as it is immediately relocatable
if (p == V)
{nV = p + b - a; // New position for CV
p += 1<<B; // Skip CV
continue;
}
// Skip Spona as it is immediately relocatable
if (p == S)
{nS = p + b - a; // New position for spona
p += 1<<B; // Skip spona
continue;
}
// Allocated block - relocate any contained object
if (B >= MemoryMinimumSize)
{UL o = getObjectNumber(*m, p); // Get object number
// Objects with object number of zero or > MMU/2 do not not need relocation
if (o > 0 && o < MMU/2)
{UL Q = getObject(m, o); // Check CV integrity
if (p == Q) // Check CV integrity
{setObjectPointer(m, o, p + b - a); // Update CV
}
else // CV integrity has failed
{croak("Non object o=%u a=%u b=%u B=%u p=%u Q=%u", o, a, b, B, p, Q);
}
}
// Reposition HashST if necessary
if (p == (*m)->hashST)
{(*m)->hashST = p + b - a;
}
// Move up to next block
p += 1<<B;
continue;
}
// Bad block
croak("Too small memory block p=%u B=%u", p, B);
}
if (nV != V) {((*m)->centralVector = nV);} // Update CV address
if (nS != S) {((*m)->spona = nS);} // Update address
}
memcpy(am(*m, b), am(*m, a), L); // Copy data
}
/*
------------------------------------------------------------------------
Shrink memory area if possible
------------------------------------------------------------------------
*/
void shrinkMemory(M **m)
{
UL B = (*m)->length; // Current length
UL B1 = B - 1; // Half current length
// Shrink from top
if (B1 > MemoryMinimumSize && getFreeAddress(*m, B1) == 1<<(B1))
{
clearFreeAddress(*m, B1);
UL B2 = B1 - 1;
for(;B2 > MemoryMinimumSize && getFreeAddress(*m, B2) == 1<<(B2);)
{clearFreeAddress(*m, B2);
--B2;
}
++B2;
Object numbers start at 1. Thus an object that does not exist has number
0.
-----------------------------------------------------------------------
*/
UL getNewObjectNumber(M **m)
{
UL o = popSP(m); // Try to recycle an object number
if (o > 0) // from the spona
{
return o;
}
UL n = ++((*m)->objectNumber);
return n; // Generate a new object number
}
/*
-----------------------------------------------------------------------
Clear Central Vector
-----------------------------------------------------------------------
*/
void clearCV(M *m)
{
UL v = m->centralVector; // Offset of CV
UL W = m->centralVectorX; // Extent of CV
CVT *cv = am(m, v); // Address CV
UL i;
for(i = 0; i < W; ++i)
{cv->array[i] = MMU; // Set slot to non object
}
}
/*
-----------------------------------------------------------------------
Allocate Central Vector if not yet allocated
-----------------------------------------------------------------------
*/
UL allocCV(M **m)
{UL v = (*m)->centralVector; // Offset of CV
if (v == MMU) // Not yet allocated
{UL l = 4; // Default size for CV - it grows as needed
v = allocMemory(m, l); // Allocate CV
(*m)->centralVector = v; // Save offset of CV
setCVX(*m, l); // Save extent of CV
clearCV(*m); // Clear CV
}
return v;
}
/*
------------------------------------------------------------------------
Re-allocate and relocate Central Vector
------------------------------------------------------------------------
*/
void reallocCV(M **m)
{
UL V = allocCV(m); // Address of CV
UL l = getAllocLength(*m, V); // Size of block
UL s = getCVX(*m); // Size needed for CV
if (s == 0) // CV no longer needed
{(*m)->centralVector = MMU; // Mark a not in use
(*m)->centralVectorX = 0; // With no extent
freeMemory(m, V); // Free CV
return;
}
if (s == l) // Existing CV should be fine
{
return;
}
UL p = allocMemory(m, s); // Allocate new CV
(*m)->centralVector = p; // Set new CV
setCVX(*m, s); // Set new CV extent
clearCV(*m); // Clear CV
if (s > l)
{allocCopy(m, V, p, l); // Copy in old CV
}
else // Allocate smaller CV
{allocCopy(m, V, p, s); // Copy active part of old CV
}
setAllocLength(*m, p, s); // Reset allocation length destroyed by allocCopy
freeMemory(m, V); // Free old CV
return;
}
/*
------------------------------------------------------------------------
Dump Central Vector
------------------------------------------------------------------------
*/
void dcv(M **m, FILE *f)
{UL V = allocCV(m); // Address CV
UL W = (*m)->centralVectorX; // Extent of CV
char *lm[] = {"normal", "save", "rollback", "commit"};
fprintf(f, "LogMode %s log=%u DD=%u transaction=%u\n\n", lm[(*m)->logMode], (*m)->log, (*m)->DD, (*m)->transaction);
fprintf(f, "CVT at address %u extent %u\n\n", V, W);
if ((*m)->fileBacked > 0) // File backed
{fprintf(f, "Backing File=%s, allocated bytes=%u\n", (*m)->file, (*m)->allocatedBytes);
}
UL allocObject(M **m, UL s)
{
UL S = s + sizeof(struct O); // Size + memory allocation control byte + reference count + object number
UL o = getNewObjectNumber(m); // Get a new object number
// Place object address in Central Vector
UL i;
for(i = 0; i < bMU; ++i) // Allow CV to expand if necessary
{allocCV(m); // Address CV
UL W = (*m)->centralVectorX; // Extent of CV
if (o <= W)
{UL p = allocMemory(m, bits(S)); // Allocate a memory block that is big enough
putObjectInCV (m, o, p); // Update CV
zeroReferenceCount(m, o); // Zero object reference count
return o; // Return object number
}
reallocCV(m); // reallocate CV if too small
}
croak("Unable to expand Central Vector to contain new object");
}
// Same as above except that the object prefix is assumed to be in the specified size
UL allocObject2(M **m, UL s)
{return allocObject(m, s - sizeof(struct O));
}
/*
------------------------------------------------------------------------
Reallocate object of specified size and indeterminate type.
o - object to be reallocated
s - Size of storage required (does not include object prefix - it will
be added) in bytes.
copy - a function to copy data from the old object to the new object
befor we free it.
Returns the number of the object created. You can convert this to the
offset of the object in the memory structure by calling
getObjectOffset().
-----------------------------------------------------------------------
*/
void reallocObject(M **m, UL o, UL s, void (*copy)(M **m, UL from, UL to, UL l))
{
UL l = bits(s + sizeof(struct O)); // Log2(Size of required block)
UL p = allocMemory(m, l); // Allocate a memory block that is big enough
UL q = getObject (m, o); // Offset of existing object
// Set object number of new allocation
putObjectInCV ( m, o, p); // Update CV, its an existing object so CVT will not change
setObjectNumber(*m, q, 0); // Zero object number of old object so that allocCopy will not relocate it
// Copy data if copy function supplied
if (copy)
{(*copy)(m, q, p, l);
}
// Copy referenceCount and type from old to new object
{O *P = am(*m, p);
O *Q = am(*m, q);
P->referenceCount = Q->referenceCount; // Copy object attributes
P->type = Q->type;
}
freeMemory(m, q); // Free old object
}
// The same as the above except that the object prefix is assumed to be contained in the size
void reallocObject2(M **m, UL o, UL s, void (*copy)(M **m, UL from, UL to, UL l))
{reallocObject(m, o, s - sizeof(struct O), copy);
}
/*
------------------------------------------------------------------------
Free object by object number immediately
-----------------------------------------------------------------------
*/
void freeObjectImmediately(M **m, UL o)
{
UL p = getObject(m, o); // Offset of memory block containing this object
UL t = getObjectType(m, o); // Free by object type
void (*f[])(M **m, UL o) = {&freeNothing, &freeNothing, &freeHashSTKey, &freeArrayObject, &freeHashObject};
(*(f[t]))(m, o);
p = getObject(m, o); // It has probably moved by now, so readdress
freeMemory(m, p); // Free memory block
putSP(m, o); // Put object number on spona
}
/*
------------------------------------------------------------------------
Clean up - removes any objects whose reference count has fallen to zero.
-----------------------------------------------------------------------
*/
void cleanUp(M **m)
{
for(;(*m)->lastObjectFreed > 0;)
{MU f = (*m)->lastObjectFreed;
( run in 0.617 second using v1.01-cache-2.11-cpan-71847e10f99 )