This is gst.h in view mode; [Download] [Up]
/***********************************************************************
*
* GNU Smalltalk generic inclusions.
*
* $Revision: 1.6 $
* $Date: 1995/09/12 04:34:44 $
* $Author: sbb $
*
***********************************************************************/
/***********************************************************************
*
* Copyright (C) 1990, 1991, 1992, 1994, 1995 Free Software Foundation, Inc.
* Written by Steve Byrne.
*
* This file is part of GNU Smalltalk.
*
* GNU Smalltalk is free software; you can redistribute it and/or modify it
* under the terms of the GNU General Public License as published by the Free
* Software Foundation; either version 1, or (at your option) any later
* version.
*
* GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
* more details.
*
* You should have received a copy of the GNU General Public License along with
* GNU Smalltalk; see the file COPYING. If not, write to the Free Software
* Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
***********************************************************************/
/*
* Change Log
* ============================================================================
* Author Date Change
* sbb 30 Aug 95 Merged in Visual C++ changes.
*
* sbb 23 Jul 95 Removed mstconfig.h!!! Code is now not conditional on
* the presence of config.h.
*
* sbb 26 Jun 95 Switched EMPTY_BYTES to be 8 byte into the word
* instead of the low bytes to make the low bytes unused
* for use with the mark/sweep GC.
*
* sbb 23 Jun 95 Switched to GST header guard.
*
* sbb 31 May 95 Removed the old sysVersionMajor etc definitions --
* they are now defined in configure.in.
*
* sbb 31 May 95 Boolean replaced with mst_Boolean, objectClass =>
* mst_objectClass, Object => mst_Object. This thanks
* to the foresightful guys at the X consortium. Thanks
* guys for wantonly chewing up name space.
*
* sbb 31 Mar 95 Adjusted EMPTY_BYTES related constants to vary with
* hardware architecture.
*
* sbb 20 Jan 95 More changes for Dec Alpha 64bit architecture.
*
* sbb 4 Sep 94 More changes -- removed some old bcopy macro
* definitions, and switched more towards the autoconf
* based implementation.
*
* sbb 3 Sep 94 Switched to having version defines coming from the
* config.h file, and added the edit prefix string.
*
* sbb 3 Sep 94 Switched double size out, switched to use RETSIGTYPE,
* and WORDS_BIGENDIAN.
*
* sbb 31 Aug 94 Began switching to autoconf based approach.
*
* sbb 24 Aug 94 Added symbolic constants for max and min integer
* values representable in a Smalltalk Integer object.
*
* sbb 21 Aug 94 Switched to low order bit for int flagging.
*
* sbb 14 Sep 91 Added edit version support.
*
* sbyrne 23 Sep 89 Modifications to support operation on a DECstation 3100.
*
* sbyrne 13 Sep 89 Sigh!!! modified pushOOP and setStackTop to move the
* objects that they refer to to toSpace...good bye
* performance!
*
* sbyrne 29 Dec 88 Created.
*
*/
#ifndef __GST__
#define __GST__
#include "config.h"
/* AIX requires this to be the first thing in the file. */
#ifdef __GNUC__
# ifndef alloca
# define alloca __builtin_alloca
# endif
#else
# if HAVE_ALLOCA_H
# include <alloca.h>
# else
# ifdef _AIX
#pragma alloca
# else
# ifndef alloca /* predefined by HP cc +Olibcalls */
# if !defined(__OS2__) && !defined(_WIN32)
char *alloca ();
# else
# include <malloc.h> /* OS/2 defines alloca in here */
# endif
# endif
# endif
# endif
#endif
#if defined(HAVE_UNISTD_H)
#include <unistd.h>
#endif
/* Enable this definition to count different types of byte code executions */
/* #define countingByteCodes */
/* !!! this should be an enabled feature */
#ifndef HAVE_MEMCPY
#define memcpy(s1, s2, n) bcopy(s2, s1, n)
#define memset(s, ignored, l) bzero(s, l)
#endif /* HAVE_MEMCPY */
/* This use of _WIN32 is not all that elegant -- it's not clear why it doesn't
* define __STDC__ */
#if (defined (__STDC__) && __STDC__) || defined(_ANSI_C_SOURCE) || defined (__cplusplus) || defined(_WIN32)
#define __P(args) args
#define __const const
#define __signed signed
#define __volatile volatile
#define __DOTS , ...
#else /* Not ANSI C or C++. */
#define __P(args) () /* No prototypes. */
#define __const /* No ANSI C keywords. */
#define __signed
#define __volatile
#define __DOTS
#endif /* ANSI C or C++. */
/*#if !defined(__STDC__) && (defined(AIX) | defined(mips) | defined(ibm032) || (defined(sun) && !defined(SUNOS40))) */
#if !defined(__STDC__) && defined(OLDCC)
/* for older compilers that don't understand void * and enums are ints */
#define nil 0
typedef char *voidPtr;
#define ENUM_INT(x) ((int)(x))
typedef int mst_Boolean;
#define false 0
#define true 1
#else
typedef void *voidPtr;
/* old code #define nil (voidPtr)0 */
#define nil 0
/*old code#define ENUM_INT(x) (x)*/
#define ENUM_INT(x) ((int)(x))
typedef enum booleanType {
false,
true
} mst_Boolean;
#endif
/* Would someone (this means you!) please test this out on this machine and
* see if this can be merged with the code above a little more cleanly?
*/
#if defined(hp9000s300)
#undef ENUM_INT
#define ENUM_INT(x) ((int)(x))
#endif
typedef struct StreamStruct *Stream;
typedef struct OOPStruct *OOP;
typedef struct ObjectStruct *mst_Object;
#if SIZEOF_CHAR_P != SIZEOF_LONG
#error "Cannot compile: longs and pointer are different sizes"
#endif
/* Implementation note: on 64 bit architectures, bit-encoded 32 bit words
* are made to live in the low order 32 bits -- the high 32 bits are ignored,
* and are padded if necessary to achieve the useful stuff in the lower 32.
* This simplifies the current implementation, as most bit fields, both in C
* and in Smalltalk do not have to be modified when on a 64 bit architecture.
* Smalltalk Integers will be able to represent up to 62 bits + 1 sign bit.
*/
#if SIZEOF_LONG == 8
#define LONG_PAD_BIT_FIELDS /* pad bit fields to be 64 bits long */
#define LONG_SHIFT 3 /* bits to shift for a long or pointer */
#define BIG_LONGS 1
#else
#define LONG_SHIFT 2 /* bits to shift for a long or pointer */
#endif
struct OOPStruct {
mst_Object object;
#ifndef NO_FIELDS
unsigned long flags;
};
#define F_FREE ((unsigned long) 0x80000000)
/* XXX single addr space doesn't need these.
#define F_SPACE ((unsigned long) 0x40000000)
#define F_EVEN ((unsigned long) 0x20000000)
#define F_ODD ((unsigned long) 0x10000000)
*/
#define F_FAKE ((unsigned long) 0x08000000)
#define F_WEAK ((unsigned long) 0x04000000)
#define F_REACHABLE ((unsigned long) 0x02000000)
#if defined(BIG_LONGS)
#define EMPTY_BYTES ((unsigned long) 0x00000007)
#else
#define EMPTY_BYTES ((unsigned long) 0x00000003)
#endif
/* String related platform-specific definitions */
#define LONG_MOD sizeof(long)
/* This macro should only be used right after an allocOOP, when the
* emptyBytes field is guaranteed to be zero
*/
#define initEmptyBytes(oop, value) \
((oop)->flags |= (LONG_MOD - (value)) & EMPTY_BYTES)
/* Use this one to assign a particular value */
#define setEmptyBytes(oop, value) \
( (oop)->flags = ((oop)->flags & ~EMPTY_BYTES) | ((LONG_MOD - len) & EMPTY_BYTES) )
#else
union {
/* 26-Jun-95 07:27:49 appears to no longer be accurate */
struct {
#ifdef WORDS_BIGENDIAN
unsigned i_isFree : 1; /* pack these tighter as needed to make long */
/* XXX remove odd & even */
unsigned i_evenMark : 1; /* for OOP table garbage collector */
unsigned i_oddMark : 1; /* for OOP table garbage collector */
unsigned i_isWeak : 1; /* weak object reference */
char i_emptyBytes; /* 3(or7) number of unused bytes at end; subtract
from computed byte length to get the real
length of data */
char i_inSpace; /* 0 => space 0, 1 => space 1 */
#else
char i_inSpace; /* 0 => space 0, 1 => space 1 */
char i_emptyBytes; /* number of unused bytes at end; subtract
from computed byte length to get the real
length of data */
unsigned : 13;
unsigned i_isWeak : 1; /* weak object reference */
/* XXX remove odd & even */
unsigned i_oddMark : 1; /* for OOP table garbage collector */
unsigned i_evenMark : 1; /* for OOP table garbage collector */
unsigned i_isFree : 1; /* pack these tighter as needed to make long */
#endif
} w2_i;
/* long w2_prevFree; */
} w2;
};
#define isFree w2.w2_i.i_isFree
/* XXX no longer needed
#define evenMark w2.w2_i.i_evenMark
#define oddMark w2.w2_i.i_oddMark
*/
#define isWeak w2.w2_i.i_isWeak
#define emptyBytes w2.w2_i.i_emptyBytes
#define inSpace w2.w2_i.i_inSpace
/* #define prevFree w2.w2_prevFree */
#endif
/* The header of all objects in the system.
* Note how structural inheritance is achieved without adding extra levels of
* nested structures. */
#define OBJ_HEADER \
long objSize; /* for now, this is object size in 32bit words*/ \
OOP objClass
/* just for symbolic use in sizeof's */
typedef struct ObjectHeaderStruct {
OBJ_HEADER;
} ObjectHeader;
#define OBJ_HEADER_SIZE_WORDS (sizeof(ObjectHeader) / sizeof(long))
/* A bare-knuckles accessor for real objects */
struct ObjectStruct {
OBJ_HEADER;
OOP data[1]; /* variable length, may not be objects, but
will always be at least this big. */
};
/* the current execution stack pointer */
extern OOP *sp;
extern char *nilName;
/* some useful constants */
extern OOP nilOOP, trueOOP, falseOOP, thisClass;
/* This is TRUE if we are doing regression testing, and causes whatever sources
* of variance to be suppressed (such as printing out execution statistics).
*/
extern mst_Boolean regressionTesting;
#if defined(PROFBLOCK)
struct profStruct {
int numRealizes; /* number of methods realized */
int numRealizeCalls; /* #times realizeMethodC called */
int numThisContexts;
int numMethodAllocs; /* real malloc type allocations */
int numMethodReclaims; /* reclaims from free list */
int numMethodFrees;
int numBlockAllocs;
int numValues;
int stackSizeSum; /* sum at GC time of the saved stack pointers*/
int stackDepth; /* num records (blocks(?) and methods on stack*/
int maxStackDepth; /* the max it reaches ever */
double stackDepthAvgSum;
int numGCs;
};
extern struct profStruct ps;
#endif
typedef unsigned char Byte;
#define TreeNode void * /* dummy decl */
/*
* Macros for common things...can be functions for debugging or can be
* macros for speed.
*/
#ifndef NO_INLINE_MACROS
#define uncheckedPushOOP(oop) \
{ \
*++sp = (oop); \
}
#define uncheckedSetTop(oop) \
{ \
*sp = (oop); \
}
#define pushOOP(oop) \
uncheckedPushOOP(oop)
#define popOOP() \
(*sp--)
#define popNOOPs(n) \
sp -= (n)
#define unPop(n) \
sp += (n)
#define stackTop() \
(*sp)
#define setStackTop(oop) \
uncheckedSetTop(oop)
#define setStackTopInt(i) \
uncheckedSetTop(fromInt(i))
#define setStackTopBoolean(exp) \
uncheckedSetTop((exp) ? trueOOP : falseOOP)
#define stackAt(i) \
(sp[-(i)])
#define pushInt(i) \
uncheckedPushOOP(fromInt(i))
#define popInt() \
toInt(popOOP())
#define pushBoolean(exp) \
uncheckedPushOOP((exp) ? trueOOP : falseOOP)
#define oopToObj(oop) \
((oop)->object)
#define oopClass(oop) \
(oopToObj(oop)->objClass)
#define isClass(oop, class) \
(isOOP(oop) && oopClass(oop) == class)
/* Generally useful conversion functions */
#define size2Bytes(size) \
((size) << LONG_SHIFT)
#define bytes2Size(bytes) \
((bytes) >> LONG_SHIFT)
/* Turn on the mark bit in OBJ */
#define markObject(obj) \
(void *)(((char *)(obj)) + 1)
#define unmarkObject(obj) \
(void *)(((char *)(obj)) - 1)
#define isMarked(obj) \
isObjMarked((obj)->objClass)
#define isOOPMarked(oop) \
((oop)->flags & F_REACHABLE)
/* This leverages the current isInt implementation, and must be changed when
* isInt changes.
*/
#define isObjMarked(obj) \
isInt(obj)
/* integer conversions */
#define toInt(oop) \
((long)(oop) >> 1)
#define fromInt(i) \
(OOP)( ((long)(i) << 1) | 1)
/* Be sure to update these if you change the representation of Integer
* objects*/
#define MAX_ST_INT (( ((long) 1) << ((SIZEOF_LONG * 8) - 2) ) - 1)
#define MIN_ST_INT ( ~MAX_ST_INT)
#define incrInt(i) \
((i) + 2) /* 1 << 1 */
#define decrInt(i) \
((i) - 2)
#define isInt(oop) \
((long)(oop) & 1)
#define isOOP(oop) \
(! isInt(oop) )
/* general functions */
#define isNil(oop) \
((OOP)(oop) == nilOOP)
#define isFake(oop) \
((oop)->flags & F_FAKE)
/* return the number of availble longwords in object, excluding the header */
#define numOOPs(obj) \
( 1 + (obj)->objSize - (sizeof(struct ObjectStruct) / sizeof(mst_Object)) )
#endif /* NO_INLINE_MACROS */
#endif /* __GST__ */
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.