/* $Id: $ */
/* Copyright (C) 1997 Sverre Hvammen Johansen,
* Department of Informatics, University of Oslo.
*
* This program 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; version 2.
*
* This program 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 this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#include "cim.h"
#include "align.h"
#include "simfile.h"
/******************************************************************************
DO_FOR_STACK_POINTERS */
/* Denne rutinen g}r igjennom alle stakk-pekere og gj|r utf|rer rutinen
* doit for hver data peker.
* Denne rutinen kalles fra pass 1 og pass 3 i GBC.
* Dessuten kalles den ogs} fra add_to_pointers i det tilfellet
* at poolen blir flyttet */
static
do_for_stack_pointers (doit)
void (*doit) ();
{
int i,
ar,
at;
ar = __as >> 8 & 0xff;
at = __as & 0xff;
/* Behandler f|rst ref og text stakken */
for (i = ar; i; i--)
(*doit) (&__r[i]);
for (i = at; i; i--)
(*doit) ((__dhp *) & __t[i].obj);
}
/******************************************************************************
DO_FOR_EACH_POINTER */
/* Denne rutinen g}r igjennom alle pekere for et dataobjekt
* og utf|rer rutinen doit(_notest) for hver data peker.
* Denne rutinen kalles fra pass 1 og pass 3 i GBC.
* Dessuten kalles den ogs} fra add_to_pointers i det tilfellet
* at poolen blir flyttet */
__do_for_each_pointer (p, doit, doit_notest)
__dhp p;
void (*doit) (),
(*doit_notest) ();
{
__dhp *ph,
*qh;
static __pty ppx;
long i,
j;
switch ((int) p->pp)
{
case __TEXT:
break;
case __ARRAY:
ph = (__dhp *) ((char *) p + sizeof (__ah) +
(((__ahp) p)->dim * sizeof (__arrlimit)));
qh = (__dhp *) ((char *) p + ((__ahp) p)->size);
if (((__ahp) p)->type == __TREF)
{
for (; (char *) ph < (char *) qh; ph++)
(*doit) ((__dhp *) ph);
}
else if (((__ahp) p)->type == __TTEXT)
{
__txtvp th;
for (th = (__txtvp) ph; (char *) th < (char *) qh; th++)
(*doit) ((__dhp *) th);
}
break;
case __ACTS:
(*doit) (&p->dl);
/* peker stakken */
for (i = p->dt; i < (p->dt + p->pm + ((__shp) p)->at); i++)
(*doit) (&((__stkp) p)->s[i].r);
break;
case __THUNK:
/* Dynamisk link */
(*doit_notest) (&p->dl);
/* Statisk link */
(*doit_notest) (&p->sl);
case 0:
break;
default:
/* Dynamisk link */
(*doit_notest) (&p->dl);
/* Statisk link */
(*doit_notest) (&p->sl);
/* Pekertabellen */
j = 0;
for (ppx = p->pp; j <=
#if __CHAR_UNSIGNED__
(signed char)
#endif
p->pp->plev; ppx = p->pp->pref[j++])
for (i = 0; i < ppx->naref; i++)
{
(*doit) ((__dhp *) ((char *) p + ppx->ref[i]));
}
}
}
/******************************************************************************
GET_SIZE */
/* Denne rutinen finner st|rrelsen p} et data objekt inklusive alignment */
static long
get_size (p)
__dhp p;
{
long size;
switch ((int) p->pp)
{
case __TEXT:
size = ((__textref) p)->h.size + sizeof (__th) + 1;
break;
case __ARRAY:
size = ((__ahp) p)->size;
break;
case __ACTS:
size = ((__shp) p)->size;
break;
case __THUNK:
size = sizeof (__thunk);
break;
default:
size = p->pp->size;
};
return (align (size));
}
static __dhp p;
/******************************************************************************
DO_ADD_TO_LIST */
/* Brukes som parameter til do_for_stack_pointers og do_for_each_pointer
* for } f} lagt inn objekter som ikke allerede ligger i lista.
* Den gies som parameter til de to nevnte rutinene fra GBC pass 1.
* Den benytter seg av } kjede alle objekter sammen i en list ved
* hjelp av GB-ordet. Objekter blir kjedet inn rett bak p.
* P peker en hver tid p} det objektet som er under prosessering. */
static
do_add_to_list (qp)
__dhp *qp;
{
__dhp q;
if ((q = *qp) != __NULL)
if (q->gl == __NULL)
{
q->gl = p;
p = q;
};
}
/******************************************************************************
DO_UPDATE_POINTER */
/* Brukes som parameter til do_for_stack_pointers og do_for_each_pointer
* for } f} oppdatert samtlige pekere til et objekt.
* Den gies som parameter til de to nevnte rutinene fra GBC pass 3.
* Den benytter seg av at adressen (etter flytting av objektet)
* til et objekt ligger i objektets GB-ord.
* Denne informasjonen er lagt i GB-ordet av GBC pass 2 */
static
do_update_pointer (qp)
__dhp *qp;
{
if (*qp != __NULL)
*qp = (*qp)->gl;
}
/******************************************************************************
Rutine garbage collector (fire pas) */
/* GBC algoritme som best}r av 4 pass.
* 1. pass traverserer og merker alle aksesserbare pekere.
* 2. pass beregner ny posisjon til data-objektene.
* 3. pass oppdaterer pekere
* 4. pass skyver de aksesserbare objektene sammen */
void
__rgbc ()
{
static __dhp hppp;
static __dhp hpp;
static __dhp hp;
static __dhp q;
static long i,
j;
static long size;
static __pty ppx;
register __dhp *ph,
*qh; /* Brukes for } flytte objektene */
__gbctime -= __rcputime ();
__gc++;
/* PAS 1 */
p = &__nil;
do_add_to_list (&__lb);
do_add_to_list (&__pb);
do_add_to_list (&__sl);
do_add_to_list (&__er);
do_add_to_list (&__t1.obj);
do_add_to_list (&__t2.obj);
do_for_stack_pointers (do_add_to_list);
__do_for_each_stat_pointer (do_add_to_list, do_add_to_list, __FALSE);
__do_for_each_pointer (&__sysin, do_add_to_list, do_add_to_list);
__do_for_each_pointer (&__sysout, do_add_to_list, do_add_to_list);
__do_for_each_pointer (&__syserr, do_add_to_list, do_add_to_list);
while (p != &__nil)
{
q = p;
p = p->gl;
__do_for_each_pointer (q, do_add_to_list, do_add_to_list);
};
/* PAS 2 */
p = q = __min;
while (p < __fri)
{
size = get_size (p);
if (p->gl != __NULL)
{
p->gl = q;
q = (__dhp) ((char *) q + size);
}
p = (__dhp) ((char *) p + size);
};
__update_gl_to_obj ();
/* PAS 3 */
do_for_stack_pointers (do_update_pointer);
__do_for_each_stat_pointer (do_update_pointer, do_update_pointer, __FALSE);
__do_for_each_pointer (&__sysin, do_update_pointer, do_update_pointer);
__do_for_each_pointer (&__sysout, do_update_pointer, do_update_pointer);
__do_for_each_pointer (&__syserr, do_update_pointer, do_update_pointer);
p = __min;
while (p < __fri)
{
if (p->gl != __NULL)
__do_for_each_pointer (p, do_update_pointer, do_update_pointer);
p = (__dhp) ((char *) p + get_size (p));
};
do_update_pointer (&__lb);
do_update_pointer (&__pb);
do_update_pointer (&__sl);
do_update_pointer (&__er);
do_update_pointer (&__t1.obj);
do_update_pointer (&__t2.obj);
/* PAS 4 */
p = q = __min;
while (p < __fri)
{
size = get_size (p);
if (p->gl != __NULL)
{
p->gl = __NULL;
ph = (__dhp *) p;
qh = (__dhp *) q;
q = (__dhp) ((char *) q + size);
memmove ( (char *) qh,(char *) ph, size);
}
p = (__dhp) ((char *) p + size);
};
__fri = q;
__update_gl_to_null ();
/* Nuller resten av omr}det */
memset ((char *) __fri, 0, (char *) p - (char *) __fri);
__gbctime += __rcputime ();
}
/******************************************************************************
(DO)ADD_TO_POINTER */
/* Disse rutinene s|rger for at pekere blir oppdatert etter at pool'en er
* flyttet. Do_add_to_pointer brukes som parameter til do_for_stack_pointers
* og do_for_each_pointer, slik at pekerene blir oppdatert riktig.
* Legg merke til at det er kun de pekere
* som peker innenfor poolen som skal oppdateres.
* Denne oppdateringen gj|res ved } traversere samtlige objekter p}
* samme m}te som i GBC pass 3. */
static long disp;
static char *new_fri,
*new_min;
static
do_add_to_pointer (qp)
__dhp *qp;
{
if (*qp >= __min & *qp < __fri)
*qp = (__dhp) ((char *) (*qp) + disp);
}
static
add_to_pointers ()
{
char *p;
do_for_stack_pointers (do_add_to_pointer);
__do_for_each_stat_pointer (do_add_to_pointer, do_add_to_pointer, __TRUE);
__do_for_each_pointer (&__sysin, do_add_to_pointer, do_add_to_pointer);
__do_for_each_pointer (&__sysout, do_add_to_pointer, do_add_to_pointer);
__do_for_each_pointer (&__syserr, do_add_to_pointer, do_add_to_pointer);
p = new_min;
while (p < new_fri)
{
__do_for_each_pointer ((__dhp) p, do_add_to_pointer, do_add_to_pointer);
p = (char *) p + get_size ((__dhp) p);
};
do_add_to_pointer (&__sl);
do_add_to_pointer (&__lb);
do_add_to_pointer (&__pb);
}
/******************************************************************************
RutineAlloc */
/* Denne rutinen er basis rutinen for allokering av data fra Simula.
* Hvis det ikke er ledig plass i poolen s} blir GBC kalt.
* Hvis det fremdeles ikke er nokk plass eller at under halve plassen
* er frigjort fors|ker rutinen } utvide poolen ved } kalle realloc.
* Blir poolen flyttet s} blir add_to_pointers kalt for } oppdatere pekere,
* og nytt omr}de blir fylt med nuller. */
__dhp
__ralloc (size)
long size;
{
void __rgbc ();
static __dhp mem;
if (__sto != __NULL)
{
__dhp dp;
dp = __sto;
__sto = __NULL;
if (dp->pp != __NULL)
{
memset ((char *) dp, 0, size);
}
return (dp);
}
size = align (size);
if (((char *) __fri + size) > (char *) __max)
{
__rgbc ();
#if REALLOC
if (((char *) __fri - (char *) __min > (char *) __max - (char *) __fri)
|| (char *) __fri + size > (char *) __max)
{
long new_size,
*ph;
new_size = ((char *) __max - (char *) __min) * 2;
if (new_size - ((char *) __fri - (char *) __min) < size)
new_size += size;
if (new_size > __maxsize * 1024)
new_size = __maxsize * 1024;
if (new_size == ((char *) __max - (char *) __min))
new_min = __NULL;
else
new_min = (char *) realloc (__min, new_size);
if (new_min != __NULL)
{
disp = new_min - (char *) __min;
if (new_min != (char *) __min)
{
new_fri = (char *) __fri + disp;
new_min = (char *) __min + disp;
add_to_pointers ();
__fri = (__dhp) new_fri;
__min = (__dhp) new_min;
}
/* Nuller resten av omr}det */
ph = (long *) ((char *) __max + disp);
__max = (__dhp) (new_min + new_size);
memset ((char *) ph, 0, (char *) __max - (char *) ph);
__chpoolsize = __TRUE;
__poolsize = new_size / 1024;
}
}
#endif
if (((char *) __fri + size) > (char *) __max)
__rerror ("Alloc: Virtual memory exhausted");
}
mem = __fri;
__fri = (__dhp) (((char *) __fri) + size);
return (mem);
}
syntax highlighted by Code2HTML, v. 0.9.1