home *** CD-ROM | disk | FTP | other *** search
- /* Kevo -- a prototype-based object-oriented language */
- /* (c) Antero Taivalsaari 1991-1993 */
- /* Some parts (c) Antero Taivalsaari 1986-1988 */
- /* memory.c: memory and object allocation internals */
-
- #include "global.h"
-
- /*--------------------------------------------------------------------------*/
- /* Memory allocation internals */
-
- char* mymalloc(size)
- int size;
- {
- char* addr;
-
- if (!(addr = (char*)malloc(size))) {
- SysBeep(1); SysBeep(1);
- fprintf(confile, "== Not enough memory (malloc request: %ld bytes) ==\n", size);
- if (!supervisor) {
- ownPrintf("-- Not enough memory");
- execute((*up)->errorVector);
- }
- ownLongJmp();
- }
- return addr;
- }
-
-
- char* mycalloc(nelem, elsize)
- int nelem;
- int elsize;
- {
- char* addr;
-
- if (!(addr = (char*)calloc(nelem, elsize))) {
- SysBeep(1); SysBeep(1);
- fprintf(confile, "== Not enough memory (calloc request: %ld bytes) ==\n", nelem*elsize);
- if (!supervisor) {
- ownPrintf("-- Not enough memory");
- execute((*up)->errorVector);
- }
- ownLongJmp();
- }
- return addr;
- }
-
-
- char* myrealloc(ptr, newsize)
- char* ptr;
- int newsize;
- {
- char* addr;
-
- if (!(addr = (char*)realloc(ptr, newsize))) {
- SysBeep(1); SysBeep(1);
- fprintf(confile, "== Not enough memory (realloc request: %ld bytes) ==\n", newsize);
- if (!supervisor) {
- ownPrintf("-- Not enough memory");
- execute((*up)->errorVector);
- }
- ownLongJmp();
- }
- return addr;
- }
-
-
- char* allocStrCpy(source)
- char* source;
- {
- char* target;
-
- target = (char*)mymalloc(strlen(source)+1);
- return(strcpy(target, source));
- }
-
-
- /*--------------------------------------------------------------------------*/
- /* Object-specific operations */
- /*
- These operations create, manipulate, and delete "non-object-oriented"
- objects (handle-store structures).
-
- For further info, see 'memory.h'.
- */
-
- /* createStore(): create an initialized store part for an object */
- /* Size is given in CELLS */
-
- /* inlined for speed (see the header file 'memory.h')
- STORE* createStore(size)
- int size;
- {
- return((STORE*)mycalloc(1, size*CELL));
- }
- */
-
-
- /* createPrimitive(): create a primitive object */
- /*
- Primitives refer to the C operation directly via their 'mfa'
- field. Unlike other objects, primitives do not have a separate
- store part. The size field 'sfa' is always zero.
- */
-
- OBJECT* createPrimitive(code)
- int* code;
- {
- OBJECT* newObject = (OBJECT*)mymalloc(sizeof(OBJECT));
-
- newObject->mfa = (STORE*)code; /* Address of the C function */
- newObject->sfa = 0; /* The size field of a primitive is zero */
-
- return(newObject);
- }
-
-
- /* createClosure(): create a closure object */
-
- OBJECT* createClosure(size)
- int size; /* how much space do we need (in CELLS) */
- {
- /* Allocate object */
- OBJECT* newObject = (OBJECT*)mymalloc(sizeof(OBJECT));
- STORE* newStore;
-
- /* Ensure that size is at least 1 */
- size = (size > 1) ? size : 1;
-
- /* Store 'exit' to the beginning of the newly allocated memory */
- newStore = createStore(size);
- newStore->efa = (int*)oExit;
-
- /* Set the fields needed for closure objects */
- newObject->mfa = newStore; /* Storage part for storing code */
- newObject->sfa = size; /* Size of storage part in cells */
-
- return(newObject);
- }
-
-
- /* copyObject(): shallow copy an existing object and its store part */
- /* this operation is needed for multitasking and prototype-based OOP */
-
- OBJECT* copyObject(oldObject)
- OBJECT* oldObject;
- {
- int size = oldObject->sfa;
- OBJECT* newObject = (OBJECT*)mymalloc(sizeof(OBJECT));
-
- if (size) { /* Object is not a primitive */
- STORE* newStore = createStore(size);
- int* newp = (int*)newStore;
- int* oldp = (int*)oldObject->mfa;
- int i;
-
- /* Copy old data to the new store part (shallow copy) */
- for (i = 0; i < size; i++) *newp++ = *oldp++;
-
- /* Set the fields needed for the new object */
- newObject->mfa = newStore; /* Duplicated storage part */
- newObject->sfa = size; /* Size of storage part in cells */
- }
- else { /* Object is a primitive */
- newObject->mfa = oldObject->mfa; /* Share the same C operation */
- /* newObject->sfa = 0; */ /* Size is automatically zero (=primitive) */
- }
-
- return(newObject);
- }
-
-
- /* deleteObject(): delete an existing object and its store part */
-
- void deleteObject(object)
- OBJECT* object;
- {
- /* if the object has a store part (= is not a primitive), free the store */
- if (object->sfa) free((STORE*)object->mfa);
- free(object);
- }
-
-
- /* resizeClosure(): resize the storage area of an existing object */
-
- void resizeClosure(object, newsize)
- OBJECT* object;
- int newsize; /* The new size of the storage area (in cells) */
- {
- int oldsize = object->sfa;
-
- /* If the new size is the same as the old size -> do nothing */
-
- /* Primitives (objects with size 0) cannot be resized at all */
- /* (since they do not have a store part) */
-
- /* Since the zero size implies that an object is a primitive */
- /* we do not allow size to be changed to zero */
-
- if (newsize == oldsize || oldsize == 0 || newsize < 1) return;
-
- object->mfa = (STORE*)myrealloc(object->mfa, newsize*CELL);
- object->sfa = newsize;
-
- /* Clear the possible newly allocated extra memory to zeros */
- while (oldsize < newsize) {
- int* ptr = (int*)object->mfa + oldsize++;
- *ptr = 0;
- }
- }
-
-
- /* Recognize an OOP object */
-
- int recognizeObject(object)
- OBJECT* object;
- {
- OBJECT* code;
-
- if (!object) return UNKNOWN;
- if (!object->mfa) return UNKNOWN;
- if (object->sfa == 0) return PRIMITIVE;
-
- code = (OBJECT*)object->mfa->efa;
- if (code == oREF) return REF;
- if (code == oVAR) return VAR;
- if (code == oSharedConst) return CONST;
- return METHOD;
- }
-
-