[Vm-dev] MemoryAccess added as separate package in VMMaker SqueakSource project

[David T. Lewis]

On Sat, Dec 13, 2008 at 03:07:28PM -0800, Eliot Miranda wrote:
>  
> David,
>     can you hum a few bars on how the Smalltalk code looks using this and
> not using this?

There is no difference at all in the Smalltalk code. Only the generated C
is affected by changing from CPP macros to inlined Slang. See below for an
example.

> One of the things I hate most about Slang is the exposed bit twiddlng for
> object headers.  i.e. there is nothing that maps to the level of a C struct
> with bit fields.  In my Cog Stack interpreter I made a class
> InterpreterStackPage map to a struct.  this class is only a container.  I'd
> like to do the same for the object header so in Smalltalk one would have a
> proper object type that one could send messages like classFormatField and
> markBit to and have that map down onto a struct bitfield dereference which
> would improve readability in both Smalltalk and C.  Any thoughts on that?

Excellent idea. I'm afraid that MemoryAccess does nothing to address it, but
I see no reason that it can't be done, and it would probably be helpful in
migrating object headers from one format to another.

For an example of the effect of memory access macros implemented in Slang,
take as an example ObjectMemory>>accessibleObjectAfter: showing the effect
of longAt() implemented first as a macro, and then as as C code generated
from a method in class MemoryAccess.

=== Smalltalk (slang) source code ===
accessibleObjectAfter: oop 
	"Return the accessible object following the given object or 
	free chunk in the heap. Return nil when heap is exhausted."
	| obj |
	self inline: false.
	obj := self objectAfter: oop.
	[self oop: obj isLessThan: endOfMemory]
		whileTrue: [(self isFreeObject: obj) ifFalse: [^ obj].
			obj := self objectAfter: obj].
	^ nil

=== C code after normal code generation, relying on sqMemoryAccess.h macros ===

/*	Return the accessible object following the given object or 
	free chunk in the heap. Return nil when heap is exhausted. */

sqInt accessibleObjectAfter(sqInt oop) {
register struct foo * foo = &fum;
    sqInt obj;
    sqInt sz;
    sqInt header;
    sqInt sz1;
    sqInt header1;

	/* begin objectAfter: */
	if (DoAssertionChecks) {
		if ((((usqInt) oop)) >= (((usqInt) foo->endOfMemory))) {
			error("no objects after the end of memory");
		}
	}
	if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
		sz1 = (longAt(oop)) & AllButTypeMask;
	} else {
		/* begin sizeBitsOf: */
		header1 = longAt(oop);
		if ((header1 & TypeMask) == HeaderTypeSizeAndClass) {
			sz1 = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
			goto l2;
		} else {
			sz1 = header1 & SizeMask;
			goto l2;
		}
	l2:	/* end sizeBitsOf: */;
	}
	obj = (oop + sz1) + (foo->headerTypeBytes[(longAt(oop + sz1)) & TypeMask]);
	while ((((usqInt) obj)) < (((usqInt) foo->endOfMemory))) {
		if (!(((longAt(obj)) & TypeMask) == HeaderTypeFree)) {
			return obj;
		}
		/* begin objectAfter: */
		if (DoAssertionChecks) {
			if ((((usqInt) obj)) >= (((usqInt) foo->endOfMemory))) {
				error("no objects after the end of memory");
			}
		}
		if (((longAt(obj)) & TypeMask) == HeaderTypeFree) {
			sz = (longAt(obj)) & AllButTypeMask;
		} else {
			/* begin sizeBitsOf: */
			header = longAt(obj);
			if ((header & TypeMask) == HeaderTypeSizeAndClass) {
				sz = (longAt(obj - (BytesPerWord * 2))) & LongSizeMask;
				goto l1;
			} else {
				sz = header & SizeMask;
				goto l1;
			}
		l1:	/* end sizeBitsOf: */;
		}
		obj = (obj + sz) + (foo->headerTypeBytes[(longAt(obj + sz)) & TypeMask]);
	}
	return null;
}

=== C code generated with class MemoryAccess replacing macros in sqMemoryAccess.h ===

/*	Return the accessible object following the given object or 
	free chunk in the heap. Return nil when heap is exhausted. */

sqInt accessibleObjectAfter(sqInt oop) {
register struct foo * foo = &fum;
    sqInt obj;
    sqInt sz;
    sqInt header;
    sqInt sz1;
    sqInt header1;

	/* begin objectAfter: */
	if (DoAssertionChecks) {
		if ((((usqInt) oop)) >= (((usqInt) foo->endOfMemory))) {
			error("no objects after the end of memory");
		}
	}
	if (((((sqInt) ((((sqInt *) ((sqMemoryBase) + oop)))[0]))) & TypeMask) == HeaderTypeFree) {
		sz1 = (((sqInt) ((((sqInt *) ((sqMemoryBase) + oop)))[0]))) & AllButTypeMask;
	} else {
		/* begin sizeBitsOf: */
		header1 = ((sqInt) ((((sqInt *) ((sqMemoryBase) + oop)))[0]));
		if ((header1 & TypeMask) == HeaderTypeSizeAndClass) {
			sz1 = (((sqInt) ((((sqInt *) ((sqMemoryBase) + (oop - (BytesPerWord * 2)))))[0]))) & LongSizeMask;
			goto l2;
		} else {
			sz1 = header1 & SizeMask;
			goto l2;
		}
	l2:	/* end sizeBitsOf: */;
	}
	obj = (oop + sz1) + (foo->headerTypeBytes[(((sqInt) ((((sqInt *) ((sqMemoryBase) + (oop + sz1))))[0]))) & TypeMask]);
	while ((((usqInt) obj)) < (((usqInt) foo->endOfMemory))) {
		if (!(((((sqInt) ((((sqInt *) ((sqMemoryBase) + obj)))[0]))) & TypeMask) == HeaderTypeFree)) {
			return obj;
		}
		/* begin objectAfter: */
		if (DoAssertionChecks) {
			if ((((usqInt) obj)) >= (((usqInt) foo->endOfMemory))) {
				error("no objects after the end of memory");
			}
		}
		if (((((sqInt) ((((sqInt *) ((sqMemoryBase) + obj)))[0]))) & TypeMask) == HeaderTypeFree) {
			sz = (((sqInt) ((((sqInt *) ((sqMemoryBase) + obj)))[0]))) & AllButTypeMask;
		} else {
			/* begin sizeBitsOf: */
			header = ((sqInt) ((((sqInt *) ((sqMemoryBase) + obj)))[0]));
			if ((header & TypeMask) == HeaderTypeSizeAndClass) {
				sz = (((sqInt) ((((sqInt *) ((sqMemoryBase) + (obj - (BytesPerWord * 2)))))[0]))) & LongSizeMask;
				goto l1;
			} else {
				sz = header & SizeMask;
				goto l1;
			}
		l1:	/* end sizeBitsOf: */;
		}
		obj = (obj + sz) + (foo->headerTypeBytes[(((sqInt) ((((sqInt *) ((sqMemoryBase) + (obj + sz))))[0]))) & TypeMask]);
	}
	return null;
}