This is gasman.c in view mode; [Download] [Up]
/****************************************************************************
**
*A gasman.c GAP source Martin Schoenert
**
*H @(#)$Id: gasman.c,v 3.23 1993/10/01 10:27:26 martin Rel $
**
*Y Copyright 1990-1992, Lehrstuhl D fuer Mathematik, RWTH Aachen, Germany
**
** This file contains the functions of GASMAN, the GAP storage manager.
**
** Gasman is the GAP storage manager. That means that the other parts of
** GAP request memory areas from Gasman. These are then filled with
** information. Gasman cares about the allocation of those memory areas and
** the collection of unused areas. Thus these operations are transparent to
** the rest of GAP, enabling the programmer to concentrate on his algorithm
** instead of caring about memory allocation and deallocation.
**
** The basic thing is the bag. This is simply a continous area of memory
** containing any information, including references to other bags. If a bag
** contains references to other bags these references are collected at the
** beginning of the bag. A bag together with all bags he references direct
** or indirect, is called an object. New bags are created with 'NewBag'.
**
** When you create a bag using 'NewBag' this functions returns a unique
** pointer identifying this bag, this pointer is called a handle and is of
** type 'TypHandle'. You specify this handle as first argument to every
** storage manager function as first argument. Variables containing handles
** should begin with 'hd' to make the code more readable.
**
** Every bag belongs to a certain type, specifying what information this bag
** contains and how bags of this type are evaluated. You specify the type
** when creating the bag, you can retrieve it using the macro 'TYPE'.
**
** Every bag has a size, which is the size of the memory area in bytes. You
** specify this size when you create the bag, you can change it later using
** 'Resize' and retrieve it later using the macro 'SIZE'.
**
*H $Log: gasman.c,v $
*H Revision 3.23 1993/10/01 10:27:26 martin
*H changed 'InitGasman' to avoid a HP-UX 9.01 CC compiler problem
*H
*H Revision 3.22 1993/05/05 17:08:49 martin
*H fixed size data for make ranges
*H
*H Revision 3.21 1993/03/19 17:30:30 martin
*H changed to of stack frames to 'T_EXEC'
*H
*H Revision 3.20 1993/03/11 13:01:21 fceller
*H added package mode
*H
*H Revision 3.19 1993/02/12 17:50:28 martin
*H added large permutations
*H
*H Revision 3.18 1993/02/04 10:51:10 martin
*H added the new list and extended types
*H
*H Revision 3.17 1992/12/08 11:40:54 martin
*H added '<list>{<positions>}'
*H
*H Revision 3.16 1992/04/29 09:09:11 martin
*H changed a few things to silence GCC
*H
*H Revision 3.15 1992/04/28 13:06:49 martin
*H added 'NrHandles' and 'CollectGarb' to the interface
*H
*H Revision 3.14 1992/04/28 10:35:00 martin
*H changed the 'Size' struct slightly (IBM RS/6000 compilers complained)
*H
*H Revision 3.13 1992/03/20 11:48:52 martin
*H fixed 'Size', its entries must also be exchanged
*H
*H Revision 3.12 1992/03/19 18:56:32 martin
*H changed the type numbers of 'T_FFE' and 'T_UNKNOWN'
*H
*H Revision 3.11 1991/11/05 11:20:42 jmnich
*H fixed GASMAN statistics
*H
*H Revision 3.10 1991/07/16 10:07:10 fceller
*H Only T_SWORD is needed, T_PCWORD is simulated.
*H
*H Revision 3.9 1991/06/27 12:41:49 fceller
*H New constant types 'T_SWORD' and 'T_PCWORD'.
*H
*H Revision 3.8 1991/04/30 16:12:21 martin
*H initial revision under RCS
*H
*H Revision 3.7 1991/01/18 12:00:00 fceller
*H replaced 'nqpres' by the polycyclic pres package
*H
*H Revision 3.6 1991/01/15 12:00:00 martin
*H added statistics to Gasman
*H
*H Revision 3.5 1990/12/20 12:00:00 martin
*H added the boolean list package
*H
*H Revision 3.4 1990/12/06 12:00:00 martin
*H added yet another list package
*H
*H Revision 3.3 1990/11/20 12:00:00 martin
*H added new list package
*H
*H Revision 3.2 1990/10/09 12:00:00 martin
*H added unknown package
*H
*H Revision 3.1 1990/09/27 12:00:00 martin
*H added new cyclotomics package
*H
*H Revision 3.0 1990/08/28 12:00:00 martin
*H changed garbage collector message to fit on a line
*H
*/
#include "system.h" /* system dependent functions */
#include "gasman.h" /* declaration part of the package */
/****************************************************************************
**
** For every type of bags there is a symbolic name defined for this type.
** The types *must* be sorted in the following order:
**
** Type of the non-printing object: 'T_VOID',
** Types of objects that lie in a field: 'T_INT' to 'T_FFE',
** Types of objects that lie in a group: 'T_PERM' to 'T_AGWORD',
** Types of other unstructured objects: 'T_BOOL' to 'T_FUNCINT',
** Types of lists: 'T_LIST' to 'T_RANGE',
** Type of records: 'T_REC',
** Extended types of lists (see list.c): 'T_MATRIX' to 'T_LISTX'
** Types related to variables: 'T_VAR' to 'T_RECASS',
** Types of binary operators: 'T_SUM' to 'T_COMM',
** Types of logical operators: 'T_NOT' to 'T_IN',
** Types of statements: 'T_FUNCCALL' to 'T_RETURN',
** Types of almost constants: 'T_MAKEPERM' to 'T_MAKEREC',
** Remaining types, order not important: 'T_CYCLE' to 'T_FREEBAG',
** First non assigned type: 'T_ILLEGAL'.
**
** The types of changable objects must lie between 'T_LIST' and 'T_VAR'.
** They are the types of objects that 'Copy' must really copy.
**
** The types of all constants, i.e., the types of all objects that can be
** the result of 'EVAL' must lie between 'T_INT' and 'T_VAR'. They are the
** indices into the dispatch tables of the binary operators.
**
** The possible types are defined in the declaration part of this package as
** follows:
**
#define T_VOID 0
#define T_INT 1
#define T_INTPOS 2
#define T_INTNEG 3
#define T_RAT 4
#define T_CYC 5
#define T_UNKNOWN 6
#define T_FFE 7
#define T_PERM16 8
#define T_PERM32 9
#define T_WORD 10
#define T_SWORD 11
#define T_AGWORD 12
#define T_BOOL 13
#define T_CHAR 14
#define T_FUNCTION 15
#define T_FUNCINT 16
#define T_LIST 17
#define T_SET 18
#define T_VECTOR 19
#define T_VECFFE 20
#define T_BLIST 21
#define T_STRING 22
#define T_RANGE 23
#define T_REC 24
#define T_MATRIX 25
#define T_MATFFE 26
#define T_LISTX 27
#define T_VAR 28
#define T_VARAUTO (T_VAR+ 1)
#define T_VARASS (T_VAR+ 2)
#define T_LISTELM (T_VAR+ 3)
#define T_LISTELML (T_VAR+ 4)
#define T_LISTELMS (T_VAR+ 5)
#define T_LISTELMSL (T_VAR+ 6)
#define T_LISTASS (T_VAR+ 7)
#define T_LISTASSL (T_VAR+ 8)
#define T_LISTASSS (T_VAR+ 9)
#define T_LISTASSSL (T_VAR+10)
#define T_RECELM (T_VAR+11)
#define T_RECASS (T_VAR+12)
#define T_SUM (T_VAR+13)
#define T_DIFF (T_SUM+ 1)
#define T_PROD (T_SUM+ 2)
#define T_QUO (T_SUM+ 3)
#define T_MOD (T_SUM+ 4)
#define T_POW (T_SUM+ 5)
#define T_COMM (T_SUM+ 6)
#define T_NOT (T_SUM+ 7)
#define T_AND (T_NOT+ 1)
#define T_OR (T_NOT+ 2)
#define T_EQ (T_NOT+ 3)
#define T_NE (T_NOT+ 4)
#define T_LT (T_NOT+ 5)
#define T_GE (T_NOT+ 6)
#define T_LE (T_NOT+ 7)
#define T_GT (T_NOT+ 8)
#define T_IN (T_NOT+ 9)
#define T_FUNCCALL (T_NOT+10)
#define T_STATSEQ (T_FUNCCALL+ 1)
#define T_IF (T_FUNCCALL+ 2)
#define T_FOR (T_FUNCCALL+ 3)
#define T_WHILE (T_FUNCCALL+ 4)
#define T_REPEAT (T_FUNCCALL+ 5)
#define T_RETURN (T_FUNCCALL+ 6)
#define T_MAKEPERM (T_FUNCCALL+ 7)
#define T_MAKEFUNC (T_MAKEPERM+ 1)
#define T_MAKELIST (T_MAKEPERM+ 2)
#define T_MAKESTRING (T_MAKEPERM+ 3)
#define T_MAKERANGE (T_MAKEPERM+ 4)
#define T_MAKEREC (T_MAKEPERM+ 5)
#define T_CYCLE (T_MAKEPERM+ 6)
#define T_FF (T_CYCLE+ 1)
#define T_AGEN (T_CYCLE+ 2)
#define T_AGGRP (T_CYCLE+ 3)
#define T_PCPRES (T_CYCLE+ 4)
#define T_AGEXP (T_CYCLE+ 5)
#define T_AGLIST (T_CYCLE+ 6)
#define T_RECNAM (T_CYCLE+ 7)
#define T_EXEC (T_CYCLE+ 8)
#define T_FREEBAG (T_EXEC+ 1)
#define T_ILLEGAL (T_FREEBAG+ 1)
*/
/****************************************************************************
**
*T TypHandle . . . . . . . . . . . . . . type of the identification of a bag
**
** 'TypHandle' is the type of the pointer that identifies a bag. I.e.,
** every object has a handle and no two used bags have the same handle.
** This handle is returned by 'NewBag' and passed to every Gasman function
** to identify this bag.
**
** The handle of a is a pointer to a structure that contains the following
** important information for this bag:
**
** 'type' the type of this bag, the possible values are defined above.
** 'size' the size of this bag (this objects data block) in bytes.
** 'ptr' the pointer to the place where this objects data resides.
**
** The type 'TypHandle' is defined in the declaration part of this package
** as follows:
**
typedef struct TypHeader {
unsigned char type;
unsigned char name[3];
unsigned long size;
struct TypHeader * * ptr;
} * TypHandle;
*/
/****************************************************************************
**
*V SIZE_HD . . . . . . . . . . . . . . . . . . . . . . . . size of a handle
**
** 'SIZE_HD' is just short for 'sizeof(TypHandle)' which is used very often.
**
** 'SIZE_HD' is defined in the declaration part of this package as follows:
**
#define SIZE_HD ((unsigned long)sizeof(TypHandle))
*/
/****************************************************************************
**
*F TYPE( <hd> ) . . . . . . . . . . . . . . . . . return the type of a bag
**
** 'TYPE' returns the type of the the bag with the handle <hd>.
**
** Note that 'TYPE' is a macro, so do not call it with arguments that have
** sideeffects.
**
** 'TYPE' is defined in the declaration part of this package as follows:
**
#define TYPE(HD) (((long)(HD) & T_INT) ? T_INT : ((HD)->type))
*/
/****************************************************************************
**
*F SIZE( <hd> ) . . . . . . . . . . . . . . . . . return the size of a bag
**
** 'SIZE' returns the size of the bag with the handle <hd> in bytes.
**
** Note that 'SIZE' is a macro, so do not call it with arguments that have
** sideeffects.
**
** 'SIZE' is defined in the declaration part of this package as follows:
**
#define SIZE(HD) ((HD)->size)
*/
/****************************************************************************
**
*F PTR( <hd> ) . . . . . . . . . . . . . . . . . return the pointer to a bag
**
** 'PTR' returns the absolute memory address of the bag with handle <hd>.
** Using this pointer you can then read information from the bag or write
** information to it. The pointer is of type pointer to handles, i.e.,
** 'PTR(<hd>)[0]' is the handle of the first subbag of the bag, etc. If the
** bag contains data in a different format, you have to cast the pointer
** returned by 'PTR', e.g., '(long*)PTR(<hd>)'.
**
** Note that pointers are fragile as bags move during garbage collection,
** that is the value returned by 'PTR' might differ between two calls if
** 'NewBag', 'Resize', or any function that might call those functions, is
** called in between.
**
** Note that 'PTR' is a macro, so do not call it with arguments that have
** sideeffects.
**
** 'PTR' is defined in the declaration part of this package as follows:
**
#define PTR(HD) ((TypHandle*)((HD)->ptr))
*/
/****************************************************************************
**
*V NameType . . . . . . . . . . . . . . . . . . . printable name of a type
**
** 'NameType' is an array that contains for every possible type a printable
** name. Those names can be used, for example, in error messages.
*/
char * NameType [] = {
"void",
"integer", "integer (> 2^28)", "integer (< -2^28)",
"rational", "cyclotomic", "unknown",
"finite field element",
"permutation", "permutation",
"word", "sparse word", "agword",
"boolean", "character",
"function", "internal function",
"list", "set", "vector", "finite field vector", "boolean list",
"string", "range",
"record",
"matrix (extended)", "matffe (extended)", "list (extended)",
"variable", "autoread variable", "var assignment",
"list element", "list element", "sublist", "sublist",
"list assignment","list assignment","list assignment","list assignment",
"record element", "record assignment",
"+", "-", "*", "/", "mod", "^", "commutator",
"not", "and", "or", "=", "<>", "<", ">=", "<=", ">", "in",
"function call", "statement sequence", "if statement",
"for loop", "while loop", "repeat loop", "return statement",
"var permutation", "var function", "var list", "var string", "var range",
"var record",
"cycle", "finite field",
"abstract generator",
"aggroup", "polycyclic presentation",
"ag exponent vector", "ag exponent/generator",
"record name",
"stack frame",
"free bag"
};
/****************************************************************************
**
*V GasmanStat . . . . . . . . . . . . . . . . . . . . statistics of Gasman
**
** 'GasmanStat' are four arrays that contain statistical information from
** Gasman. This information can be printed with the function 'GASMAN'.
**
** 'GasmanStatAlive': number of alive bags
** 'GasmanStatASize': sum of the sizes of the alive bags
** 'GasmanStatTotal': total number of bags allocated since startup
** 'GasmanStatTSize': sum of the sizes of all the bags allocated
*/
unsigned long GasmanStatAlive [T_ILLEGAL];
unsigned long GasmanStatASize [T_ILLEGAL];
unsigned long GasmanStatTotal [T_ILLEGAL];
unsigned long GasmanStatTSize [T_ILLEGAL];
/****************************************************************************
**
*V Size . . . . . . . . . . . size of handle and data area of a bag, local
**
** 'Size' is an array, that contains for every possible type the information
** how large the handle area and the data area are.
**
** 'Size[<type>].handles' is the size of the handle area in bytes, i.e., the
** size of the part at the beginning of the bag which contains handles.
**
** 'Size[<type>].data' is the size of the data area in bytes, i.e., the size
** of the part following the handle area which stores arbitrary data.
**
** 'Size[<type>].name' is the name of the type <type>. This is useful when
** debugging GAP, but is otherwise ignored.
**
** For example, 'SIZE[T_FFE].handles' is 'SIZE_HD' and 'Size[T_FFE].data'
** is 'sizeof(short)', that means the finite field elements have one handle,
** referring to the finite field, and one short value, which is the value of
** this finite field element, i.e., the discrete logarithm.
**
** Either value may also be negative, which means that the size of the
** corresponding area has a variable size.
**
** For example, 'Size[T_VAR].handles' is 'SIZE_HD' and 'Size[T_VAR].data' is
** -1, which means that variable bags have one handle, for the value of the
** variable, and a variable sized data area, for the name of the identifier.
**
** For example, 'SIZE[T_LIST].handles' is '-SIZE_HD' and 'Size[T_LIST].data'
** is '0', which means that a list has a variable number of handles, for the
** elements of the list, and no other data.
**
** If both values are negative both areas are variable sized. The ratio of
** the sizes is fix, and is given by the ratio of the two values in 'Size'.
**
** I can not give you an example, because no such type is currently in use.
*/
struct {
long handles;
long data;
char name[4];
} Size [] = {
{ 0, 0, "voi" },
{ 0, 0, "123" },
{ 0, -1, "+12" },
{ 0, -1, "-12" },
{ 2*SIZE_HD, 0, "1/2" },
{ -SIZE_HD, -sizeof(short), "cyc" },
{ 0, sizeof(long), "unk" },
{ SIZE_HD, sizeof(short), "ffe" },
{ 0, -1, "prm" },
{ 0, -1, "prm" },
{ -SIZE_HD, 0, "wrd" },
{ SIZE_HD, -1, "swd" },
{ SIZE_HD, -1, "agw" },
{ 0, 0, "bol" },
{ 0, 1, "chr" },
{ -SIZE_HD, 2*sizeof(short), "-> " },
{ 0, sizeof(long), "fni" },
{ -SIZE_HD, 0, "[1]" },
{ -SIZE_HD, 0, "{1}" },
{ -SIZE_HD, 0, "vec" },
{ SIZE_HD, -1, "vff" },
{ SIZE_HD, -1, "bli" },
{ 0, -1, "str" },
{ 2*SIZE_HD, 0, "ran" },
{ -SIZE_HD, 0, "rec" },
{ -SIZE_HD, 0, "max" }, /* unused */
{ -SIZE_HD, 0, "mfx" }, /* unused */
{ -SIZE_HD, 0, "lsx" }, /* unused */
{ SIZE_HD, -1, "var" },
{ SIZE_HD, -1, "aut" },
{ 2*SIZE_HD, 0, "v:=" },
{ 2*SIZE_HD, 0, "l[]" },
{ 2*SIZE_HD, sizeof(long), "l[]" },
{ 2*SIZE_HD, 0, "l{}" },
{ 2*SIZE_HD, sizeof(long), "l{}" },
{ 2*SIZE_HD, 0, "l:=" },
{ 2*SIZE_HD, sizeof(long), "l:=" },
{ 2*SIZE_HD, 0, "l:=" },
{ 2*SIZE_HD, sizeof(long), "l:=" },
{ 2*SIZE_HD, 0, "r.e" },
{ 2*SIZE_HD, 0, "r:=" },
{ 2*SIZE_HD, 0, "+ " },
{ 2*SIZE_HD, 0, "- " },
{ 2*SIZE_HD, 0, "* " },
{ 2*SIZE_HD, 0, "/ " },
{ 2*SIZE_HD, 0, "mod" },
{ 2*SIZE_HD, 0, "^ " },
{ 2*SIZE_HD, 0, "com" },
{ SIZE_HD, 0, "not" },
{ 2*SIZE_HD, 0, "and" },
{ 2*SIZE_HD, 0, "or " },
{ 2*SIZE_HD, 0, "= " },
{ 2*SIZE_HD, 0, "<> " },
{ 2*SIZE_HD, 0, "< " },
{ 2*SIZE_HD, 0, ">= " },
{ 2*SIZE_HD, 0, "<= " },
{ 2*SIZE_HD, 0, "> " },
{ 2*SIZE_HD, 0, "in " },
{ -SIZE_HD, 0, "f()" },
{ -SIZE_HD, 0, ";;;" },
{ -SIZE_HD, 0, "if " },
{ 3*SIZE_HD, 0, "for" },
{ 2*SIZE_HD, 0, "whi" },
{ 2*SIZE_HD, 0, "rep" },
{ -SIZE_HD, 0, "ret" },
{ -SIZE_HD, 0, "mpr" },
{ -SIZE_HD, 2*sizeof(short), "mfu" },
{ -SIZE_HD, 0, "mls" },
{ 0, -1, "mst" },
{ -SIZE_HD, 0, "mrn" },
{ -SIZE_HD, 0, "mre" },
{ -SIZE_HD, 0, "cyc" },
{ 0, -1, "ff " },
{ SIZE_HD, -1, "gen" },
{ -SIZE_HD, 0, "agp" },
{ -SIZE_HD, 0, "pcp" },
{ 0, -1, "age" },
{ 0, -1, "agl" },
{ 0, -1, "rnm" },
{ -SIZE_HD, 0, "stk" },
{ 0, -1, "fre" }
};
/****************************************************************************
**
*F NrHandles( <type>, <size> ) . . . . . . . . . number of handles of a bag
**
** 'NrHandles' returns the number of handles of a bag with type <type> and
** size <size>. This is used in the garbage collection which needs to know
** the number to be able to mark all subobjects of a given object.
**
** 'NrHandles' uses the information stored in 'Size'.
*/
long NrHandles ( type, size )
unsigned int type;
unsigned long size;
{
register long hs, is;
hs = Size[type].handles;
if ( hs >= 0 ) return hs / SIZE_HD;
is = Size[type].data;
if ( is >= 0 ) return (size - is) / SIZE_HD;
return ( hs * (long)size / (hs + is) ) / SIZE_HD;
}
/****************************************************************************
**
*F EnterKernel() . . . . . . . . . . . establish lifetime scopes for objects
*F ExitKernel( <hd> ) . . . . . . . . . establish lifetime scopes for bags
*V HdNewHandles . . . . handle of the bag that contains new handles, local
*V NrNewHandles . . . . . . . . . . . . . . . number of new handles, local
**
** 'EnterKernel' and 'ExitKernel' are used by Gasman to decide which bags
** are still used and which can be thrown away during a garbage collection.
** These functions are used like brackets, i.e., for every 'EnterKernel'
** call there must follow exactely one corresponding 'ExitKernel' call.
**
** All bags created before the first call to 'EnterKernel' are never garbage
** collected. This rule ensures that all bags that are created during the
** initialization like the identifier table bag are never thrown away.
** Together with the rule that no subobject of a used object is not
** collected this ensures that no object that has a name at the GAP level,
** i.e., that is a subobject in the identifier table is thrown away.
**
** A bag created after a call to 'EnterKernel' is not collected before the
** corresponding 'ExitKernel' call. This rule ensures that no bag is thrown
** away before it could be entered into a superobject.
**
** If the handle passed to 'ExitKernel' is not 0 it is treated as though the
** corresponding bag has been created after the 'ExitKernel' call. This is
** important to save the result of a computation.
**
** If the handle passed to 'ExitKernel' has the special value 2, this means
** an error occured and the user quitted to the main read-eval-print-loop
** and that all bags execpt those created before the first 'EnterKernel'
** call and their subobjects are canidates for collection. I.e., it works
** as a meta-bracket closing all open 'EnterKernel' brackets.
**
** Calling 'EnterKernel' and 'ExitKernel' is done during evaluation of
** statments and GAP functions, they must not be called from elsewhere.
** Calling 'EnterKernel' but forgetting to call 'ExitKernel' will result in
** some bags being uncollectable, thereby eating up available space.
** Calling 'ExitKernel' with calling 'EnterKernel' will remove everthing
** that is absolutely neccessary for the storage manager to work.
**
** 'HdNewHandles' is the handle of the bag that contains the list of new
** handles.
**
** 'NrNewHandles' is the number of entries in that list.
*/
TypHandle HdNewHandles;
unsigned long NrNewHandles;
void EnterKernel ()
{
++NrNewHandles;
if ( SIZE_HD * NrNewHandles == SIZE(HdNewHandles) )
Resize( HdNewHandles, SIZE(HdNewHandles) + 4096 * SIZE_HD );
}
void ExitKernel ( hd )
TypHandle hd;
{
unsigned long i;
if ( hd != (TypHandle)2 ) {
while ( PTR(HdNewHandles)[--NrNewHandles] != 0 )
PTR(HdNewHandles)[NrNewHandles] = 0;
if ( hd != 0 )
PTR(HdNewHandles)[NrNewHandles++] = hd;
}
else {
i = NrNewHandles; NrNewHandles = 0;
while ( PTR(HdNewHandles)[NrNewHandles] != 0 )
++NrNewHandles;
while ( --i > NrNewHandles )
PTR(HdNewHandles)[i] = 0;
}
}
/****************************************************************************
**
*V HdFree . . . . . . . . . . . . . . . . . . handle of the free bag, local
**
** 'HdFree' is the handle of the free bag. This is always the last bag in
** memory. New bags are created by taking memory from the beginning of the
** free bag. The structure pointed to by the handle 'HdFree' on the other
** hand is always the first thing in memory.
*/
TypHandle HdFree;
/****************************************************************************
**
*V FreeHandle . . . . . . . . . . . . . first free handle structure, local
*V NrFreeHandle . . . . . . . . . . . . . . . . length of free list, local
**
** 'FreeHandle' is the first element on the list of free handle structures.
** They are linked through the 'PTR' field in that structure, i.e., the
** second free handle is '(TypHandle)PTR(FreeHandle)'. The last element
** on that list contains 0 in its 'PTR' field.
**
** 'NrFreeHandles' is the length of this free list, i.e., the number of free
** handle structures on the list that starts with 'FreeHandle'.
*/
TypHandle FreeHandle;
unsigned long NrFreeHandles;
/****************************************************************************
**
*V IsResizeCall . . . . . . . . . . . . . . currently resizing a bag, local
*V HdResize . . . . . . . . . . . . . . . . . . . handle for Resize, local
**
** 'IsResizeCall' is 1 if 'NewBag' is called from 'Resize' and 0 otherwise.
** This enables 'NewBag' to decide if it was called from 'Resize' or not.
** 'Resize' calls 'NewBag' if it is called to enlarge a bag. If called from
** 'Resize' 'NewBag' will not add the handle to the new handles list.
**
** 'HdResize' is used by 'NewBag' as handle for the newly created bag if it
** is called from 'Resize'. Thus 'NewBag' need not search for a free handle
** in this case.
*/
unsigned long IsResizeCall;
TypHandle HdResize;
/****************************************************************************
**
*V FirstBag . . . . . . . . . . . pointer to the first bag in memory, local
**
** 'FirstBag' is a pointer to the first bag, i.e., the one which is lowest
** in memory. As with any other bag you can get the handle of this bag
** with 'FirstBag[-1]'. This variable is needed, so that we know where to
** start sweeping the memory in a garbage collection.
*/
TypHandle * FirstBag;
/****************************************************************************
**
*F asStr( <int> ) . . . . . . . . . . convert an integer to a string, local
**
** 'asStr' converts the nonnegative integer <int> to a string and returns a
** pointer to it. The string contains always 6 characters, if neccessary it
** is filled with leading blanks. The string is placed in a static array,
** therefor subsequent calls to 'asStr' will overwrite the old string.
**
** This function is neccessary because Gasman functions must not call
** functions from the scanner, especially not 'Pr'.
*/
char * asStr ( i )
unsigned long i;
{
static char s [7];
s[0] = i < 100000 ? ' ' : '0' + i / 100000 % 10;
s[1] = i < 10000 ? ' ' : '0' + i / 10000 % 10;
s[2] = i < 1000 ? ' ' : '0' + i / 1000 % 10;
s[3] = i < 100 ? ' ' : '0' + i / 100 % 10;
s[4] = i < 10 ? ' ' : '0' + i / 10 % 10;
s[5] = '0' + i % 10;
s[6] = '\0';
return s;
}
/****************************************************************************
**
*F CollectGarb() . . . . . . . . . . . . . . . . . . . . collect the garbage
**
** 'CollectGarb' performs a garbage collection. This means it removes the
** unused bags from memory and compacts the used bags at the beginning.
*/
void CollectGarb ()
{
TypHandle first, last, h;
TypHandle * d, * s, * e;
long i;
unsigned long NrBags = 0;
if ( SyGasman ) SyFputs("#G collect garbage, ",3);
/* First we mark all bags that are reachable from the new handles bag. */
/* We manage a list of used bags, that begins with the new handles bag.*/
first = last = HdNewHandles;
PTR(last)[-1] = 0;
while ( first != 0 ) {
/* add all not yet marked subbags of this bag to the list */
for ( i = NrHandles(TYPE(first),SIZE(first))-1; i >= 0; --i ) {
h = PTR(first)[i];
if ( h != 0 && ((long)h & T_INT) == 0 && PTR(h)[-1] == h ) {
PTR(last)[-1] = h;
last = h;
PTR(last)[-1] = 0;
}
}
h = PTR(first)[-1];
PTR(first)[-1] = (TypHandle)((unsigned long)first + 1);
first = h;
++NrBags;
}
SyPinfo( 1, NrBags );
if ( SyGasman ) {
SyFputs( asStr(NrBags), 3 );
SyFputs( " used, ", 3 );
}
NrBags = 0;
/* Now we sweep the memory, i.e., we copy all bags downward to create */
/* a large free bag at the end of memory */
d = s = FirstBag-1;
while ( s < PTR(HdFree)-1 ) {
/* if the tag is 0 the bag is unused, we add handle to free list */
if ( ((long)*s & 3) == 0 ) {
#ifdef STAT
GasmanStatAlive[((TypHandle)((long)*s & ~3))->type]--;
GasmanStatASize[((TypHandle)((long)*s & ~3))->type]
-= ((TypHandle)((long)*s & ~3))->size;
#endif
((TypHandle)((long)*s & ~3))->ptr = (TypHandle*)FreeHandle;
((TypHandle)((long)*s & ~3))->type = T_ILLEGAL;
FreeHandle = (TypHandle)((long)*s & ~3);
s = s + (SIZE((TypHandle)((long)*s & ~3))+2*SIZE_HD-1) / SIZE_HD;
++NrBags;
++NrFreeHandles;
}
/* if the tag is 1 the bag is still used, we copy it from s to d */
else if ( ((long)*s & 3) == 1 ) {
((TypHandle)((long)*s & ~3))->ptr = d+1;
e = s + (SIZE((TypHandle)((long)*s & ~3))+2*SIZE_HD-1) / SIZE_HD;
*d++ = (TypHandle)((long)*s++ & ~3);
if ( d != s )
while ( s < e ) *d++ = *s++;
else
s = d = e;
}
/* if the tag is 2 this are the remains of a resize, we skip them */
else if ( ((long)*s & 3) == 2 ) {
s = s + ((long)*s + SIZE_HD) / SIZE_HD;
}
/* if the tag is 3 this is corrupted */
else {
SyFputs("Gasman: is caught off base by a bag with tag 3.\n",3);
SyExit( 1 );
}
}
SyPinfo( 2, NrBags );
if ( SyGasman ) {
SyFputs( asStr(NrBags), 3 );
SyFputs( " dead, ", 3 );
}
NrBags = 0;
/* Now we completed that job, the new free space starts at d. */
s = d+1;
e = PTR(HdFree);
while ( s < e ) *s++ = 0;
HdFree->size += (char*)PTR(HdFree) - (char*)(d+1);
HdFree->ptr = d+1;
PTR(HdFree)[-1] = HdFree;
SyPinfo( 3, SIZE(HdFree) );
SyPinfo( 4, ((long)PTR(HdFree)-(long)HdFree+SIZE(HdFree)) );
if ( SyGasman ) {
SyFputs(asStr(SIZE(HdFree)/1024),3);
SyFputs(" KB free, ",3);
SyFputs(asStr(((long)PTR(HdFree)-(long)HdFree+SIZE(HdFree))/1024),3);
SyFputs(" KB total\n",3);
}
}
/****************************************************************************
**
*F NewBag( <type>, <size> ) . . . . . . . . . . . . . . . create a new bag
**
** 'NewBag' allocates memory for a new bag of the type <type> and size
** <size>. Usually <type> is a symbolic constant defined in the file
** declaration file of this package. <size> is an unsigned long. 'NewBag'
** returns the handle of the new bag, which must be passed as first argument
** to all other Gasman functions identifying this bag. All entrys of the
** new bag are initialized to 0.
*/
unsigned long lastType, lastSize;
TypHandle NewBag ( type, size )
unsigned int type;
unsigned long size;
{
long needed, wished;
TypHandle hdBag;
TypHandle * s, * d, * e;
TypHandle h;
/* if 'NewBag' was called from 'Resize' use the special handle */
if ( IsResizeCall ) {
hdBag = HdResize;
}
/* get a free handle from the free list, unless the free list is empty */
else if ( FreeHandle != (TypHandle)0 ) {
hdBag = FreeHandle;
FreeHandle = (TypHandle)PTR(FreeHandle);
NrFreeHandles--;
}
/* perform a garbage collection to get new free handles */
else {
CollectGarb();
/* if a garbage collection did not free enough handles create new */
if ( NrFreeHandles < 20000 ) {
/* try to get that much free memory for new handles */
needed = (char*)FirstBag - (char*)HdFree;
/* if there is not enough memory get more from the system */
if ( SIZE(HdFree) < needed ) {
if ( SyGetmem( needed ) != (char*)-1 ) {
HdFree->size += needed;
}
else {
SyFputs("Gasman: has no handle for a bag of type ",3);
SyFputs(Size[type].name,3);
SyFputs(" and size ",3); SyFputs(asStr(size),3);
SyFputs(".\n",3);
SyExit( 1 );
}
}
/* move all bags upward to make room for the handles */
d = PTR(HdFree) + needed / SIZE_HD - 1;
s = PTR(HdFree) - 1;
e = (FirstBag-1);
while ( e <= s ) *d-- = *s--;
/* correct all the pointer in the handle structures */
for ( h = HdFree; h < (TypHandle)(FirstBag-1); ++h ) {
if ( h->type != T_ILLEGAL )
h->ptr += needed / SIZE_HD;
}
HdFree->size -= needed;
FirstBag = FirstBag + needed / SIZE_HD;
/* initialize free space with linked list of free handles */
d = (TypHandle*)h;
for ( ; h+2 < (TypHandle)(FirstBag-1); ++h ) {
h->ptr = (TypHandle*)(h+1);
h->type = T_ILLEGAL;
++NrFreeHandles;
}
h->ptr = (TypHandle*)FreeHandle;
FreeHandle = (TypHandle)d;
}
/* get a free handle */
hdBag = FreeHandle;
FreeHandle = (TypHandle)PTR(FreeHandle);
}
/* if there is not enough room perform a garbage collection */
if ( SIZE(HdFree) < size + SIZE_HD ) {
CollectGarb();
/* if it is still not enough get new from the operating system */
if ( SIZE(HdFree) < size + SIZE_HD ) {
/* absolutely required amount of memory */
needed = ( size + SIZE_HD - SIZE(HdFree) + 1023 ) & ~1023;
/* wished amount, such that 25\% stay free after allocation */
wished = ( ((char*)PTR(HdFree) - (char*)HdFree + size) / 4
+ size + SIZE_HD - SIZE(HdFree) + 1023 ) & ~1023;
/* try to get the wished amount, or at least the needed */
if ( SyGetmem( (long)wished ) != (char*)-1 ) {
HdFree->size += wished;
}
else if ( SyGetmem( (long)needed ) != (char*)-1 ) {
HdFree->size += needed;
}
else {
SyFputs("Gasman: has no space for a bag of type ",3);
SyFputs(Size[type].name,3);
SyFputs(" and size ",3); SyFputs(asStr(size),3);
SyFputs(".\n",3);
SyExit( 1 );
}
}
}
/* check that the long preceding the free bag has not been overwritten */
if ( PTR(HdFree)[-1] != HdFree ) {
SyFputs("Gasman: last bag of type ",3);
SyFputs(Size[lastType].name,3);
SyFputs(" and size ",3); SyFputs(asStr(lastSize),3);
SyFputs(" has overwritten the free bag.\n",3);
SyExit( 1 );
}
lastType = type; lastSize = size;
/* enter the information of the new bag in its header */
hdBag->type = type;
hdBag->name[0] = Size[type].name[0];
hdBag->name[1] = Size[type].name[1];
hdBag->name[2] = Size[type].name[2];
hdBag->size = size;
hdBag->ptr = HdFree->ptr;
PTR(hdBag)[-1] = hdBag;
/* adjust the size and the address of the free bag */
HdFree->name[0] = 'f';
HdFree->name[1] = 'r';
HdFree->name[2] = 'e';
HdFree->size -= (size + SIZE_HD + SIZE_HD-1) & ~(SIZE_HD-1);
HdFree->ptr += (size + SIZE_HD + SIZE_HD-1) / SIZE_HD;
PTR(HdFree)[-1] = HdFree;
/* enter hdBag in the NewHdBag, as not to throw it away to soon */
if ( ! IsResizeCall ) {
PTR(HdNewHandles)[NrNewHandles++] = hdBag;
if ( SIZE_HD * NrNewHandles == SIZE(HdNewHandles) )
Resize( HdNewHandles, SIZE(HdNewHandles) + 4096 * SIZE_HD );
}
#ifdef STAT
/* add some statistics */
GasmanStatAlive[type]++;
GasmanStatASize[type] += size;
GasmanStatTotal[type]++;
GasmanStatTSize[type] += size;
#endif
return hdBag;
}
/****************************************************************************
**
*F Retype( <hdBag>, <newType> ) . . . . . . . . . change the type of a bag
**
** 'Retype' changes the type of the bag with the handle <hdBag> to the new
** type <newType>. The handle, the size and also the absolute address of
** the bag does not change.
**
** Note that Gasman does not take any responsibility for this operation.
** It is the responsibility of the caller to make sure that the contents of
** the bag make good sense even after the retyping. 'Retype' should be used
** to temporary turn a negative integer into a positive one, converting an
** autoread variable into a normal after reading the file and similar stuff.
*/
void Retype ( hdBag, newType )
TypHandle hdBag;
unsigned int newType;
{
#ifdef STAT
/* update the statistics */
GasmanStatAlive[hdBag->type]--;
GasmanStatAlive[newType]++;
GasmanStatASize[hdBag->type] -= hdBag->size;
GasmanStatASize[newType] += hdBag->size;
GasmanStatTotal[hdBag->type]--;
GasmanStatTotal[newType]++;
GasmanStatTSize[hdBag->type] -= hdBag->size;
GasmanStatTSize[newType] += hdBag->size;
#endif
hdBag->type = newType;
}
/****************************************************************************
**
*F Resize( <hdBag>, <newSize> ) . . . . . . . . . change the size of a bag
**
** 'Resize' changes the size of the bag with the handle <hdBag> to the new
** size <newSize>. The handle of the bag does not change, but the absolute
** address might. New entries, whether in the handle area or in the date
** area are initializes to zero. If the size of the handle area of the bag
** changes 'Resize' will move the data area of the bag.
**
** Note that 'Resize' may cause a garbage collection if the bag is enlarged.
*/
void Resize ( hdBag, newSize )
TypHandle hdBag;
unsigned long newSize;
{
unsigned long oldSize;
unsigned char typeBag;
TypHandle hdNew;
TypHandle * s, * d, * e;
/* get the type and size of the old bag */
typeBag = TYPE(hdBag);
oldSize = SIZE(hdBag);
/* if the size in longwords does not change we just adjust the size */
if ( ((newSize + 3) & ~3) == ((oldSize + 3) & ~3) ) {
#ifdef STAT
/* update the statistics */
GasmanStatASize[typeBag] += newSize - oldSize;
#endif
hdBag->size = newSize;
}
/* if the new bag is smaller than the old one */
else if ( newSize < oldSize ) {
/* if the handle area shrinks we move the data area forward */
s = PTR(hdBag) + NrHandles(typeBag,oldSize);
e = PTR(hdBag) + (newSize + SIZE_HD-1)/SIZE_HD;
d = PTR(hdBag) + NrHandles(typeBag,newSize);
if ( d < s )
while ( d < e ) *d++ = *s++;
/* create a unused block with tag 2 */
*e = (TypHandle)(((oldSize+3)&~3) - ((newSize+3)&~3) - SIZE_HD + 2);
/* adjust the size of the bag */
hdBag->size = newSize;
#ifdef STAT
/* update the statistics */
GasmanStatASize[typeBag] += newSize - oldSize;
#endif
}
/* if the new bag is larger than the old one */
else {
/* create a new bag with the handle 'HdResize' */
IsResizeCall = 1;
hdNew = NewBag( typeBag, newSize );
IsResizeCall = 0;
/* copy the handle area */
s = PTR(hdBag);
e = PTR(hdBag) + NrHandles(typeBag,oldSize);
d = PTR(hdNew);
while ( s < e ) *d++ = *s++;
/* copy the data area */
s = e;
e = PTR(hdBag) + (oldSize + SIZE_HD-1)/SIZE_HD;
d = PTR(hdNew) + NrHandles(typeBag,newSize);
while ( s < e ) *d++ = *s++;
/* create an unused block with tag 2 */
PTR(hdBag)[-1] = (TypHandle)(((SIZE(hdBag) + 3) & ~3) + 2);
/* adjust pointer and size of the bag */
hdBag->ptr = hdNew->ptr;
hdBag->size = hdNew->size;
PTR(hdBag)[-1] = hdBag;
#ifdef STAT
/* update the statistics */
GasmanStatAlive[typeBag]--;
GasmanStatASize[typeBag] -= oldSize;
GasmanStatTotal[typeBag]--;
#endif
}
}
/****************************************************************************
**
*F InitGasman() . . . . . . . . . initialize dynamic memory manager package
**
** 'InitGasman' initializes Gasman, i.e., allocates some memory for the
** memory managment, and sets up the bags needed for the working of Gasman.
** This are the new handles bag, which remembers the handles of bags that
** must not be thrown away during a garbage collection and the free bag,
** from which the memory for newly created bags is taken by 'NewBag'.
** 'InitGasman' must only be called once from 'InitGap' right after
** initializing the scanner, but before everything else, as none of the
** storage manager functions work before calling 'InitGasman'.
*/
void InitGasman ()
{
/* first get some memory from the operating system */
if ( SyMemory < 32 * 1024 ) SyMemory = 32 * 1024;
SyMemory = (SyMemory + 1023) & ~1023;
HdFree = (TypHandle)SyGetmem( SyMemory );
if ( HdFree == (TypHandle)-1 ) {
SyFputs("Gasman: can not get memory for the initial workspace.\n",3);
SyExit( 1 );
}
/* the free bag initialy ocupies three quarter of the memory */
HdFree->type = T_FREEBAG;
HdFree->size = (3 * SyMemory / 4 - SIZE_HD) & ~(SIZE_HD-1);
/*C 1993/10/01 martin HP-UX 9.01 CC compiler has problems with */
/*C ee->ptr = (TypHandle*)((char*)HdFree + SyMemory - HdFree->size); */
HdFree->ptr = (TypHandle*)((char*)HdFree + (SyMemory - HdFree->size));
PTR(HdFree)[-1] = HdFree;
/* the first quarter of the memory is allocated for header structures */
for ( FreeHandle = HdFree+1;
FreeHandle+2 < (TypHandle)(PTR(HdFree)-1);
FreeHandle++ ) {
FreeHandle->ptr = (TypHandle*)(FreeHandle+1);
FreeHandle->type = T_ILLEGAL;
++NrFreeHandles;
}
FreeHandle = HdFree + 1;
/* create the new handles bag */
HdNewHandles = FreeHandle;
FreeHandle = (TypHandle)PTR(FreeHandle);
HdNewHandles->type = T_LIST;
HdNewHandles->size = 4096 * SIZE_HD;
HdNewHandles->ptr = HdFree->ptr;
PTR(HdNewHandles)[-1] = HdNewHandles;
HdFree->size -= 4096 * SIZE_HD + SIZE_HD;
HdFree->ptr += (4096 * SIZE_HD + SIZE_HD) / SIZE_HD;
PTR(HdFree)[-1] = HdFree;
FirstBag = PTR(HdNewHandles);
/* reserve one handle for resize operations */
HdResize = FreeHandle;
FreeHandle = (TypHandle)PTR(FreeHandle);
IsResizeCall = 0;
}
/****************************************************************************
**
*E Emacs . . . . . . . . . . . . . . . . . . . . . . . local emacs variables
**
** Local Variables:
** mode: outline
** outline-regexp: "*A\\|*F\\|*V\\|*T\\|*E"
** fill-column: 73
** fill-prefix: "** "
** eval: (local-set-key "\t" 'c-indent-command)
** eval: (local-set-key ";" 'electric-c-semi )
** eval: (local-set-key "{" 'electric-c-brace)
** eval: (local-set-key "}" 'electric-c-brace)
** eval: (hide-body)
** End:
*/
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.