/*
------------------------------------------------------------------------
DBM_Deep_Blue
Philip R Brenan, 2010
------------------------------------------------------------------------
*/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <malloc.h>
#include <windows.h>
/*
------------------------------------------------------------------------
Memory model
------------------------------------------------------------------------
*/
#define MUNIT long // The memory models are selected with char, short, long, quad
#define PAGESIZE 4096 // Byte size of a page on this system
typedef unsigned char UCHAR; // Byte
typedef unsigned MUNIT MU; // Offset in memory model
typedef unsigned long UL; // All memory calculations are done as this
#define BMU sizeof(MUNIT) // Bytes in memory unit
#define bMU BMU*8 // Bits in memory unit
#define MMU ((unsigned MUNIT)0xffffffff) // Value used as a null pointer in memory model as it is impossible to reach it with the given minimum memory size
#define systemBitsWidth sizeof(long)*8 // Maximum bit width of an address on this system
#define MemoryMinimumSize 2 // Minimum log2 size of a memory block
/*
------------------------------------------------------------------------
Objects in memory
------------------------------------------------------------------------
*/
enum
{ObjectTypeAny, ObjectTypeString, ObjectTypeHashKey,
ObjectTypeArray, ObjectTypeHash, ObjectTypeSpona};
/*
------------------------------------------------------------------------
Logging mode
------------------------------------------------------------------------
*/
enum {LogNormal, LogSave, LogRollBack, LogCommit } logMode;
/*
------------------------------------------------------------------------
Memory Structure
Functions that cannot change the size of the memory structure, get M*,
functions that can change its size, get M**.
------------------------------------------------------------------------
*/
typedef struct M
{char signature[64]; // Signature
MU free[bMU+1]; // Free address chains
MU objectNumber; // Next object number
MU centralVector; // Central vector
MU centralVectorX; // Number of objects that can be stored in CVT at the moment
MU spona; // Spare object number array
MU hashST; // String Hash Table
MU hashSTX; // Number of buckets in the hash string table at the moment
MU GAH; // Global Hash or Array
MU length; // Log2 length of memory structure
MU lastArrayElement; // Last Array element got, simplifies testing
MU lastFoundHashElement; // Last Hash element got, simplifies testing
MU lastObjectFreed; // Last object freed, - allows objects with zero reference count to survive movement from one array/hash to another
MU logMode; // Logging mode
MU log; // Array used to log units of work
MU DD; // Array used to hold delayed deletes while in logSave mode
MU transaction; // Transaction number
HANDLE fileHandle; // Handle to backing file
HANDLE mapHandle; // Handle to mapping
MU allocatedBytes; // Bytes allocated for this structure
MU fileBacked; // 0 - not file backed, 1 - file backed
MU spare[100]; // Spare fields
char file[PAGESIZE - 64 - 118*sizeof(MU) - 2 * sizeof(HANDLE)]; // File name which pads us out to one page
UCHAR array[0]; // Memory structure
} M;
/*
------------------------------------------------------------------------
Object
------------------------------------------------------------------------
*/
typedef struct O
{UCHAR MAC; // Log2(memory block size)
UCHAR type; // Object type
MU referenceCount; // Reference count
MU number; // Object number
UCHAR array[0]; // Object data
} O;
/*
------------------------------------------------------------------------
Central vector table
------------------------------------------------------------------------
*/
typedef struct CVT
{O o; // Object
MU array[0]; // Object offsets for even entries, 2*index+1 = odd for spona entries
} CVT;
/*
------------------------------------------------------------------------
Spare Object Number Array - the spona
------------------------------------------------------------------------
*/
typedef struct SP
{UCHAR MAC; // Allocation size
MU count; // Number of objects on Spona
MU extent; // Number of objects Spona can hold
MU array[0]; // Object numbers
} SP;
/*
------------------------------------------------------------------------
String
------------------------------------------------------------------------
*/
typedef struct String
{O o; // Object
MU length; // Length of string
char array[0]; // String contents
} String;
/*
------------------------------------------------------------------------
Array
------------------------------------------------------------------------
*/
typedef struct Array
{O o; // Object
MU blessed; // Blessing string number
MU l; // Low bound of array
MU h; // High bound of array
MU array[0]; // Array elements
} Array;
/*
------------------------------------------------------------------------
Hash
The Hash String table uses the data field of struct HashElement to save
the hash value of the string. Normally this field is used to hold the
object number of the object stored in the hash at this key.
The current offset and extents of the HashST are stored in the memory
structure header.
------------------------------------------------------------------------
*/
typedef struct HashKey
{O o; // Object
MU length; // Length of string
char array[0]; // String
} HashKey;
typedef struct HashElement
{MU key; // Hash key pointer
MU data; // Hash data pointer
MU path; // hash path length
} HashElement;
typedef struct Hash
{O o; // Object
MU blessed; // Blessing string number
MU count; // Elements active in hash
MU maxPath; // Maximum path length in hash
MU iterator; // Iterator for this hash
HashElement array[0]; // Hash elements
} Hash;
/*
-----------------------------------------------------------------------
Prototypes
-----------------------------------------------------------------------
*/
Array *addressArray (M **m, UL o);
Hash *addressHash (M **m, UL o);
HashKey *addressHashKey (M **m, UL o);
String *addressString (M **m, UL o);
UL allocArray (M **m);
M **allocMemoryArea (UL l);
M *allocMemoryAreaBase (UL l);
M ** allocPagedMemoryArea (char *f);
long arrayMax (M **m, UL o);
void cleanUp (M **m);
void clearArray (M **m, UL a);
void dcv (M **m, FILE *f);
void decReferenceCount (M **m, UL n);
UL deleteHashKeyByIndex (M **m, UL H, UL k);
void dumpArea (M **m, char *F);
void freeArray (M **m, UL a);
void freeArrayObject (M **m, UL o);
void freeHashObject (M **m, UL o);
void freeHashSTKey (M **m, UL o);
void freeMemoryArea (M **m);
void freeNothing (M **m, UL o);
void freeObject (M **m, UL o);
UL getArray (M **m, UL a, long i);
UL getArraySize (M **m, UL o);
UL getArraySizeFromAddress(Array *a);
UL getHashBuckets (M **m, UL H);
UL getHashBucketsObject (M **m, UL H);
UL getObject (M **m, UL o);
UL getObjectNumber (M *m, UL p);
UL getObjectOffset (M **m, UL o);
UL getObjectType (M **m, UL n);
UL getObjectReferenceCount(M **m, UL n);
void getStringContents (M **m, UL n, char *b, UL l);
void incReferenceCount (M **m, UL n);
UL popSP (M **m);
void pushArray (M **m, UL a, UL o);
void putHashByIndex (M **m, UL H, UL k, UL D);
void putSP (M **m, UL o);
void putArray (M **m, UL a, long i, UL v);
void putArrayNanO (M **m, UL a, long i, UL v);
void rollback (M **m);
void saveArrayBless (M **m, UL o, UL b);
void saveHashBless (M **m, UL o, UL b);
void setArraySize (M **m, UL a, long i);
void setObjectPointer (M **m, UL o, UL p);
void setUpHashST (M **m);
UL shiftArray (M **m, UL a);
void shrinkHash (M **m, UL H);
void shrinkHashST (M **m);
UL sizeOfBackingFile (UL l);
void unshiftArray (M **m, UL a, UL v);
void zeroReferenceCount (M **m, UL o);
/*
######################################################################
# Debugging
######################################################################
*/
#define debug 0 // Tracing: -1 calls, 1 returns, 2 all
#define debugMemory 1 // 0 - no fill memory, 1 - fill memory with special values
#define collectInstrumentation 1 // 0 - none, 1 - collect
long debugLine = 0; // Debug output line
long debugIndent = 0; // Indentation for output
void dd(long line) // Indent debugging info
{long i, n = debugIndent * 2;
++debugLine;
fprintf(stderr, "%5u ", line);
for(i = 0; i < n; ++i)
{fprintf(stderr, " ");
}
fprintf(stderr, "%u ", line);
}
void ds() // Start block
{++debugIndent;
}
void dr() // Return from block
{--debugIndent;
}
long lines[10000];
void instrumentation(long line) // Collect instrumentation
{if (collectInstrumentation) {++lines[line];}
}
void instrumentationDump() // Dump instrumentation
{if (collectInstrumentation == 0) {return;}
FILE *f = fopen("instrumentation/run.data", "w");
UL i;
for(i = 0; i < sizeof(lines)/sizeof(long); ++i)
{if (lines[i] == 0) {continue;}
fprintf(f, "%5d %6d\n", i, lines[i]);
}
fclose(f);
}
/*
######################################################################
# Virtual Memory management for Windows
######################################################################
*/
/*
------------------------------------------------------------------------
Error messages
------------------------------------------------------------------------
*/
void windowsError(char *title)
{
DWORD e = GetLastError(); // Get error
SetLastError(0); // Clear error
if (e == 0) {return;} // Return if clear
char b[1024]; // Message buffer
size_t sb = sizeof(b); // Size of message buffer
DWORD format_flags = FORMAT_MESSAGE_FROM_SYSTEM;
int length = FormatMessage(format_flags, NULL, e, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), b, sb, NULL);
fprintf(stderr, "Windows reports error: %s %d %s\n", title, e, b);
//croak("Windows reports error: %s %d %s\n", title, e, b);
}
/*
------------------------------------------------------------------------
Page size
------------------------------------------------------------------------
*/
long pageSize(void)
{SYSTEM_INFO info;
GetSystemInfo(&info);
windowsError("PageSize");
DWORD pageSize = info.dwPageSize;
printf("pageSize=%d\n", pageSize);
pageSize;
}
/*
------------------------------------------------------------------------
Open file
------------------------------------------------------------------------
*/
HANDLE createFile(char *f, UL *x)
{
HANDLE fh = CreateFile(f, 3, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
long e = GetLastError();
if (e == 3) // Cannot create file
{croak("Cannot create file %s, do you need to create the path?", f);
}
if (e == 183) {*x = 1; SetLastError(0);} // File exists
else {windowsError("CreateFile");}
return fh;
}
/*
------------------------------------------------------------------------
File size
------------------------------------------------------------------------
*/
long fileSize(HANDLE fh)
{DWORD size = 0;
DWORD rc = GetFileSize(fh, &size);
windowsError("fileSize");
printf("rc=%d size=%d\n", rc, size);
return size;
}
/*
------------------------------------------------------------------------
Read file
------------------------------------------------------------------------
*/
void readFile(HANDLE fh)
{char a[1000];
DWORD read;
DWORD rc = ReadFile(fh, a, sizeof(a), &read, NULL);
windowsError("readFile");
printf("rc=%d read=%d a=%s\n", rc, read, a);
}
/*
------------------------------------------------------------------------
Create File Mapping
------------------------------------------------------------------------
*/
HANDLE createFileMapping(HANDLE fh, long s)
{
HANDLE m = CreateFileMapping(fh, NULL, PAGE_READWRITE, 0, s, NULL);
if (m == 0) {windowsError("CreateFileMapping");}
return m;
}
/*
------------------------------------------------------------------------
Map view of file
------------------------------------------------------------------------
*/
void *mapViewOfFile(HANDLE fh, long s)
{
void *m = MapViewOfFile(fh, FILE_MAP_WRITE, 0, 0, s);
if (m == 0) {windowsError("mapViewOfFile");}
return m;
}
/*
------------------------------------------------------------------------
Unmap view of file
------------------------------------------------------------------------
*/
void unmapViewOfFile(void *a)
{
UL e = UnmapViewOfFile(a);
if (e == 0) {windowsError("unmapViewOfFile");;}
}
/*
------------------------------------------------------------------------
Flush view of file
------------------------------------------------------------------------
*/
void flushViewOfFile(void *a)
{
UL e = FlushViewOfFile(a, 0);
if (e == 0) {windowsError("flushViewOfFile");}
}
/*
------------------------------------------------------------------------
Close file mapping handle
------------------------------------------------------------------------
*/
void closeFileMappingHandle(HANDLE h)
{
long e = CloseHandle(h);
if (e == 0) {windowsError("closeFileMappingHandle");}
}
/*
------------------------------------------------------------------------
Close file handle
------------------------------------------------------------------------
*/
void closeFileHandle(HANDLE h)
{
long e = CloseHandle(h);
if (e == 0) {windowsError("closeFileHandle");}
}
/*
######################################################################
# Memory management
######################################################################
*/
/*
------------------------------------------------------------------------
Check memory area size
------------------------------------------------------------------------
*/
void checkAllocSize(UL l)
{
if (l > bMU)
{croak("Log2(requested memory block size %u) larger than upper limit of %u", l, bMU);
}
if (l < MemoryMinimumSize)
{croak("Log2(requested memory block size %u) less than minimum block size %u", l, MemoryMinimumSize);
}
}
/*
-----------------------------------------------------------------------
Get actual address in memory of offset in memory structure
-----------------------------------------------------------------------
*/
void *am(M *m, UL a)
{if (a >= (1<<m->length))
{croak("Offset %u is outside memory structure with current length %u", a, m->length);
}
return (void *)&(m->array[a]);
}
/*---------------------------------------------------------------------
Set memory at offset a in memory structure
-----------------------------------------------------------------------
*/
void setMemory(M *m, UL a, int v, long l)
{
memset(am(m, a), v, l);
}
/*
-----------------------------------------------------------------------
Clear memory at offset a in memory structure m for length l
-----------------------------------------------------------------------
*/
void clearMemory(M *m, UL a, long l)
{
memset(am(m,a), 0, l);
}
/*
-----------------------------------------------------------------------
Get the log2(length of an allocation)
-----------------------------------------------------------------------
*/
UL getAllocLength(M *m, UL a)
{
O *o = am(m, a);
UL l = o->MAC;
checkAllocSize(l);
return o->MAC;
}
/*
-----------------------------------------------------------------------
Set the log2(length of an allocation)
-----------------------------------------------------------------------
*/
void setAllocLength(M *m, UL a, UL l)
{
O *o = am(m, a);
o->MAC = l;
}
/*
-----------------------------------------------------------------------
Set free address. If debugging, the memory is set to an unlikely value
to assist dump reading.
-----------------------------------------------------------------------
*/
void setFreeAddress (M *m, UL a, UL l)
{
m->free[l] = a;
if (debugMemory)
{long L = 1; L = L<<l;
if (l < 16) {setMemory(m, a, (int)(240+l), L);}
else {setMemory(m, a, (int)(224+l), L);}
}
}
/*
-----------------------------------------------------------------------
Set free address - but without clearing the memory area
-----------------------------------------------------------------------
*/
void setFreeAddress2(M *m, UL a, UL l)
{
m->free[l] = a;
}
/*
-----------------------------------------------------------------------
Clear free address
-----------------------------------------------------------------------
*/
void clearFreeAddress(M *m, UL l)
{
m->free[l] = MMU;
}
/*
-----------------------------------------------------------------------
Get free address
-----------------------------------------------------------------------
*/
UL getFreeAddress(M *m, UL l)
{
UL a = m->free[l];
return a;
}
/*
-----------------------------------------------------------------------
Get Log2(largest free block) of memory still free, or return 0
-----------------------------------------------------------------------
*/
UL getLargestFree(M *m)
{
UL i;
for(i = bMU; i >= MemoryMinimumSize; --i)
{UL a = m->free[i];
if (a < MMU)
{
return i;
}
}
return 0;
}
/*
-----------------------------------------------------------------------
Number of bits required to hold a number
-----------------------------------------------------------------------
*/
UL bits(UL n)
{
UL i, j = 1;
for(i = 0; j < n && i < sizeof(n)*8; ++i, j *= 2) {}
return i;
}
/*
-----------------------------------------------------------------------
Grow memory
-----------------------------------------------------------------------
*/
void growMemory(M **m, UL l)
{
if ((*m)->fileBacked > 0) // Backed with a file
{
char f[1024];
strcpy(f, (*m)->file); // Save file name
freeMemoryArea(m); // Writes out backing file
HANDLE fh, vh; M *n; UL e = 0;
UL s = sizeOfBackingFile(l); // Size of file
fh = createFile(f, &e); // Open backing file
vh = createFileMapping(fh, s); // Reopen with new size
n = mapViewOfFile(vh, s); // View file
n->length = l; // Update length
n->allocatedBytes = s; // Update allocated bytes
*m = n;
}
// Not backed with a file
else
{
M *n = allocMemoryAreaBase(l); // Alloc new area or die
long L = 1<<((*m)->length < l ? (*m)->length : l); // Minimum size
memcpy(n, *m, sizeof(struct M) + L); // Copy old area
n->length = l; // Set new length
free(*m); // Free old area
*m = n; // Address new area
}
}
/*
------------------------------------------------------------------------
Initialize Memory Area
------------------------------------------------------------------------
*/
void initializeMemoryArea(M *m, UL l)
{
strcpy(m->signature, "DBMDeepBlue32 Copyright: PhilipRBrenan at gmail dot com, 2010"); // Set signature
m->length = l; // Set free block offsets
{long i;
for(i = 0; i <= bMU; ++i)
{m->free[i] = MMU;
}
}
m->free[l] = 0; // Initial free space
m->objectNumber = m->lastObjectFreed = m->GAH = 0; // Offsets to sub structures
m->centralVector = m->hashST = m->spona = MMU;
m->lastArrayElement = m->lastFoundHashElement = 0; // Simplifies testing
m->centralVectorX = m->hashSTX = 0;
m->logMode = LogNormal; // Logging
m->DD = m->log = 0;
m->fileBacked = 0; // Not file backed
m->transaction = 0; // TRansaction should always be zero in a non file backed mode
}
/*
------------------------------------------------------------------------
Allocate Memory Area Base - this gets the memory area but does no
initialization.
------------------------------------------------------------------------
*/
M *allocMemoryAreaBase(UL l)
{
if (l > bMU)
{croak("Cannot allocate more memory in this memory model to satisfy request for 2**%u bytes", l);
}
UL mL = sizeof(struct M) + (1<<l); // Size of memory
M *m = malloc(mL); // Allocate memory
if (m == 0)
{croak("Malloc failed to allocate 2**%u bytes", l);
}
memset(m, 0, sizeof(struct M)); // Clear memory
if (debugMemory) {memset(&(m->array), 240+l, 1<<l);} // Mark free area to simplify debugging
m->allocatedBytes = mL; // Save allocation size
return m;
}
/*
------------------------------------------------------------------------
Allocate Memory Area - users should call this function to allocate a
memory area not backed by a file.
------------------------------------------------------------------------
*/
M **allocMemoryArea(UL l)
{
M *m = allocMemoryAreaBase(l);
initializeMemoryArea(m, l); // Initialize the memory area
M **mm = malloc(sizeof(struct M *)); // Indirection to allow area to grow/shrink
*mm = m;
return mm;
}
/*
------------------------------------------------------------------------
Compute size of backing file
------------------------------------------------------------------------
*/
UL sizeOfBackingFile(UL l)
{
UL s = (1<<l)+sizeof(struct M)+PAGESIZE; // Size of allocation
return s;
}
/*
------------------------------------------------------------------------
Allocate file backed memory area - users should call this function
to allocate a memory area backed by a file.
If we the user is opening the file, l will be 0, else if growMemory()
is the caller, l will have the log2(size) required.
------------------------------------------------------------------------
*/
M **allocPagedMemoryArea(char *f)
{
UL e = 0; // Backing file existance
HANDLE fh = createFile(f, &e); // Open backing file
HANDLE vh; // File mapping handle
M *m; // Memory structure
if (e) // File exists, user is opening it
{
UL s = PAGESIZE; // Minimum size
vh = createFileMapping(fh, s); // Map file
m = mapViewOfFile(vh, s); // View file
UL S = m->allocatedBytes; // size of file
unmapViewOfFile(m); // Unmap file
closeFileMappingHandle(vh); // Close file mapping
vh = createFileMapping(fh, S); // Reopen at full size
m = mapViewOfFile(vh, S); // View file full size
if (m->logMode == LogSave) {rollback(&m);} // Rollback any uncommited changes
m->transaction++; // Transaction number
}
else
{
UL l = 10; // Default size of allocation - it can grow
UL s = sizeOfBackingFile(l); // Bytes in default allocation
vh = createFileMapping(fh, s); // Map file
m = mapViewOfFile(vh, s); // View file
m->allocatedBytes = s; // Allocated bytes
m->transaction = 0; // Count transactions
strcpy(m->file, f); // Copy in file name
initializeMemoryArea(m, l); // Initialize memory
}
m->fileBacked = 1; // File backed
m->fileHandle = fh; // File handle
m->mapHandle = vh; // map handle
M **mm = malloc(sizeof(struct M *)); // Indirection pointer
*mm = m; // Set indirection
return mm; // One level of indirection
}
/*
------------------------------------------------------------------------
Free Memory Area
------------------------------------------------------------------------
*/
void freeMemoryArea(M **mm)
{
M *m = *mm;
// free(mm); // Free indirection pointer - this needs to be checked as it causes a SEGV, however like this the memory leak is small.
if (m->fileBacked == 0) // Non file backed
{
free(m); // Free pointer to memory structure
}
else // File backed
{
HANDLE fh = m->fileHandle; // File handle of backing file
HANDLE vh = m->mapHandle; // Handle for mapping
flushViewOfFile(m); // Write pages to file
unmapViewOfFile(m); // Unmap file
closeFileMappingHandle(vh); // Close file mapping
closeFileHandle(fh); // Close file
}
}
/*
------------------------------------------------------------------------
Allocate a block of memory, size is specified as log2
------------------------------------------------------------------------
*/
UL allocMemory(M **m, UL l)
{
UL a;
// Die if request is too big
if (l > bMU || l >= systemBitsWidth)
{croak("Allocation request %u too big for memory model 2", l);
}
// Find a suitable block
{UL L = 0;
UL i;
for(i = l; i <= bMU; ++i)
{a = getFreeAddress(*m, i);
if (a < MMU)
{L = i;
clearFreeAddress(*m, L);
break;
}
}
// Die if we are too close to the end of memory
if (L && a > 0xffffffff - sizeof(**m))
{croak("Out of memory");
}
// Allocate more memory if necessary and retry allocation
if (L == 0)
{UL b = (*m)->length;
if (!(b < sizeof(l)*8 && l < sizeof(l)*8))
{croak("Out of memory in memory model 2");
}
if (l <= b) // Double block
{long L = 1<<b; // Size of current memory
long L1 = L<<1; // Double size of current memory
growMemory(m, b+1); // Allocate and copy
if (getFreeAddress(*m, b) == 0) // All of memory is free
{ setFreeAddress(*m, 0, b+1);
clearFreeAddress(*m, b);
}
else
{ setFreeAddress(*m, L, b); // Allocated memory is free
clearFreeAddress(*m, b+1); // rest remains as it was
}
return allocMemory(m, l); // Retry allocation
}
else // More than double block
{
growMemory(m, l+1); // Allocate and copy
if (getFreeAddress(*m, b) == 0) // All of memory is free
{ setFreeAddress(*m, 0, l+1);
clearFreeAddress(*m, b);
}
else
{UL i;
for(i = b; i <= l; ++i) // Split new down to old
{setFreeAddress(*m, 1<<i, i);
}
clearFreeAddress(*m, l+1); // Some memory was in use
}
return allocMemory(m, l);
}
}
// Split intermediate blocks of located block
else if (L > l)
{UL i;
for(i = l; i < L; ++i)
{
setFreeAddress(*m, a + (1<<i), i);
}
}
}
// Format memory allocation control byte and clear memoru block ready for use
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;
growMemory(m, B2);
}
// Shrink from bottom
else if (B > MemoryMinimumSize && getFreeAddress(*m, B1) == 0)
{
clearFreeAddress(*m, B1);
allocCopy(m, 1<<(B1), 0, B1);
growMemory(m, B1);
}
// Shrink empty memory
else if (B > MemoryMinimumSize && getFreeAddress(*m, B) == 0)
{
clearFreeAddress(*m, B);
setFreeAddress(*m, 0, MemoryMinimumSize);
growMemory(m, MemoryMinimumSize);
}
// Failed to shrink
else
{
}
}
/*
------------------------------------------------------------------------
Free memory area
------------------------------------------------------------------------
*/
void freeMemory2(M **m, UL a, UL l)
{
if (l == 0) {l = getAllocLength(*m, a);}
// Other free block of same size
UL b = getFreeAddress(*m, l);
// Check alignment as a way of stopping bad free attempts
if (a % (1<<l) != 0)
{croak("Misaligned memory free address=%u, size=%u", a, l);
}
// Free directly if no other block waiting
if (b == MMU)
{setFreeAddress(*m, a, l);
shrinkMemory(m);
return;
}
// Fuse b to make a bigger block
clearFreeAddress(*m, l);
// Fuse with already freed paired block above
UL ap = getAllocPosition(a, l);
UL bp = getAllocPosition(b, l);
if (ap == 0 && bp == 1 && b == a + (1<<l))
{
freeMemory2(m, a, l+1);
return;
}
// Fuse with already freed paired block below
if (ap == 1 && bp == 0 && a == b + (1<<l))
{
freeMemory2(m, b, l+1);
return;
}
// Relocate the twin of a to b to liberate higher memory
if (b < a)
{UL f = a;
if (getAllocPosition(a, l))
{
f -= 1<<l;
allocCopy(m, f, b, l); // f is now free and below a
freeMemory2(m, f, l+1);
}
else
{
f += 1<<l;
allocCopy(m, f, b, l); // f is now free and above a
freeMemory2(m, a, l+1);
}
return;
}
// Relocate b's twin to a to liberate higher memory
{UL f = b;
if (getAllocPosition(b, l))
{
f -= 1<<l;
allocCopy(m, f, a, l); // f is now free and below b
freeMemory2(m, f, l+1);
}
else
{
f += 1<<l;
allocCopy(m, f, a, l); // f is now free and above b
freeMemory2(m, b, l+1);
}
return;
}
}
void freeMemory(M **m, UL a)
{freeMemory2(m, a, 0);
}
/*
------------------------------------------------------------------------
Maps the value of MMU to -1 for printing as it makes dumps more readable
------------------------------------------------------------------------
*/
long nmi(UL a)
{if (a == MMU) {return -1;}
return a;
}
/*
------------------------------------------------------------------------
Dump memory area
------------------------------------------------------------------------
*/
void dumpArea(M **mm, char *F)
{
M *m = *mm;
FILE *f;
{char b[1024]; memset(b, 0, sizeof(b));
mkdir("out", 0);
sprintf(b, "out\\%d", sizeof(MU));
mkdir(b, 0);
sprintf(b, "out\\%d\\%s.data", sizeof(MU), F);
f = fopen(b, "w");
}
fprintf(f, "Memory:\n");
fprintf(f, " ObjectNumber=%u centralVector=%d centralVectorX=%u hashST=%d hashSTX=%u spona=%d GAH=%d transaction=%u Log2(memory length)=%u\n lastArrayElement=%u lastFoundHashElement=%u lastObjectFreed=%u\n",
m->objectNumber,
nmi(m->centralVector), m->centralVectorX,
nmi(m->hashST), m->hashSTX,
nmi(m->spona), nmi(m->GAH), m->transaction,
m->length, m->lastArrayElement, m->lastFoundHashElement, m->lastObjectFreed);
if (m->fileBacked)
{fprintf(f, " Backing file: %s\n", m->file);
}
// Free areas
{UL i, L = bMU;
for(i = 0; i <= L; ++i)
{fprintf(f, " f%u=%d", i, nmi(m->free[i]));
}
fprintf(f, "\n");
}
// Memory contents
{UL l = m->length;
if (l > bMU)
{croak("Memory block %u too big", l);
}
long i;
long L = 1<<l;
for(i = 0; i < L; ++i)
{if (i % 4 == 0) {fprintf(f, " ");}
if (i % 8 == 0) {fprintf(f, " ");}
fprintf(f, "%02x", m->array[i]);
if (i % 64 == 63) {fprintf(f, "\n");}
}
fprintf(f, "\n\n");
}
// Spona
{if (m->spona < MMU)
{SP *S = am(m, m->spona);
fprintf(f, "Spona offset=%u count=%u extent=%u\n", (*mm)->spona, S->count, S->extent);
long i;
for(i = 0; i < S->count; ++i)
{fprintf(f, "%d ", S->array[i]);
}
}
fprintf(f, "\n\n");
}
// CVT
fflush(f);
if (m->centralVector != MMU) {dcv(mm, f);}
fclose(f);
}
void ddd(M **m)
{dumpArea(m, "zz");
}
/*
#######################################################################
# Logging
#######################################################################
*/
enum
{ActionSetGAH,
ActionPutArray,
ActionSetArraySize,
ActionExtendArray,
ActionClearArray,
ActionPopArray,
ActionShiftArray,
ActionUnshiftArray,
ActionPutIHash,
ActionPutRUHash, ActionPutRDHash,
ActionDeleteDHash, ActionDeleteUHash,
ActionSaveArrayRBless, ActionSaveArrayFBless,
ActionSaveHashRBless, ActionSaveHashFBless,
} saveActions;
/*
-----------------------------------------------------------------------
Get object number of log array - create if not present
The log is used to record user requests that change the relationships
between the objects stored in the memory structure that occur between
begin_work() and rollback(I) or commit().
If the actions are committed via commit(), the log is deleted. If the
actions are rolled back via rollback(), the information in this array is
used to undo the changes made by the user since begin_work() was called.
-----------------------------------------------------------------------
*/
UL getLog(M **m)
{
if ((*m)->log > 0) // Return log if it exists
{
return (*m)->log;
}
UL l = allocArray(m); // Allocate log if it does not exist
(*m)->log = l; // Save log
return l;
}
/*
-----------------------------------------------------------------------
Get object number of delayed delete array - create if not present
The delayed delete array is used to record user requests for the
deletion of objects stored in the memory structure that occur between
begin_work() and rollback(I) or commit().
If the actions are committed via commit(), the deletes areprocessed. If
the actions are rolled back via rollback(), these objects are not
deleted.
-----------------------------------------------------------------------
*/
UL getDD(M **m)
{
if ((*m)->DD > 0) // Return DD if it exists
{
return (*m)->DD;
}
UL d = allocArray(m); // Allocate DD if it does not exist
(*m)->DD = d; // Save DD
return d;
}
/*
-----------------------------------------------------------------------
Start work
-----------------------------------------------------------------------
*/
void begin_work(M **m)
{
getLog(m); // Create log
getDD(m); // Create delayed deletes
(*m)->logMode = LogSave; // Start saving user actions
}
/*
-----------------------------------------------------------------------
Nullify array
The arrays log and DD used for logging contain un refernce counted
refernces to objects in the memory structure. To free these arrays, each
element is set to zero, and then the array can be freed as normal.
-----------------------------------------------------------------------
*/
void nullifyArray(M **m, UL a)
{
long i, j = getArraySize(m, a);
for(i = 0; i < j; ++i)
{putArrayNanO(m, a, i, 0); // Nullify element
}
clearArray(m, a);
freeArray (m, a); // Free array now that it contains no references
}
/*
-----------------------------------------------------------------------
Rollback setGAH
-----------------------------------------------------------------------
*/
void rbSetGAH(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL g = A->array[--A->h]; // Previous value
(*m)->GAH = g; // Reset GAH
}
/*
-----------------------------------------------------------------------
Rollback setArraySize
-----------------------------------------------------------------------
*/
void rbSetArraySize(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL a = A->array[--A->h]; // Array
UL s = A->array[--A->h]; // Previous value
setArraySize(m, a, s); // Reset array size
}
/*
-----------------------------------------------------------------------
Rollback extendArray
-----------------------------------------------------------------------
*/
void rbExtendArray(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL a = A->array[--A->h]; // Array
UL n = A->array[--A->h]; // Previous maximum size
//shrinkArray(m, a);
}
/*
-----------------------------------------------------------------------
Rollback clearArray
-----------------------------------------------------------------------
*/
void rbClearArray(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL a = A->array[--A->h]; // Array
UL s = A->array[--A->h]; // Previous value
setArraySize(m, a, s); // Reset array size
}
/*
-----------------------------------------------------------------------
Rollback putArray
-----------------------------------------------------------------------
*/
void rbPutArray(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL a = A->array[--A->h]; // Array
UL i = A->array[--A->h]; // Index
UL e = A->array[--A->h]; // Old value
putArray(m, a, i, e); // Restore old value
}
/*
-----------------------------------------------------------------------
Rollback popArray
-----------------------------------------------------------------------
*/
void rbPopArray(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL a = A->array[--A->h]; // Array
UL v = A->array[--A->h]; // Value popped
pushArray(m, a, v); // Restore old value
}
/*
-----------------------------------------------------------------------
Rollback shiftArray
-----------------------------------------------------------------------
*/
void rbShiftArray(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL a = A->array[--A->h]; // Array
UL v = A->array[--A->h]; // Value shifted
unshiftArray(m, a, v); // Restore old value
}
/*
-----------------------------------------------------------------------
Rollback unshiftArray
-----------------------------------------------------------------------
*/
void rbUnshiftArray(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL a = A->array[--A->h]; // Array
shiftArray(m, a); // Restore old value
}
/*
-----------------------------------------------------------------------
Rollback insert new value
-----------------------------------------------------------------------
*/
void rbPutIHash(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL h = A->array[--A->h]; // Hash
UL k = A->array[--A->h]; // Key
deleteHashKeyByIndex(m, h, k); // Delete inserted value
}
/*
-----------------------------------------------------------------------
Rollback replace undefined value
-----------------------------------------------------------------------
*/
void rbPutRUHash(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL h = A->array[--A->h]; // Hash
UL k = A->array[--A->h]; // Key
putHashByIndex(m, h, k, 0); // Undefine data
}
/*
-----------------------------------------------------------------------
Rollback replace defined value
-----------------------------------------------------------------------
*/
void rbPutRDHash(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL h = A->array[--A->h]; // Hash
UL k = A->array[--A->h]; // Key
UL d = A->array[--A->h]; // Data replaced
putHashByIndex(m, h, k, d); // Reset data to previous value
}
/*
-----------------------------------------------------------------------
Rollback delete of key with undefined data
-----------------------------------------------------------------------
*/
void rbDeleteUHash(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL h = A->array[--A->h]; // Hash
UL k = A->array[--A->h]; // Key
putHashByIndex(m, h, k, 0); // Restore old value
}
/*
-----------------------------------------------------------------------
Rollback delete of key with defined data
-----------------------------------------------------------------------
*/
void rbDeleteDHash(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL h = A->array[--A->h]; // Hash
UL k = A->array[--A->h]; // Key
UL d = A->array[--A->h]; // Data
putHashByIndex(m, h, k, d); // Restore old value
}
/*
-----------------------------------------------------------------------
Rollback bless of array that was already blessed
-----------------------------------------------------------------------
*/
void rbSaveArrayRBless(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL a = A->array[--A->h]; // Array
UL o = A->array[--A->h]; // Old blessing hash key
saveArrayBless(m, a, o); // Restore old value
}
/*
-----------------------------------------------------------------------
Rollback bless of array that was not already blessed
-----------------------------------------------------------------------
*/
void rbSaveArrayFBless(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL a = A->array[--A->h]; // Array
saveArrayBless(m, a, 0); // Restore old value
}
/*
-----------------------------------------------------------------------
Rollback bless of hash that was already blessed
-----------------------------------------------------------------------
*/
void rbSaveHashRBless(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL h = A->array[--A->h]; // Hash
UL o = A->array[--A->h]; // Old blessing hash key
saveHashBless(m, h, o); // Restore old value
}
/*
-----------------------------------------------------------------------
Rollback bless of hash that was not already blessed
-----------------------------------------------------------------------
*/
void rbSaveHashFBless(M **m)
{
UL l = getLog(m); // Address log
Array *A = addressArray(m, l); // Address log array
UL h = A->array[--A->h]; // Hash
saveHashBless(m, h, 0); // Restore old value
}
/*
-----------------------------------------------------------------------
Roll Back one action
-----------------------------------------------------------------------
*/
void rollback1(M **m)
{
UL l = getLog(m); // Addresse log
UL s = (*m)->logMode; // Save logging mode
(*m)->logMode = LogRollBack; // Stop saving user actions
Array *A = addressArray(m, l);
UL a = A->array[--A->h]; // Action to roll back
void (*f[])(M **m) =
{&rbSetGAH, &rbPutArray, &rbSetArraySize, &rbExtendArray, &rbClearArray, &rbPopArray, &rbShiftArray, &rbUnshiftArray,
&rbPutIHash, &rbPutRUHash, &rbPutRDHash, &rbDeleteDHash, &rbDeleteUHash,
&rbSaveArrayRBless, &rbSaveArrayFBless,
&rbSaveHashRBless, &rbSaveHashFBless,
};
f[a](m);
(*m)->logMode = s; // Restore saved logging mode
}
/*
-----------------------------------------------------------------------
Roll Back
The delayed deletes array is nullified, while the log array is processed
in reverse order to undo the users actions.
-----------------------------------------------------------------------
*/
void rollback(M **m)
{
UL l = getLog(m); // Create log
UL d = getDD(m); // Create delayed deletes
(*m)->logMode = LogRollBack; // Stop saving user actions
nullifyArray(m, d); // Nullify deletes
long i; // Undo user actions
for(;getArraySize(m, l) > 0;)
{rollback1(m);
}
nullifyArray(m, l); // Nullify log
(*m)->logMode = LogNormal; // Resume normal logging
}
/*
-----------------------------------------------------------------------
Commit
The log array is nullified and the pending deletes in the delayed
deletes array is are executed.
-----------------------------------------------------------------------
*/
void commit(M **m)
{
UL l = getLog(m); // Create log
UL d = getDD(m); // Create delayed deletes
(*m)->logMode = LogRollBack; // Stop saving user actions
nullifyArray(m, l); // Nullify log
{long i; // Execute deletes
long j = getArraySize(m, d); // Number of deletes
for(i = 0; i < j; ++i) // Each delete
{UL o = getArray(m, d, i); // Get delete
freeObject(m, o); // Execute delete
}
nullifyArray(m, d); // Nullify deletes
}
(*m)->logMode = LogNormal; // Resume normal logging
}
/*
-----------------------------------------------------------------------
Delete Log entry
-----------------------------------------------------------------------
*/
void saveDelete(M **m, UL o)
{
if ((*m)->logMode == LogSave)
{UL d = getDD(m);
UL s = getArraySize(m, d);
putArrayNanO(m, d, s, o); // Save delete request in log
}
return;
}
/*
-----------------------------------------------------------------------
Log entry
-----------------------------------------------------------------------
*/
//void saveLog1(UL a, M **m)
// {sTART saveLog1 "action=%u", a
// if ((*m)->logMode == LogSave)
// {UL l = getLog(m);
// UL s = getArraySize(m, l);
// putArrayNanO(m, l, s, a); // Save action in log
// }
// rETURN
// return;
// }
void saveLog2(UL a, M **m, UL o)
{
if ((*m)->logMode == LogSave)
{UL l = getLog(m);
UL s = getArraySize(m, l);
putArrayNanO(m, l, s, o); // Save object in log
putArrayNanO(m, l, s+1, a); // Save action in log
}
return;
}
void saveLog3(UL a, M **m, UL o, UL i)
{
if ((*m)->logMode == LogSave)
{UL l = getLog(m);
UL s = getArraySize(m, l);
putArrayNanO(m, l, s, i); // Save index in log
putArrayNanO(m, l, s+1, o); // Save object in log
putArrayNanO(m, l, s+2, a); // Save action in log
}
return;
}
void saveLog4(UL a, M **m, UL o, UL i, UL v)
{
if ((*m)->logMode == LogSave)
{UL l = getLog(m);
UL s = getArraySize(m, l);
putArrayNanO(m, l, s, v); // Save value in log
putArrayNanO(m, l, s+1, i); // Save index in log
putArrayNanO(m, l, s+2, o); // Save object in log
putArrayNanO(m, l, s+3, a); // Save action in log
}
return;
}
/*
#######################################################################
# Central Vector
#######################################################################
*/
/*
-----------------------------------------------------------------------
Address central vector
-----------------------------------------------------------------------
*/
CVT *getCV(M *m)
{
CVT *cv = am(m, m->centralVector); // Address CV
return cv;
}
/*
-----------------------------------------------------------------------
Get central vector extent required to hold next object number
-----------------------------------------------------------------------
*/
UL getCVX(M *m)
{
UL n = m->objectNumber; // Current object number
if (n == 0) {return 0;} // CVT not needed
UL s = sizeof(struct CVT) + n * sizeof(MU); // Size of CVT required
UL b = bits(s); // Log2(size)
return b;
}
/*
-----------------------------------------------------------------------
Set central vector extent - number of objects that the central vector
can currently store
l - log2(size of block containing CV)
-----------------------------------------------------------------------
*/
void setCVX(M *m, UL l)
{
checkAllocSize(l); // Check block size
UL L = 1<<l; // Size of Central Vector memory block
UL w = L - sizeof(struct CVT); // Size of area available for pointers
w -= w % sizeof(MU); // Round down
w /= sizeof(MU); // Calculate CV extent
m->centralVectorX = w; // Save
}
/*
-----------------------------------------------------------------------
Get next object number
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);
}
// Summary
{UL i;
for(i = 1; i <= W; ++i)
{UL o = getObjectOffset(m, i);
if (o % 2 == 0)
{fprintf(f, "(%u,%d) ", i, o);
}
}
fprintf(f, "\n");
}
// Contents
{UL i;
fprintf(f, "\n\n");
fprintf(f, "Object bits Refs Offset Type\n");
for(i = 1; i <= W; ++i)
{UL o = getObjectOffset(m, i);
if (o % 2 == 0)
{UL length = getAllocLength (*m, o);
UL offset = getObjectOffset (m, i);
UL oType = getObjectType (m, i);
UL refs = getObjectReferenceCount(m, i);
char *types[] = {"Any", "String", "HashKey", "Array", "Hash", "HST"};
char *type = types[oType];
if (oType == ObjectTypeHash && offset == (*m)->hashST) {type = "HashST";}
fprintf(f, " %4d %4d %4d %6d %-16s\n", i, length, refs, offset, type);
}
}
}
// Strings
{UL i;
fprintf(f, "\nStrings\n");
fprintf(f, "Number Length Data\n");
for(i = 1; i <= W; ++i)
{UL o = getObjectOffset (m, i);
if (o % 2 == 0)
{UL oType = getObjectType (m, i);
if (oType == ObjectTypeString)
{char b[128];
String *s = addressString (m, i);
getStringContents(m, i, b, sizeof(b));
fprintf(f, "%6d %5d %s\n", i, s->length, b);
}
}
}
}
// HashKeys
{UL i;
fprintf(f, "\nHash Keys\n");
fprintf(f, "Number Length Data\n");
for(i = 1; i <= W; ++i)
{UL o = getObjectOffset(m, i);
if (o % 2 == 0)
{UL oType = getObjectType(m, i);
if (oType == ObjectTypeHashKey)
{char b[128];
HashKey *k = addressHashKey(m, i);
UL sLength = k->length; if (sizeof(b)-1 < sLength) {sLength = sizeof(b)-1;}
memset(b, 0, sizeof(b));
memcpy(b, k->array, sLength);
fprintf(f, "%6d %5d %s\n", i, k->length, b);
}
}
}
}
// Arrays
{UL i;
fprintf(f, "\nArrays\n");
fprintf(f, "Number Offset Bless Low High Size Nax Contents\n");
for(i = 1; i <= W; ++i)
{UL o = getObjectOffset(m, i);
if (o % 2 == 0)
{UL oType = getObjectType (m, i);
if (oType == ObjectTypeArray)
{Array *A = addressArray (m, i);
UL p = getObjectOffset(m, i);
UL s = getArraySize (m, i);
fprintf(f, " %4d %6d %4d %4d %4d %4d %4d", i, p, A->blessed, A->l, A->h, s, arrayMax(m, i));
long j, k = 0;
for(j = 0; j < getArraySizeFromAddress(A); ++j,++k)
{UL e = getArray(m, i, j);
fprintf(f, " [%u]=%u,", k, e);
}
fprintf(f, "\n");
}
}
}
}
// Hashes
{UL i;
fprintf(f, "\nHashes\n");
fprintf(f, "Number Offset Bless Count Buckets maxPath Iter Type Contents\n");
for(i = 1; i <= W; ++i)
{UL o = getObjectOffset(m, i);
if (o % 2 == 0)
{UL oType = getObjectType (m, i);
if (oType == ObjectTypeHash)
{Hash *h = am(*m, getObjectOffset(m, i));
UL p = getObjectOffset(m, i);
UL b = getHashBuckets (m, p);
UL c = h->count;
UL mp = h->maxPath;
long it = nmi(h->iterator);
char *t = "normal"; if (p == (*m)->hashST) {t = "HashST";}
fprintf(f, " %4u %6u %4u %4u %4u %4u %4d %s ", i, p, h->blessed, c, b, mp, it, t);
long j;
for(j = 0; j < b; ++j)
{UL k = h->array[j].key;
UL p = h->array[j].path;
UL d = h->array[j].data;
if (k == 0 && p == 0) {continue;}
fprintf(f, " [%u]{%u}=(%u,%u), ", j, k, d, p);
}
fprintf(f, "\n");
}
}
}
}
}
/*
------------------------------------------------------------------------
Dump Array and Hash sizes
------------------------------------------------------------------------
*/
void dahs(M **m)
{UL V = allocCV(m); // Address CV
UL W = (*m)->centralVectorX; // Extent of CV
// Arrays
{UL i;
fprintf(stderr, "\nArrays\n");
fprintf(stderr, "Number Offset Bless Low High Size Nax\n");
for(i = 1; i <= W; ++i)
{UL o = getObjectOffset(m, i);
if (o % 2 == 0)
{UL oType = getObjectType (m, i);
if (oType == ObjectTypeArray)
{Array *A = addressArray (m, i);
UL p = getObjectOffset(m, i);
UL s = getArraySize (m, i);
fprintf(stderr, " %4d %6d %4d %4d %4d %4d %4d\n", i, p, A->blessed, A->l, A->h, s, arrayMax(m, i));
}
}
}
}
// Hashes
{UL i;
fprintf(stderr, "\nHashes\n");
fprintf(stderr, "Number Offset Bless Count Buckets maxPath Iter Type\n");
for(i = 1; i <= W; ++i)
{UL o = getObjectOffset(m, i);
if (o % 2 == 0)
{UL oType = getObjectType (m, i);
if (oType == ObjectTypeHash)
{Hash *h = am(*m, getObjectOffset(m, i));
UL p = getObjectOffset(m, i);
UL b = getHashBuckets (m, p);
UL c = h->count;
UL mp = h->maxPath;
long it = nmi(h->iterator);
char *t = "normal"; if (p == (*m)->hashST) {t = "HashST";}
fprintf(stderr, " %4u %6u %4u %4u %4u %4u %4d %s\n", i, p, h->blessed, c, b, mp, it, t);
}
}
}
}
}
/*
-----------------------------------------------------------------------
Get object type
-----------------------------------------------------------------------
*/
UL getObjectType(M **m, UL n)
{
UL p = getObject(m, n);
O *o = am(*m, p);
return o->type;
}
/*
-----------------------------------------------------------------------
Get address of global array or hash
-----------------------------------------------------------------------
*/
UL getGAH(M **m)
{
return (*m)->GAH;
}
/*
-----------------------------------------------------------------------
Set address of global array or hash
-----------------------------------------------------------------------
*/
void setGAH(M **m, UL o)
{
UL e = (*m)->GAH;
saveLog2(ActionSetGAH, m, e);
if (e > 0) {decReferenceCount(m, e);}
(*m)->GAH = o;
if (o > 0) {incReferenceCount(m, o);}
}
/*
-----------------------------------------------------------------------
Get string contents
o - object number
b - buffer to copy string into
l - length of buffer
-----------------------------------------------------------------------
*/
void getStringContents(M **m, UL n, char *b, UL l)
{String *s = addressString(m, n);
UL sl = s->length; if (sl >= l) {sl = l - 1;};
memset(b, 0, l);
memcpy(b, s->array, sl);
}
/*
-----------------------------------------------------------------------
Get object reference count
o - object number
-----------------------------------------------------------------------
*/
UL getObjectReferenceCount(M **m, UL n)
{
UL p = getObject(m, n);
O *o = am(*m, p);
MU r = o->referenceCount;
return r;
}
/*
------------------------------------------------------------------------
Get object number
p - offset of object in memory structure
-----------------------------------------------------------------------
*/
UL getObjectNumber(M *m, UL p)
{O *o = am(m, p);
return o->number;
}
/*
------------------------------------------------------------------------
Set object number
p - offset in memory structure of object whose number is to be set
o - object number
-----------------------------------------------------------------------
*/
void setObjectNumber(M *m, UL p, UL n)
{O *o = am(m, p);
o->number = n;
}
/*
------------------------------------------------------------------------
Get current offset of an object with a given number via Central Vector.
o - object number
This is the same as getObjectOffset() except that checks are made to
insure that the object exists.
-----------------------------------------------------------------------
*/
UL getObject(M **m, UL o)
{
UL V = allocCV(m); // Address CV
UL W = (*m)->centralVectorX; // Extent of CV
if (o <= W)
{CVT *c = am(*m, V); // CVT
UL p = c->array[o-1]; // Current offset
if (p == MMU)
{croak("Inactive object number %u", o);
}
return p;
}
croak("Object %u outside central vector at offset %u with extent %u", o, V, W);
}
/*
------------------------------------------------------------------------
Get current offset of an object with a given number via Central Vector.
o - object number
This is the same as getObject() except that no checks are made to insure
that the object exists or is valid. This function should only be used
when it is certain that the object does in fact exist in the CV.
-----------------------------------------------------------------------
*/
UL getObjectOffset(M **m, UL o)
{UL V = allocCV(m); // Address CV
CVT *c = am(*m, V); // CV
return c->array[o-1]; // Current offset
}
/*
------------------------------------------------------------------------
Set Central Vector entry for object with this offset and number
o - number of object whose offset in the memory structure is to be
recorded ib the CVT
p - offset in memory structure of object
-----------------------------------------------------------------------
*/
void setObjectPointer(M **m, UL o, UL p)
{
UL V = allocCV(m); // Address of CV
UL W = (*m)->centralVectorX; // Objects in CV
if (o <= W)
{CVT *c = am(*m, V); // CV
c->array[o-1] = p; // Set offset in CV
return;
}
croak("CVT too small (%u) to contain object %u", W, o );
}
/*
------------------------------------------------------------------------
Update the object number of an object and set its entry in the CV.
o - object number
p - offset to object in memory structure
-----------------------------------------------------------------------
*/
void putObjectInCV(M **m, UL o, UL p)
{
setObjectNumber ( *m, p, o); // Set object number in object
setObjectPointer( m, o, p); // Save offset of object in CV by objedct number-
}
/*
------------------------------------------------------------------------
Allocate object of specified size and indeterminate type.
s - Size of storage required (does not include object prefix - it will be
added) in bytes.
Returns the number of the object created. You can convert this to the
offset of the object in the memory structure by calling getObjectOffset.
-----------------------------------------------------------------------
*/
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;
(*m)->lastObjectFreed = 0;
freeObjectImmediately(m, f);
}
}
/*
------------------------------------------------------------------------
Free object by object number
WARNING: This should only be performed for objects whose reference count
is zero (unless you are testing). No test is made on the reference count
to make sure it is zero.
-----------------------------------------------------------------------
*/
void freeObject(M **m, UL o)
{
if ((*m)->logMode == LogSave) // Logging
{saveDelete(m, o); // Save delete until commit
}
else // Not logging
{cleanUp(m);
(*m)->lastObjectFreed = o; // Free this object very soon
}
}
/*
------------------------------------------------------------------------
unfree object by object number
Recovers an object from pending free in the event that the object is
used again before the free was triggered by another object being freed.
-----------------------------------------------------------------------
*/
void unfreeObject(M **m, UL o)
{
if ((*m)->lastObjectFreed == o)
{(*m)->lastObjectFreed = 0;
}
}
/*
------------------------------------------------------------------------
Get object reference count
n - number of object whose reference count is to be got
-----------------------------------------------------------------------
*/
UL getReferenceCount(M **m, UL n)
{UL p = getObjectOffset(m, n);
O *o = am(*m, p);
return o->referenceCount;
}
/*
------------------------------------------------------------------------
Zero object reference count
n - number of object whose reference count is to be set
-----------------------------------------------------------------------
*/
void zeroReferenceCount(M **m, UL n)
{UL p = getObjectOffset(m, n);
O *o = am(*m, p);
o->referenceCount = 0;
}
/*
------------------------------------------------------------------------
Increment object reference count if possible
n - number of object whose reference count is to be incremented
------------------------------------------------------------------------
*/
void incReferenceCount(M **m, UL n)
{UL p = getObjectOffset(m, n);
O *o = am(*m, p);
if (o->referenceCount == 0) // Stop pending free if necessary
{unfreeObject(m, n);
}
o->referenceCount++;
}
/*
------------------------------------------------------------------------
Decrement object reference count if possible
n - number of object whose reference count is to be decremented
Objects whose reference count drops to zero are freed, one step behind,
giving the caller an opportunity to save the object elsewhere (and thus
raise its reference count).
2------------------------------------------------------------------------
*/
void decReferenceCount(M **m, UL n)
{
UL p = getObject(m, n);
O *o = am(*m, p);
if (o->referenceCount > 0) {o->referenceCount--;}
if (o->referenceCount == 0) // Free object if reference count is zero)
{freeObject(m, n);
}
}
/*
------------------------------------------------------------------------
Free object type ANY - does nothing because this object type does not
reference any other objects
o - number of object
The free*() functions are called to decrement the reference counts of any
objects they reference.
------------------------------------------------------------------------
*/
void freeNothing(M **m, UL o)
{
}
/*
#######################################################################
# Spona
#######################################################################
*/
/*
-----------------------------------------------------------------------
Get Spona Extent
The spona is assumed to exist
-----------------------------------------------------------------------
*/
UL getSPX(M *m)
{
if (m->spona >= MMU)
{croak("Spona does not exist");
}
UL l = getAllocLength(m, m->spona); // Size of spona memory block
UL x = ((1<<l) - sizeof(struct SP)) / sizeof(MU); // Extent of Spona
return x;
}
/*
-----------------------------------------------------------------------
log2(Minimum spona size to hold n object numbers)
-----------------------------------------------------------------------
*/
UL minSP(UL n)
{
UL x = bits(sizeof(struct SP) + n * sizeof(MU));
return x;
}
/*
-----------------------------------------------------------------------
Get the Spona - allocating it if necessary
-----------------------------------------------------------------------
*/
SP *getSP(M **m)
{
SP *S;
if ((*m)->spona == MMU)
{UL p = allocMemory(m, minSP(3)); // Allocate spona
(*m)->spona = p; // Allocate spona
S = am(*m, p); // Address newly allocated spona
S->count = 0; // Empty
S->extent = getSPX(*m); // Extent of Spona
}
else
{S = am(*m, (*m)->spona); // Address old spona
}
return S;
}
/*
-----------------------------------------------------------------------
Put a spare object number on the spona
If the number to be put back is equal to the next object number, then
the number is not put on the Spona, the next object number is reduced
instead as this saves spaces in the Spona and is faster. Now, either the
next lower number is in use or it is on the Spona: we can easily check
this by looking in the CVT (the spona is not ordered by object number,
the CVT is). The CVT entry for this object number will have its low
order bit on, the rest of the entry in the CVT will be the 2*(array
index) in the Spona. Thus if the next lower number indexes a CVT entry
with its high order bit on, then the Next Object Number can be reduced
forther. The CVT entry will be set to MMU, and the hole created in the
Spona by the removal of this next object number can be filled by
swapping in the object number at the top of the Spona, updating its
corresponding entry in the CVT in the process. Now the Spona can be
popped as its top element is not needed, and in the poping process, it
may be reduced in size. At the end of this process, I try to reduce the
CVT.
-----------------------------------------------------------------------
*/
void putSP(M **m, UL o)
{
if (o == (*m)->objectNumber) // Can we reduce next Object Number
{--((*m)->objectNumber); // do so
CVT *cv = getCV(*m); // Readdress CV in case it moved
cv->array[o-1] = MMU; // Remove object completely from CV
UL i;
for(i = o-1; i > 0; --i) // Process lower, contiguous CVT entries
{CVT *cv = getCV(*m); // Readdress CV in case it moved
if (cv->array[i-1] % 2 == 0) {break;} // Number not in Spona
--((*m)->objectNumber); // Lower next Object number
SP *S = getSP(m); // Address Spona
if (S->array[S->count-1] != i) // Next lower object number is not conveniently on top of the spona
{UL s = cv->array[i-1]>>1; // Position in Spona
UL t = S->array[S->count-1]; // Top element from Spona
cv->array[t-1] = (s<<1)+1; // Show position in spona
S->array[s] = t; // Fill hole
}
cv->array[i-1] = MMU; // Remove object completely from CV
popSP(m); // Pop it from Spona so we get shrinkage if possible
}
reallocCV(m); // See if CV can be made smaller
return;
}
SP *S = getSP(m); // Address spona
// Realloc Spona if needed
if (S->count == S->extent)
{
UL a = (*m)->spona; // Address spona
UL A = S->MAC; // Size of old Spona
UL b = allocMemory(m, A+1); // Allocate new spona
S = getSP(m); // Readdress spona
(*m)->spona = b; // Set new Spona address
SP *s = am(*m, b); // Address new spona
UL dA = (1<<A) - sizeof(struct SP); // Size of data area in old spona
memcpy(s->array, S->array, dA); // Copy data from old to new spona
s->count = S->count; // Copy count
s->extent = getSPX(*m); // Extent of Spona
freeMemory(m, a); // Free old Spona
S = getSP(m); // Address new spona
}
S->array[(S->count)] = o; // Put object on Spona
CVT *cv = getCV(*m); // Address CV
cv->array[o-1] = (S->count<<1)+1; // Show position in Spona
(S->count)++; // Increment top of spona
}
/*
-----------------------------------------------------------------------
Get a spare object number from the spona
-----------------------------------------------------------------------
*/
UL popSP(M **m)
{
if ((*m)->spona == MMU) // Spona not allocated ywt
{
return 0;
}
SP *S = getSP(m); // Address spona now it is known to exist
// Jettison Spona after extracting last object number from it
if (S->count == 1)
{UL n = S->array[0]; // Get object from Spona
UL a = (*m)->spona; // Address spona memory block
(*m)->spona = MMU; // No spona
freeMemory(m, a); // Free Spona
return n;
}
// Try to shrink Spona
if (S->count > 1)
{UL n = S->array[--(S->count)]; // Get object from Spona
{UL a = (*m)->spona; // Address spona memory block
UL A = S->MAC; // Log2(current size)
UL B = minSP(S->count); // Log2(size needed for spona)
if (B < A)
{UL b = allocMemory(m, B); // Allocate new spona
S = getSP(m); // Readdress
(*m)->spona = b; // Save offset
SP *s = am(*m, b); // Address new spona
UL dA = (1<<B) - sizeof(struct SP); // Size of data area in old spona
memcpy(s->array, S->array, dA); // Copy data from old to new spona
s->count = S->count; // Copy count
s->extent = getSPX(*m); // Extent of new spona
freeMemory(m, a); // Free old Spona
S = getSP(m);
}
}
// Return object number
return n;
}
// No spare object number available
return 0;
croak("Spona is allocated and empty which is unusual because the empty Spona is removed above");
}
/*
#######################################################################
# String
#######################################################################
*/
/*
-----------------------------------------------------------------------
Get string from object number
-----------------------------------------------------------------------
*/
String *addressString(M **m, UL o)
{
if (getObjectType(m, o) != ObjectTypeString)
{croak("Object %u is not a string", o);
}
String *s = am(*m, getObjectOffset(m, o));
return s;
}
/*
-----------------------------------------------------------------------
Create a string object
l - length of the string
s - contents of the string
Returns the object number of the created string.
-----------------------------------------------------------------------
*/
UL allocString(M **m, char *s, UL l)
{
UL o = allocObject2(m, l+sizeof(struct String)); // Allocate large enough object
String *p = am(*m, getObjectOffset(m, o)); // Pointer to object - its not a string yet so cannot call getString
p->o.type = ObjectTypeString; // Set type = string
p->length = l; // Set length
memcpy(&(p->array[0]), s, l); // Set string
return o;
}
/*
-----------------------------------------------------------------------
Recreate a string
o - object number of existing string this string will replace
l - length of the new string
s - contents of the new string
Change the string contents of a string object, either by reusing the
existing space, or by allocating new memory and fixing everything so
that the new memory replaces the old memory as the storage for this
string. The string retains its existing object number and reference
count.
-----------------------------------------------------------------------
*/
void reallocString(M **m, UL o, char *s, UL l)
{
// Reuse old memory if the string will use the same size
if (bits(l+sizeof(struct String)) == getAllocLength(*m, getObjectOffset(m, o)))
{String *S = addressString(m, o);
memcpy(S->array, s, l);
return;
}
// Allocate new memory
reallocObject2(m, o, l+sizeof(struct String), 0); // Extend/Contract existing object
String *P = addressString(m, o); // Pointer to object #12
P->length = l; // Set length
memcpy(P->array, s, l); // Set string
}
/*
-----------------------------------------------------------------------
Delete a string object
-----------------------------------------------------------------------
*/
void freeString(M **m, UL s)
{
addressString(m, s); // Check object is a string
freeObject(m, s); // Free string
}
/*
#######################################################################
# Array
#######################################################################
*/
/*
-----------------------------------------------------------------------
Get array from object number
-----------------------------------------------------------------------
*/
Array *addressArray(M **m, UL o)
{
if (debugMemory)
{if (getObjectType(m, o) != ObjectTypeArray)
{croak("Object %u is not an array", o);
}
}
Array *A = am(*m, getObjectOffset(m, o));
return A;
}
/*
-----------------------------------------------------------------------
Save blessing string stored in HashST as object o in this array
-----------------------------------------------------------------------
*/
void saveArrayBless(M **m, UL o, UL b)
{
Array *A = addressArray(m, o);
UL B = A->blessed;
if (B) // Object was blessed
{decReferenceCount(m, B);
saveLog3(ActionSaveArrayRBless, m, o, B);
}
else // First bless
{saveLog2(ActionSaveArrayFBless, m, o);
}
if (b > 0) {incReferenceCount(m, b);} // Reference count for blessing string
A->blessed = b;
}
/*
-----------------------------------------------------------------------
Get array size using known address of array
-----------------------------------------------------------------------
*/
UL getArraySizeFromAddress(Array *a)
{return a->h - a->l;
}
/*
-----------------------------------------------------------------------
Get array size - scalar(array)
-----------------------------------------------------------------------
*/
UL getArraySize(M **m, UL o)
{Array *a = addressArray(m, o);
return getArraySizeFromAddress(a);
}
/*
-----------------------------------------------------------------------
Get minimum array size for a given array
-----------------------------------------------------------------------
*/
UL getMinimumArraySize(Array *A)
{return sizeof(struct Array) + (A->h - A->l) * sizeof(MU);
}
/*
-----------------------------------------------------------------------
Get minimum array size - minimum amount of storage required to hold
an array with n elements
-----------------------------------------------------------------------
*/
UL getMinimumArraySizeToHold(UL n)
{return sizeof(struct Array) + n * sizeof(MU);
}
/*
-----------------------------------------------------------------------
Return maximum index for an array
-----------------------------------------------------------------------
*/
long arrayMax(M **m, UL o)
{UL l = getAllocLength(*m, getObject(m, o)); // log2(size of allocation)
UL L = 1<<l; // Size of allocation
L -= sizeof(struct Array); // Minus header
L /= sizeof(MU); // Divided by array element size
return L-1; // Minus one as we are zero based gives maximum possible index
}
/*
-----------------------------------------------------------------------
Return log2(Size of block needed to hold array with index i)
-----------------------------------------------------------------------
*/
UL arrayBits(UL i)
{return bits(getMinimumArraySizeToHold(i));
}
/*
-----------------------------------------------------------------------
Create an array object
-----------------------------------------------------------------------
*/
UL allocArray(M **m)
{
UL d = 3; // Default size - uses 32 bytes in 32bit Memory Model
UL s = sizeof(struct Array) + d * sizeof(MU); // Actual size
UL n = allocObject2(m, s); // Allocate
UL p = getObjectOffset(m, n); // Offset of object
O *o = am(*m, p); // Address object
o->type = ObjectTypeArray; // Set type = array
Array *A = addressArray(m, n); // Address array
A->l = 0; // Set low bound
A->h = 0; // Set high bound
return n;
}
/*
-----------------------------------------------------------------------
Create global array
-----------------------------------------------------------------------
*/
UL allocGlobalArray(M **m)
{
if ((*m)->GAH == 0) // Nothing global allocated already
{UL A = allocArray(m); // Allocate array
(*m)->GAH = A; // Save object number
return A; // Return array
}
UL t = getObjectType(m, (*m)->GAH); // Type of global object
if (getObjectType(m, (*m)->GAH) == ObjectTypeArray)
{return (*m)->GAH; // Return existing array
}
if (t == ObjectTypeHash)
{croak("Global object already allocated and it is a hash, not an array");
}
croak("Global object already allocated and it is type %u, not an array", t);
}
/*
------------------------------------------------------------------------
Free an array object.
This routine is called by freeObject. A user should call freeArray()
because it will check that the object to be deleted is in fact an array.
------------------------------------------------------------------------
*/
void freeArrayObject(M **m, UL a)
{
Array *A = addressArray(m, a); // Address array
{UL i;
for(i = A->l; i < A->h; ++i) // Each array element
{UL e = A->array[i];
if (e == 0) {continue;} // Ignore undefined entries
decReferenceCount(m, e); // Decrement reference count on freed object
A = addressArray(m, a); // Readdress array as it may have moved
}
}
}
/*
-----------------------------------------------------------------------
Free an array object.
-----------------------------------------------------------------------
*/
void freeArray(M **m, UL a)
{
if (a == (*m)->GAH) // Check GAH
{croak("Cannot free array %u because it is the global array", a);
}
addressArray(m, a); // Check object is an array
freeObject(m, a); // Free array
}
/*
-----------------------------------------------------------------------
Check an array relative index: die if bad, otherwise return absolute
index in array
-----------------------------------------------------------------------
*/
UL checkArrayIndex(Array *A, long i)
{
long I;
if (i < 0) // Index from top if negative
{I = A->h + i;
}
else
{I = A->l + i; // Index from base if positive
}
if (I < A->l) // Check bounds
{croak("Index %u is before start of array", i);
}
return I; // Return object number
}
/*
-----------------------------------------------------------------------
Get an array element at index i in array a
-----------------------------------------------------------------------
*/
UL getArray(M **m, UL a, long i)
{
Array *A = addressArray(m, a); // Address array
UL I = checkArrayIndex(A, i);
if (I >= A->h) // Undef if not defined
{
return 0;
}
UL e = A->array[I]; // Get array element
(*m)->lastArrayElement = e; // Save for testing
return e; // Return object number
}
/*
-----------------------------------------------------------------------
Copy an array from a to b in a new block of size l during reallocObject.
The array low bound will be reset to zero during the process.
This function will complain if data is lost: make sure that you remove
any elements that you do not want copied before this routine gets called.
-----------------------------------------------------------------------
*/
void copyArray(M **m, UL a, UL b, UL l)
{
Array *A = am(*m, a); // Address array
Array *B = am(*m, b); // Address array
UL S = getArraySizeFromAddress(A); // Size of array
UL L = 1<<l; // Compute maximum size of new array
L -= sizeof(struct Array);
L -= L % sizeof(MU);
UL s = L / sizeof(MU); // Maximum size of new array
if (s < S)
{croak("Target array %u is too small to receive data from %u", b, a);
}
// Move data - memory will not be moved by this operation
UL i; UL n = 0;
for(i = A->l; i < A->h; ++i, ++n)
{B->array[n] = A->array[i];
}
// Set attributes
B->l = 0; B->h = n;
}
/*
-----------------------------------------------------------------------
Reallocate an array a to hold n elements
-----------------------------------------------------------------------
*/
void reallocArray(M **m, UL a, UL n)
{
UL L = getMinimumArraySizeToHold(n); // New size
reallocObject2(m, a, L, ©Array); // Copy data
}
/*
-----------------------------------------------------------------------
Shrink an array if possible
-----------------------------------------------------------------------
*/
void shrinkArray(M **m, UL a)
{
Array *A = addressArray(m, a);
UL l = arrayBits(getArraySize(m, a)); // log2(New size)
UL k = getAllocLength(*m, getObject(m, a)); // log2(Current size)
if (l < k) // Shrinkable
{reallocArray(m, a, getArraySize(m, a)); // Reallocate array
}
}
/*
-----------------------------------------------------------------------
Put an object into an array
-----------------------------------------------------------------------
*/
void putArray(M **m, UL a, long i, UL v)
{
Array *A = addressArray(m, a); // Address array
UL I = checkArrayIndex(A, i); // Absolute index
//Cannot implement the following line because Perl fails to take advantage of this optimization documented in PE
//if (I >= A->h && v == 0) {return;} // Trying to set an undefined value to undefined
if (I < A->h && v == A->array[I]) {return;} // Element is not being changed, so nothing is being done
if (I < A->h) // Remove old object
{UL e = A->array[I]; // Old referenced object
if (e > 0) // Remove old object if defined
{decReferenceCount(m, e); // Reduce reference count for old object
}
saveLog4(ActionPutArray, m, a, i, e); // Log old value
}
else
{if (I > arrayMax(m, a)) // Expand allocation if necessary
{reallocArray(m, a, I - A->l + 1); // Expand array to at least the size required to hold this actual index
}
UL n = getArraySize(m, a); // Old array size
saveLog3(ActionSetArraySize, m, a, n); // Changing array size only
}
A = addressArray(m, a); // Address array
I = checkArrayIndex(A, i); // Absolute index
A->array[I] = v; // Set reference to new object
if (I >= A->h) {A->h = I+1;} // Increase high bound
if (v > 0) {incReferenceCount(m, v);} // Increase reference count for new object
cleanUp(m); // Clean up possible because no element is returned
}
/*
-----------------------------------------------------------------------
Set an array element without reference counting or logging. This allows
an array to be used to store numbers rather than strings, which is used
during log processing to keep track of the users actions.
-----------------------------------------------------------------------
*/
void putArrayNanO(M **m, UL a, long i, UL v)
{
Array *A = addressArray(m, a); // Address array
UL I = checkArrayIndex(A, i); // Absolute index
if (I >= A->h) // Extend array if necessary
{if (I > arrayMax(m, a)) // Expand allocation if necessary
{reallocArray(m, a, I - A->l + 1); // Expand array to at least the size required to hold this actual index
A = addressArray(m, a); // Address new array
I = checkArrayIndex(A, i); // Absolute index
}
}
A->array[I] = v; // Set reference to new object
if (I >= A->h) {A->h = I+1;} // Increase high bound
}
/*
-----------------------------------------------------------------------
Set array size - implements STORESIZE
-----------------------------------------------------------------------
*/
void setArraySize(M **m, UL a, long i)
{
Array *A = addressArray(m, a); // Address array
UL I = checkArrayIndex (A, i); // Absolute index
if (I < A->h) // Remove elements due to truncation
{UL j; // Set excluded elements to zero
for(j = I; j < A->h; ++j) // Each element
{if (A->array[j] > 0) // that is defined
{putArray(m, a, j - A->l, 0); // Set array element to undefined
A = addressArray(m, a); // Readdress array
}
}
UL n = getArraySize(m, a); // Old array size
saveLog3(ActionSetArraySize, m, a, n); // Log old array size
A = addressArray(m, a); // Readdress array
A->h = I; // Set new array size
shrinkArray(m, a); // Shrink array if possible
}
else
{putArray(m, a, I - A->l - 1, 0); // Expand allocation by seeting the new top element to undef
}
cleanUp(m); // Clean up possible because no element is returned
}
/*
-----------------------------------------------------------------------
Extend array
-----------------------------------------------------------------------
*/
void extendArray(M **m, UL a, long i)
{
Array *A = addressArray(m, a); // Address array
UL I = checkArrayIndex(A, i); // Check index
UL j = I - A->l; // Actual index
if (j > arrayMax(m, a)) // Extend array if necessary
{UL n = arrayMax(m, a); // Old array maximum size
saveLog3(ActionExtendArray, m, a, n); // Log old maximum size
reallocArray(m, a, j); // Extend array without changing the set upper bound
}
cleanUp(m); // Clean up possible because no element is returned
}
/*
-----------------------------------------------------------------------
Clear an array
-----------------------------------------------------------------------
*/
void clearArray(M **m, UL a)
{
Array *A = addressArray(m, a); // Address array
{UL i; // Lower reference count for freed elements
for(i = A->l; i < A->h; ++i)
{UL e = A->array[i];
if (e > 0)
{putArray(m, a, i - A->l, 0); // undefine defined element
A = addressArray(m, a); // Readdress array
}
}
}
saveLog3(ActionClearArray, m, a, getArraySizeFromAddress(A)); // Log old size
A = addressArray(m, a); // Address array
A->l = A->h = 0; // Reset bounds
reallocArray(m, a, 0); // Reallocate array as small as possible
cleanUp(m); // Clean up possible because no element is returned
}
/*
-----------------------------------------------------------------------
Push object number onto an array - logging is inherent in putArray()
-----------------------------------------------------------------------
*/
void pushArray(M **m, UL a, UL o)
{
Array *A = addressArray(m, a); // Address array
putArray(m, a, A->h - A->l, o); // Set top element of array
}
/*
-----------------------------------------------------------------------
Pop an object number from an array
-----------------------------------------------------------------------
*/
UL popArray(M **m, UL a)
{
Array *A = addressArray(m, a); // Address array
UL v = 0; // Popped element
if (A->l < A->h) // Elements available
{v = A->array[--A->h]; // Pop element
A->array[ A->h] = 0; // Remove old element
decReferenceCount(m, v); // Decrease reference count for removed object
saveLog3(ActionPopArray, m, a, v); // Log pop
shrinkArray(m, a); // Shrink array of possible
}
return v;
}
/*
-----------------------------------------------------------------------
Unshift value v onto an array a
-----------------------------------------------------------------------
*/
void unshiftArray(M **m, UL a, UL v)
{
saveLog2(ActionUnshiftArray, m, a);
Array *A = addressArray(m, a); // Address array
if (A->l > 0) // Enough space already
{A->array[--A->l] = v; // Save element and reduce lower bound
incReferenceCount(m, v); // Increase reference count for insert object
return;
}
UL s = 1; // Shift for unshift
if (A->h > arrayMax(m, a))
{s = 8; // Boost shift
reallocArray(m, a, A->h + s); // Make room for more elements
A = addressArray(m, a); // Address array
}
long i;
for(i = A->h-1; i >= (long)A->l; --i)
{A->array[i+s] = A->array[i]; // Shift
}
A->array[A->l + s - 1] = v; // Save current element
incReferenceCount(m, v); // Increase reference count for insert object
A->h += s; // Increase upper bound
A->l += s - 1; // Increase lower bound
cleanUp(m); // Clean up possible because no element is returned
}
/*
-----------------------------------------------------------------------
Shift from an array a
-----------------------------------------------------------------------
*/
UL shiftArray(M **m, UL a)
{
Array *A = addressArray(m, a); // Address array
UL v = 0; // Shifted element
if (A->l < A->h)
{v = A->array[A->l++];
saveLog3(ActionShiftArray, m, a, v); // Log value shifted
decReferenceCount(m, v); // Decrease reference count for removed object
}
return v;
}
/*
-----------------------------------------------------------------------
Splice array a as described by entries in array d. d[1] is th offset,
d[2] the length, and d[3 ...] the data items. n is the number of items
in d.
-----------------------------------------------------------------------
UL spliceArray(M **m, UL a, long n, UL *d)
{
UL b = allocArray(m); // Spliced array
UL r = allocArray(m); // Splice results array
Array *A = addressArray(m, a); // Address splice array
Array *B = addressArray(m, b); // Address spliced array
Array *R = addressArray(m, r); // Address results array
UL S = A->h - A->l; // Size of splice array
UL O = 0; // Offset - default
if n > 1)
{O = d[1]; // Offset
if (O < 0) {O += S;} // Negative offset
}
if (O < 0) {O = 0;} // Too negative
if (O > S) {O = S;} // Too positive
UL L = S; // Length - default
if n > 2)
{L = d[2]; // Length
if (L < 0) {L += S - O;} // Negative length
}
if (L < 0) {L = 0;} // Too negative
if (L > S - O) {L = S - O;} // Too positive
O += A->l; // Actual offset
{UL i, j = 0; // Copy each element up to offset
for(i = A->l; i < O; ++i, ++j)
{putArrayNanO(m, b, j, A->array[i]);
A = addressArray(m, a); // Readdress splice array
}
}
{UL i, j = 0, u = O + L; // Copy the spliced out elements
for(i = O; i < u; ++i, ++j)
{putArrayNanO(m, r, j, A->array[i]);
A = addressArray(m, a); // Readdress splice array
}
}
{UL i, j = O, u = O; // Copy in splicing elements
for(i = 3; i < n; ++i, ++j)
{putArrayNanO(m, b, j, d[i]);
}
}
A = addressArray(m, a); // Readdress splice array
B = addressArray(m, b); // Readdress spliced array
{UL i, j = B->h, u = A->h; // Copy remaining elements
for(i = O + L; i < n; ++i, ++j)
{putArrayNanO(m, b, j, A->array[i];
A = addressArray(m, a); // Readdress splice array
}
}
swapObject(m, a, b); // Makes the spliced array the splice array
freeArray(m, a); // Free old array
return r;
}
/*
#######################################################################
# Hash
#######################################################################
*/
/*
-----------------------------------------------------------------------
Get hash from object number
-----------------------------------------------------------------------
*/
Hash *addressHash(M **m, UL o)
{
if (debugMemory)
{if (getObjectType(m, o) != ObjectTypeHash)
{croak("Object %u is not a hash", o);
}
if ((*m)->hashST == getObjectOffset(m, o))
{croak("Please do not try to address the HashST, it is a system object");
}
}
Hash *H = am(*m, getObjectOffset(m, o));
return H;
}
/*
-----------------------------------------------------------------------
Save blessing string stored in HashST as object o in this hash
-----------------------------------------------------------------------
*/
void saveHashBless(M **m, UL o, UL b)
{
Hash *H = addressHash(m, o);
UL B = H->blessed;
if (B) // Object was blessed
{decReferenceCount(m, B);
saveLog3(ActionSaveHashRBless, m, o, B);
}
else // First bless
{saveLog2(ActionSaveHashFBless, m, o);
}
if (b > 0) {incReferenceCount(m, b);} // Reference count for blessing string
H->blessed = b;
}
/*
-----------------------------------------------------------------------
Get number of elements in a hash
-----------------------------------------------------------------------
*/
UL getHashSize(M **m, UL H)
{
Hash *h = addressHash(m, H);
UL n = h->count;
return n;
}
/*
-----------------------------------------------------------------------
Address hash key from object number
-----------------------------------------------------------------------
*/
HashKey *addressHashKey(M **m, UL o)
{
if (getObjectType(m, o) != ObjectTypeHashKey)
{ddd(m);
croak("Object %u is not a hashKey", o);
}
HashKey *k = am(*m, getObjectOffset(m, o));
return k;
}
/*
------------------------------------------------------------------------
Number of buckets that could be placed in the block at offset a
------------------------------------------------------------------------
*/
UL getHashBuckets(M **m, UL a)
{
UL l = getAllocLength(*m, a);
UL n = ((1<<l) - sizeof(struct Hash)) / sizeof(struct HashElement);
return n;
}
/*
------------------------------------------------------------------------
Number of buckets that could be placed in the hash with object number h
------------------------------------------------------------------------
*/
UL getHashBucketsObject(M **m, UL h)
{
UL H = getObjectOffset(m, h);
UL n = getHashBuckets(m, H);
return n;
}
/*
------------------------------------------------------------------------
Allocate a hash key and set it to string K with length L
------------------------------------------------------------------------
*/
UL allocHashKey(M **m, char *K, UL L)
{
UL o = allocObject2(m, sizeof(struct HashKey)+L); // Allocate object
HashKey *s = am(*m, getObjectOffset(m, o)); // Address hash string
s->length = L; // Save length
memcpy(s->array, K, L); // Save string
s->o.type = ObjectTypeHashKey; // Set type
return o; // Return object
}
/*
------------------------------------------------------------------------
Hash a string
------------------------------------------------------------------------
*/
UL hashString(char *s, UL L, UL B)
{
char *p = s;
UL i = 0;
UL v = 1;
UL v1 = 0;
v = 1;
for(i = 0; i < L; ++i, ++p)
{memcpy((void *)&v1, (void *)(s+i), 1);
v *= (1 + v1) * (1+i);
v %= MMU;
v++;
}
return v;
}
/*
------------------------------------------------------------------------
Find a string k with length l in the Hash String Table and return its
object number, or MMU if not found
------------------------------------------------------------------------
*/
UL getHashST(M **m, char *K, UL L)
{
setUpHashST(m); // Set up Hash ST if not already done
UL H = (*m)->hashST; // Address hash
UL B = (*m)->hashSTX; // Number of buckets
UL k = hashString(K, L, B); // Hash input string
Hash *h = am(*m, H); // Address hash
UL P = h->array[k % B].path; // Path length for this key in HST
UL i; UL lppp = 0; UL fh = MMU; UL fhi; // Last positive path position, first hole, first hole path length
for(i = 0; i <= P; ++i) // Search along path
{UL p = (k + i) % B; // Next position
UL f = h->array[p].key; // Get key
if (f == 0 && fh == MMU) {fh = p; fhi = i;} // First hole, first hole path
if (f > 0)
{HashKey *s = addressHashKey(m, f); // Address hash string
if (s->length != L || // Check length
memcmp(K, s->array, L) != 0) // Check contents
{lppp = i; // Record last positive position
continue; // Continue if keys do not match
}
if (fh == MMU) // No path tightening or shortening
{
return f; // Return HashKey
}
else // Tighten path possible because this entry hash the same hash key as the entry point
{h->array[fh].key = h->array[p].key; h->array[p].key = 0;
h->array[fh].data = h->array[p].data; h->array[p].data = 0;
if (i == P) // Tighten and shorten oath
{UL npl = lppp; // New path length
if (fhi > lppp) {npl = fhi;} // If we are filling a hole beyond the last positive position, path must extend to the hole
h->array[k % B].path = npl; // Shorten path as we are the end
}
else // Tighten path
{
}
return h->array[fh].key; // Return object number of matching key
}
}
}
h->array[k % B].path = lppp; // Update path length as we are at the end of the path
return MMU;
}
/*
------------------------------------------------------------------------
Find a hash string in a hash. Return the bucket number in the hash if
found, else MMU.
Path tightening moves a hash entry closer to its point of entry if
possible. We can do this with find operations because the found bucket
must match the entry point hash.
------------------------------------------------------------------------
*/
UL findHashBucket(M **m, UL H, char *K, UL L)
{
Hash *h = addressHash (m, H); // Address hash
UL k = getHashST(m, K, L); // Find bucket containing string in HashST
if (k == MMU) // Key not in HashST, so cannot be in hash
{
return MMU;
}
UL O = getObjectOffset(m, H); // Object offset
UL B = getHashBuckets (m, O); // Number of buckets
if (B == 0) // No keys in hash so cannot be found
{
return MMU;
}
UL P = h->array[k % B].path; // Path length for this key
UL i; UL lppp = 0; UL fh = MMU; UL fhi; // Last positive position, First hole, first hole path
for(i = 0; i <= P; ++i) // Search along path
{UL p = (k + i) % B; // Next position
UL f = h->array[p].key; // Get key
if (f == 0 && fh == MMU) {fh = p; fhi = i;} // First hole, first hole path
if (f == k) // Key matches
{if (fh == MMU) // No path tightening or shortening
{
return p; // return bucket - it was not moved
}
else // Tighten path possible because this entry hash the same hash key as the entry point
{h->array[fh].key = h->array[p].key; h->array[p].key = 0;
h->array[fh].data = h->array[p].data; h->array[p].data = 0;
if (i == P) // Tighten and shorten oath
{UL npl = lppp; // New path length
if (fhi > lppp) {npl = fhi;} // If we are filling a hole beyond the last positive position, path must extend to the hole
h->array[k % B].path = npl; // Shorten path as we are the end
}
else // Tighten path
{
}
return fh; // Return number of bucket containing key
}
}
if (f > 0) {lppp = i;} // Record last positive path position
}
h->array[k % B].path = lppp; // Update path length as we are at the end of the path
return MMU;
}
/*
------------------------------------------------------------------------
Find data in hash. Return the data object associated with the key or
undefined = 0 if not found.
------------------------------------------------------------------------
*/
UL getHash(M **m, UL H, char *K, UL L)
{
UL b = findHashBucket(m, H, K, L); // Find bucket
if (b == MMU) // Key not found
{
return (*m)->lastFoundHashElement = 0; // Save for testing
}
Hash *h = addressHash(m, H); // Address hash
UL D = h->array[b].data; // Get data object from bucket
(*m)->lastFoundHashElement = D; // Save for testing
return D;
}
/*
------------------------------------------------------------------------
See whether a key exists in hash H
------------------------------------------------------------------------
*/
UL inHash(M **m, UL H, char *K, UL L)
{
UL b = findHashBucket(m, H, K, L); // Find bucket
UL r = b != MMU; // Key exists if not undefined
return r;
}
/*
------------------------------------------------------------------------
Free hash key in HashST
------------------------------------------------------------------------
*/
void freeHashSTKey(M **m, UL n)
{
HashKey *K = addressHashKey(m, n); // Address hash key
UL H = (*m)->hashST; // Address hash
UL B = (*m)->hashSTX; // Number of buckets
UL k = hashString(K->array, K->length, B); // Hash String
Hash *h = am(*m, H); // Address hash
UL P = h->array[k % B].path; // Path length for this key in HST
UL i; UL lppp = 0; // Last positive path position
for(i = 0; i <= P; ++i) // Search along path
{UL p = (k + i) % B; // Next position
UL f = h->array[p].key; // Get key
if (f > 0)
{if (f == n) // Found hash key
{h->array[p].key = 0; // Zero hash key
h->array[p].data = 0; // Zero hash in data field
h->count--; // Reduce count
if (i == P)
{h->array[k % B].path = lppp; // Update path if we are at the end of it
}
else
{
}
if (h->count < B / 4) {shrinkHashST(m);} // Shrink HashST if possible
return;
}
lppp = i; // Record last positive position
}
}
h->array[k % B].path = lppp; // Update path length as we are at the end of the path
croak("NOT found hashKey %u with hash %u pathLength=%u in HashST, set pathlength of %u to %u", n, k, P, k % B, lppp);
}
/*
------------------------------------------------------------------------
Delete a hash key from a hash. Return the data field associated with the
field.
NOTE: To set an element in Hash H with key K, length L to the undefined
value:
putHash(m, H, K, L, 0)
deleteHashKey() removes the hash key from the hash completely.
------------------------------------------------------------------------
*/
UL deleteHashKeyByIndex(M **m, UL H, UL k)
{
Hash *h = addressHash (m, H); // Address hash
UL B = getHashBuckets(m, getObjectOffset(m, H)); // Number of buckets
UL P = h->array[k % B].path; // Path length for this key
UL i; UL lppp = 0; // Last positive path position
for(i = 0; i <= P; ++i) // Search along path
{UL p = (k + i) % B; // Next position
UL f = h->array[p].key; // Get key
if (f == k) // Key matches
{decReferenceCount(m, f); // Decrement reference count of hash key
h = addressHash(m, H); // Readdress hash
h->array[p].key = 0; // Zero hash key
UL D = h->array[p].data; // Save data field
h->array[p].data = 0; // Zero data field
if (D > 0) // Decrement reference count of data
{decReferenceCount(m, D);
h = addressHash(m, H); // Readdress hash
}
h->count--; // Reduce count
if (i == P)
{h->array[k % B].path = lppp; // Update path if we are at the end of it
}
else
{
}
(*m)->lastFoundHashElement = D; // Show for testing
if (h->count < B / 4) {shrinkHash(m, H);} // Shrink Hash if possible
return D; // Return data field
}
if (f > 0) {lppp = i;} // Record last positive path position
}
h->array[k % B].path = lppp; // Update path length as we are at the end of the path
return 0;
}
/*
------------------------------------------------------------------------
Delete a hash key from a hash. Return the data field associated with the
field.
------------------------------------------------------------------------
*/
UL deleteHashKey(M **m, UL H, char *K, UL L)
{
UL k = getHashST(m, K, L); // Find bucket containing string in HashST
if (k == MMU) // Key not in HashST
{return 0; // so cannot be in hash
}
UL d = deleteHashKeyByIndex(m, H, k); // Delete hash key entry using index
if (d > 0) // Log delete of key with defined value
{saveLog4(ActionDeleteDHash, m, H, k, d); // Log action
}
else // Log delete of key with undefined value
{saveLog3(ActionDeleteUHash, m, H, k); // Log action
}
return d;
}
/*
-----------------------------------------------------------------------
Copy HashST from a to b in a new block of size l during reallocObject.
We can assume that the keys to the hash are uniue as they are coming
from another hash.
-----------------------------------------------------------------------
*/
void copyHashST(M **m, UL a, UL b, UL l)
{
Hash *A = am(*m, a); // Address old HashST
Hash *B = am(*m, b); // Address new HashST
UL nA = getHashBuckets(m, a); // Number of buckets
UL nB = getHashBuckets(m, b); // Number of buckets
B->maxPath = 0; // Clear maximum path length
// Move data - memory will not be moved by this operation because there are no decrements
UL i;
for(i = 0; i < nA; ++i)
{if (A->array[i].key == 0) {continue;} // Skip empty buckets
UL h = A->array[i].data; // Hash of string
// Search for first empty position
UL j;
for(j = 0; j < nB; ++j) // Search
{UL p = (h + j) % nB; // Position
UL f = B->array[p].key; // Get key
if (f == 0) // Found empty slot
{B->array[p].key = A->array[i].key; // Save key
B->array[p].data = A->array[i].data; // Save data
UL P = B->array[h % nB].path; // Current path length
if (j > P)
{UL P = B->array[h % nB].path = j; // Update path length
if (B->maxPath < P) {B->maxPath = P;} // Maximum path length
}
break;
}
}
}
// Set attributes
B->count = A->count;
}
/*
------------------------------------------------------------------------
Allocate hash and return its object number
------------------------------------------------------------------------
*/
UL allocHash(M **m)
{
UL L = sizeof(struct Hash) + 3 * sizeof(struct HashElement); // Default size fills 64 bytes in 32bit memory model
UL H = allocObject2(m, L); // Allocate object
Hash *h = am(*m, getObjectOffset(m, H)); // Address object
h->o.type = ObjectTypeHash; // Set type
h->count = 0; // Clear count
h->maxPath = 0; // Clear maximum path
h->iterator = MMU; // Clear iterator
return H;
}
/*
-----------------------------------------------------------------------
Create global hash
-----------------------------------------------------------------------
*/
UL allocGlobalHash(M **m)
{
if ((*m)->GAH == 0) // Nothing global allocated already
{UL H = allocHash(m); // Allocate hash
(*m)->GAH = H; // Save object number
return H; // Return hash
}
UL t = getObjectType(m, (*m)->GAH); // Type of global object
if (getObjectType(m, (*m)->GAH) == ObjectTypeHash)
{return (*m)->GAH; // Return existing hash
}
if (t == ObjectTypeArray)
{croak("Global object already allocated and it is an array, not a hash");
}
croak("Global object already allocated and it is type %u, not a hash", t);
}
/*
-----------------------------------------------------------------------
Free a hash object
h = object number of hash to be freed
This routine will be called by freeObject to lower the reference counts
the hash elements. The actual free of memory is done in freeObject.
The HashST should not be freed in this manner.
A user should call freeHash() as it checks that the obejct to be
deleted is in fact a hash.
-----------------------------------------------------------------------
*/
void freeHashObject(M **m, UL h)
{
UL B = getHashBuckets(m, getObject(m, h)); // Buckets in hash
// Save Hash contents
UL c = getAllocLength(*m, getObject(m, h)); // Log2(size of block containing array)
Hash *s = malloc(1<<c);
if (s == 0)
{croak("Malloc failed to allocate 2**%u bytes", s);
}
memcpy(s, addressHash(m, h), 1<<c); // Copy hash contents as hash will move as objects are freed
{UL i;
for(i = 0; i < B; ++i) // Each bucket
{UL k = s->array[i].key; // Get key
if (k == 0) {continue;} // Skip if zero
decReferenceCount(m, k); // Otherwise decrement reference count
UL d = s->array[i].data; // Get data
if (d == 0) {continue;} // Skip if zero
decReferenceCount(m, d); // Otherwise decrement reference count
}
}
}
/*
-----------------------------------------------------------------------
Delete a hash object
-----------------------------------------------------------------------
*/
void freeHash(M **m, UL h)
{
if (h == (*m)->GAH) // Check GAH
{croak("Cannot free hash %u because it is the global hash", h);
}
addressHash(m, h); // Check it is a hash
freeObject(m, h); // Free the hash
}
/*
------------------------------------------------------------------------
Allocate hash string table.
------------------------------------------------------------------------
*/
UL allocHashST(M **m)
{
UL H = allocHash(m); // Allocate hash
UL h = (*m)->hashST = getObjectOffset(m, H); // Save offset to new HashST
(*m)->hashSTX = getHashBuckets (m, h); // Save extent of new HashST
return H;
}
/*
------------------------------------------------------------------------
Reallocate hash string table.
------------------------------------------------------------------------
*/
void reallocHashST(M **m)
{
UL P = (*m)->hashST; // Old HashST
UL l = getAllocLength (*m, P); // Block size of OLD HashST
UL o = getObjectNumber(*m, P); // Object number of OLD HashST
reallocObject2(m, o, 1<<(l+1), ©HashST); // Allocate new block of twice the size
UL O = (*m)->hashST = getObjectOffset(m, o); // Save offset to new HashST
(*m)->hashSTX = getHashBuckets (m, O); // Save extent of new HashST
}
/*
-----------------------------------------------------------------------
Copy Hash from a to b in a new block of size l during reallocObject().
-----------------------------------------------------------------------
*/
void copyHash(M **m, UL a, UL b, UL l)
{
Hash *A = am(*m, a); // Address old HashST
Hash *B = am(*m, b); // Address new HashST
UL nA = getHashBuckets(m, a); // Number of buckets in a
UL nB = getHashBuckets(m, b); // Number of buckets in b
B->iterator = A->iterator; // Iteration state, but I think should always be -1
B->maxPath = 0; // Clear maximum path length
B->count = 0; // Clear maximum path length
// Move data - memory will not be moved by this operation as there are no decrements
UL i;
for(i = 0; i < nA; ++i)
{UL k = A->array[i].key; // Object number of hash key
if (k == 0) {continue;} // Skip empty buckets
// Search
UL j;
for(j = 0; j < nB; ++j) // Search along path
{UL p = (k + j) % nB; // Position
UL f = B->array[p].key; // Get key
if (f == 0) // Found empty slot
{B->array[p].key = A->array[i].key; // Save key
B->array[p].data = A->array[i].data; // Save data
UL P = B->array[k % nB].path; // Current path length
if (j > P)
{UL P = B->array[k % nB].path = j; // Update path length
if (B->maxPath < P) {B->maxPath = P;} // Maximum path length
}
++(B->count);
break;
}
}
}
}
/*
------------------------------------------------------------------------
Reallocate hash
------------------------------------------------------------------------
*/
void expandHash(M **m, UL P)
{
UL l = getAllocLength(*m, getObjectOffset(m, P)); // Block size of Hash
reallocObject2(m, P, 1<<(l+1), ©Hash); // Allocate new block of twice the size
}
/*
------------------------------------------------------------------------
Check if hash should be expanded. The computation of the maximum
tolerable path is biased at the moment for memory model 0.
------------------------------------------------------------------------
*/
UL shouldExpandHash(M **m, UL H)
{
Hash *h = am(*m, H); // Address hash
UL l = h->o.MAC + 1; // Log2(allocation size)
l /= 2; // square root rounded up due to previous line
if (h->maxPath > (1<<l)) // Maximum path length is too long
{
return 1;
}
return 0; // Does not need realloc
}
/*
------------------------------------------------------------------------
See if a hash with offset o needs shrinking
------------------------------------------------------------------------
*/
UL shouldShrinkHash(M **m, UL o)
{
UL H = getObjectNumber(*m, o); // Get Object Number of Hash
UL l = getAllocLength (*m, o); // log2(allocation size)
//if (l <= MemoryMinimumSize)
// {rETURN "Hash %u is too small to shrink", H
// return 0;
// }
UL l2 = l / 2; // sqrt log2(allocation size)
UL B = getHashBuckets ( m, o); // Buckets
UL B2 = B / 2; // Buckets / 2
UL B4 = B2 / 2; // Buckets / 4
UL B8 = B4 / 2; // Buckets / 8
Hash *h = am(*m, o); // Address hash
UL M = h->maxPath; // Maximum path
UL C = h->count; // Count
UL r = 0; // Result
if (B4 > C && M < (1<<l2-1)) {r = 1;} // Less than 1/4 full and maximum path length is short
else if (B8 > C) {r = 1;} // Less than 1/8 full
else if (B2 > C && M > C) {r = 1;} // Less than 1/2 full and very long max path
return r;
}
/*
------------------------------------------------------------------------
Make HashST smaller if possible
------------------------------------------------------------------------
*/
void shrinkHashST(M **m)
{
UL O = (*m)->hashST; // HashST offset
UL H = getObjectNumber(*m, O); // Get Object Number of HashST
if (shouldShrinkHash (m, O)) // Needs shrinking
{UL l = getAllocLength(*m, O); // Block size of Hash
reallocObject2(m, H, 1<<(l-1), ©HashST); // Allocate new block half the size
UL O = (*m)->hashST = getObjectOffset(m, H); // Save offset to new HashST
(*m)->hashSTX = getHashBuckets(m, O); // Save extent of new HashST
return;
}
}
/*
------------------------------------------------------------------------
Make a hash smaller if possible
------------------------------------------------------------------------
*/
void shrinkHash(M **m, UL H)
{
Hash *h = addressHash(m, H); // Address hash
if (h->iterator < MMU) {return;} // Not allowed during scan
UL O = getObjectOffset(m, H); // Hash Offset
if (shouldShrinkHash (m, O)) // Needs shrinking
{UL l = getAllocLength(*m, O); // Block size of Hash
reallocObject2(m, H, 1<<(l-1), ©Hash); // Allocate new block half the size
return;
}
}
/*
------------------------------------------------------------------------
Set up Hash String table if not present
------------------------------------------------------------------------
*/
void setUpHashST(M **m)
{if ((*m)->hashST == MMU) {allocHashST(m);} // Allocate hash string table if not already allocated
}
/*
------------------------------------------------------------------------
Save string K with length L in Hash String Table and return object
number of hash string object.
------------------------------------------------------------------------
*/
UL saveStringInHashST(M **m, char *K, UL L)
{
setUpHashST(m);
// Save string in Hash String Table
UL i;
for(i = 0; i < bMU; ++i) // Let HashST grow if necessary
{UL B = (*m)->hashSTX; // Buckets in HashST
if (B == 0 || shouldExpandHash(m, (*m)->hashST)) // Increase size of HashST if necessary
{reallocHashST(m);
continue;
}
UL k = hashString(K, L, B); // Hash string
Hash *h = am(*m, (*m)->hashST); // Address Hash
UL P = h->array[k % B].path; // Path length
// Search - in path - return index of matching entry if possible
UL fp = MMU; // First empty position
UL j;
for(j = 0; j <= P; ++j) // Search along path
{UL p = (k + j) % B; // Position
UL f = h->array[p].key; // Get key
if (f > 0)
{HashKey *s = addressHashKey(m, f); // Address hash string
if (s->length != L || // Check length
memcmp(K, s->array, L) != 0) // Check contents
{continue; // Continue if keys do not match
}
return f; // Return object number of matching key
}
else
{if (fp == MMU) {fp = p;} // Save first empty position
}
}
// New entry within path
if (fp < MMU)
{UL s = allocHashKey(m, K, L); // Save hash string
Hash *h = am(*m, (*m)->hashST); // Address Hash
h->array[fp].key = s; // Save object number of hash string
h->array[fp].data = k; // Save hash of string
h->count++; // Update in use count
h->iterator = MMU; // Stop any further iteration
return s;
}
// Extend path
for(j = 0; j < B; ++j) // Search along path
{UL Pj1 = P+j+1; // Position
UL p = (k+Pj1) % B; // Position
if (h->array[p].key > 0) {continue;}; // Find empty bucket
UL s = allocHashKey(m, K, L); // Save hash string
Hash *h = am(*m, (*m)->hashST); // Address Hash
h->array[p].key = s; // Save object number of hash string in hash key
h->array[p].data = k; // Save hash of string
h->count++; // Update in use count
h->iterator = MMU; // Stop any further iteration
h->array[k % B].path = Pj1; // Update path length
if (h->maxPath <= Pj1) {h->maxPath = Pj1;} // Maximum path length
return s;
}
reallocHashST(m); // Reallocate hash and try again
}
// Failed
croak("Cannot save %s in HashST", K);
}
/*
------------------------------------------------------------------------
Save data D in hash H under key K wih length l
------------------------------------------------------------------------
*/
void putHashByIndex(M **m, UL H, UL k, UL D)
{
UL i;
for(i = 0; i < bMU; ++i) // Let Hash grow if necessary
{Hash *h = addressHash(m, H); // Address hash
UL o = getObjectOffset(m, H); // Offset of hash
UL B = getHashBuckets(m, o); // Buckets in Hash
if (B == 0 || shouldExpandHash(m, o)) // Increase size of Hash if necessary
{expandHash(m, H);
continue;
}
UL P = h->array[k % B].path; // Path length
// Search in path
UL fp = MMU; // First empty position
UL j;
for(j = 0; j <= P; ++j) // Search along path
{UL p = (k + j) % B; // Position
UL f = h->array[p].key; // Get key
if (f > 0)
{if (f == k) // Check keys match
{UL d = h->array[p].data; // Old referenced object
if (d == D) {return;} // Data is the same - no action required
if (d > 0) // Decrement old object reference if not undefined
{decReferenceCount(m, d);
h = addressHash(m, H); // Readdress hash
saveLog4(ActionPutRDHash, m, H, k, d); // Log action
}
else
{saveLog3(ActionPutRUHash, m, H, k); // Log action
}
h->array[p].data = D; // Set new object reference
if (D > 0) {incReferenceCount(m, D);} // Increment reference count of saved data if not undefined
return;
}
}
else
{if (fp == MMU) {fp = p;} // Save first empty position
}
}
// New entry within path
if (fp < MMU)
{h->array[fp].key = k; // Save object number of hash string in hash key
h->array[fp].data = D; // Save object number of hash string in hash key
incReferenceCount(m, k); // Update reference count
if (D > 0) {incReferenceCount(m, D);} // Increment reference count of saved data if not undefined
h->count++; // Update in use count
h->iterator = MMU; // Stop any further iteration
saveLog3(ActionPutIHash, m, H, k); // Log action
return;
}
// Extend path
for(j = 0; j < B; ++j) // Search along path
{UL Pj1 = P+j+1; // Position
UL p = (k + Pj1) % B; // Position
if (h->array[p].key > 0) {continue;}; // Find empty bucket
h->array[p].key = k; // Save object number of hash string in hash key
h->array[p].data = D; // Save object number of hash string in hash key
incReferenceCount(m, k); // Update reference count
if (D > 0) {incReferenceCount(m, D);} // Increment reference count of saved data if not undefined
h->count++; // Update in use count
h->iterator = MMU; // Stop any further iteration
h->array[k % B].path = Pj1; // Update path length
if (h->maxPath <= Pj1) {h->maxPath = Pj1;} // Maximum path length
saveLog3(ActionPutIHash, m, H, k); // Log action
return;
}
expandHash(m, H); // Reallocate hash and try again
}
// Failed
croak("Cannot save data %u under key %u in Hash %u", D, k, H);
}
/*
------------------------------------------------------------------------
Save data in Hash and return number of hashKey used to store data
------------------------------------------------------------------------
*/
UL putHash(M **m, UL H, char *K, UL L, UL D)
{
UL k = saveStringInHashST(m, K, L); // Save string in HashST
putHashByIndex(m, H, k, D); // Put into hash
cleanUp(m); // Clean up possible because no element is returned
return k;
}
/*
-----------------------------------------------------------------------
Get minimum hash size - mminimum amount of storage required to hold
a hashn eith number of elements n
-----------------------------------------------------------------------
*/
UL getMinimumHashSize(UL n)
{return sizeof(struct Hash) + n * sizeof(struct HashElement) - sizeof(struct O);
}
/*
-----------------------------------------------------------------------
Clear a hash
-----------------------------------------------------------------------
*/
void clearHash(M **m, UL h)
{
Hash *H = addressHash(m, h); // Address hash
UL B = getHashBucketsObject(m, h); // Get buckets
{UL i; // Lower reference count for freed elements
for(i = 0; i < B; ++i)
{UL k = H->array[i].key; // Get key
H->array[i].key = 0; // Zero key
UL d = H->array[i].data; // Get data
H->array[i].data = 0; // Zero data
if (k > 0) // Decerment refence count of referenced hash key
{decReferenceCount(m, k); // Reduce reference count of hash key
if (d > 0)
{saveLog4(ActionDeleteDHash, m, h, k, d); // Log action
}
else
{saveLog3(ActionDeleteUHash, m, h, k); // Log action
}
}
if (d > 0) {decReferenceCount(m, d);} // Reduce reference count of data
Hash *N = addressHash(m, h); // Readdress hash
if (H != N) // If hash has moved
{B = getHashBucketsObject(m, h); // Get buckets
i = 0; // Restart scan
H = N; // Address new position of hash
}
}
}
reallocObject(m, h, getMinimumHashSize(0), 0); // Reallocate object
H = addressHash(m, h); // Readdress hash
H->count = 0; // Reset count
H->iterator = MMU; // Reset iterator
cleanUp(m); // Clean up possible because no element is returned
}
/*
-----------------------------------------------------------------------
Get bucket number of first element from a hash at the start os a scan.
If the hash changes size during scan the elements will be rehashed and
the iterator position will become confused. So I lock the hash in place
during scan so its size cannot change. Deletes are permitted as they do
not require more space. Inserts have two problesms: the hash will
eventually need to be resized and new elements may get inserted behind
or in front of the scan pointer, and thus may or may not appear in the
scan. To avoid these problems, an insert of a new key will signal the
completion of the scan, any attempt to call getHashNext() without
calling getHashFirst() first will cause an exit.
This approach is similar to Perl's, wherein the current element may be
deleted and the action of an insert is not specified.
-----------------------------------------------------------------------
*/
UL getHashFirst(M **m, UL h)
{
Hash *H = addressHash(m, h); // Address hash
UL B = getHashBucketsObject(m, h); // Get buckets
{UL i;
for(i = 0; i < B; ++i) // Search for first key
{UL k = H->array[i].key; // Get key
if (k > 0) // First key
{H->iterator = i; // Set iterator
return 1;
}
}
}
// Empty hash because it contains no keys
clearHash(m, h); // Clear hash
return 0; // No keys
}
/*
-----------------------------------------------------------------------
Get next element from a hash
-----------------------------------------------------------------------
*/
UL getHashNext(M **m, UL h)
{
Hash *H = addressHash(m, h); // Address hash
UL B = getHashBucketsObject(m, h); // Get buckets
long i = H->iterator; // Iterated element
if (i == MMU) // No iterated element
{croak("Scan has been terminated due to insertion of a new key in hash %u", h);
}
{UL i;
for(i = H->iterator+1; i < B; ++i) // Search for next key
{UL k = H->array[i].key; // Get key
if (k > 0) // Next key
{H->iterator = i;
return 1;
}
}
}
H->iterator = MMU; // Clear iterator
return 0;
}
/*
-----------------------------------------------------------------------
Return 1 if we are scanning a hash, else 0
-----------------------------------------------------------------------
*/
UL scanHash(M **m, UL h)
{
Hash *H = addressHash(m, h); // Address hash
UL r = H->iterator < MMU; // Is an iterated element available?
return r;
}
/*
-----------------------------------------------------------------------
Get hash key from iterator
-----------------------------------------------------------------------
*/
UL getKey(M **m, UL h)
{
Hash *H = addressHash(m, h); // Address hash
if (H->iterator == MMU) // No iterated element
{croak("no iterated element available for hash object %u", h);
}
UL k = H->array[H->iterator].key;
return k;
}
/*
-----------------------------------------------------------------------
Get hash data from iterator
-----------------------------------------------------------------------
*/
UL getData(M **m, UL h)
{
Hash *H = addressHash(m, h); // Address hash
if (H->iterator == MMU) // No iterated element
{croak("no iterated element available for hash object %u", h);
}
UL d = H->array[H->iterator].data;
return d;
}
/*
------------------------------------------------------------------------
Test
------------------------------------------------------------------------
*/