mirror of
https://github.com/Interlisp/maiko.git
synced 2026-02-10 02:00:17 +00:00
Reformat all C source files with Clang-format in Google style w/ 100 col width.
This commit is contained in:
Nick Briggs
794
src/gcfinal.c
Executable file → Normal file
794
src/gcfinal.c
Executable file → Normal file
@@ -1,10 +1,7 @@
|
||||
/* $Id: gcfinal.c,v 1.3 1999/05/31 23:35:31 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
|
||||
/* $Id: gcfinal.c,v 1.3 1999/05/31 23:35:31 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved
|
||||
*/
|
||||
static char *id = "$Id: gcfinal.c,v 1.3 1999/05/31 23:35:31 sybalsky Exp $ Copyright (C) Venue";
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
|
||||
@@ -17,10 +14,8 @@ static char *id = "$Id: gcfinal.c,v 1.3 1999/05/31 23:35:31 sybalsky Exp $ Copyr
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
|
||||
#include "version.h"
|
||||
|
||||
|
||||
/*************************************************************************/
|
||||
/*************************************************************************/
|
||||
/* */
|
||||
@@ -67,58 +62,55 @@ static char *id = "$Id: gcfinal.c,v 1.3 1999/05/31 23:35:31 sybalsky Exp $ Copyr
|
||||
|
||||
#ifdef NEVER
|
||||
#define GetSegnuminColl(entry1) ((entry1 & 0x01fe) >> 1) /* segnum field */
|
||||
#define GetLinkptr(entry) (entry & 0x0fffe)
|
||||
#define GetCountinColl(entry1) ((entry1 & 0x0fc00) >> 10)
|
||||
#define Oddp(num) (((num % 2) != 0)?1:0)
|
||||
#define Evenp(num) (((num % 2) != 0)?0:1)
|
||||
#define STK_HI 1 /* This value also */
|
||||
#define WORDSPERCELL 2
|
||||
#define PADDING 4
|
||||
#define Boundp(frame_field) ((frame_field == 0)?1:0)
|
||||
#define GetLinkptr(entry) (entry & 0x0fffe)
|
||||
#define GetCountinColl(entry1) ((entry1 & 0x0fc00) >> 10)
|
||||
#define Oddp(num) (((num % 2) != 0) ? 1 : 0)
|
||||
#define Evenp(num) (((num % 2) != 0) ? 0 : 1)
|
||||
#define STK_HI 1 /* This value also */
|
||||
#define WORDSPERCELL 2
|
||||
#define PADDING 4
|
||||
#define Boundp(frame_field) ((frame_field == 0) ? 1 : 0)
|
||||
#endif /* NEVER */
|
||||
|
||||
|
||||
#define min(a,b) ((a > b)?b:a)
|
||||
#define Trailer(ldatum,datum68) (ldatum+2*(datum68->arlen - \
|
||||
ARRAYBLOCKTRAILERCELLS))
|
||||
#define BucketIndex(n) min(integerlength(n),MAXBUCKETINDEX)
|
||||
#define FreeBlockChainN(n) ((POINTERMASK & *FreeBlockBuckets_word)+ \
|
||||
2*BucketIndex(n))
|
||||
#define min(a, b) ((a > b) ? b : a)
|
||||
#define Trailer(ldatum, datum68) (ldatum + 2 * (datum68->arlen - ARRAYBLOCKTRAILERCELLS))
|
||||
#define BucketIndex(n) min(integerlength(n), MAXBUCKETINDEX)
|
||||
#define FreeBlockChainN(n) ((POINTERMASK & *FreeBlockBuckets_word) + 2 * BucketIndex(n))
|
||||
|
||||
#ifndef BYTESWAP
|
||||
#ifdef BIGVM
|
||||
struct buf {
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
unsigned noreference :1;
|
||||
unsigned usermapped :1;
|
||||
unsigned iodirty :1;
|
||||
unsigned unused :1;
|
||||
unsigned sysnext :28;
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
unsigned noreference : 1;
|
||||
unsigned usermapped : 1;
|
||||
unsigned iodirty : 1;
|
||||
unsigned unused : 1;
|
||||
unsigned sysnext : 28;
|
||||
};
|
||||
#else
|
||||
struct buf {
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
unsigned noreference :1;
|
||||
unsigned usermapped :1;
|
||||
unsigned iodirty :1;
|
||||
unsigned unused :5;
|
||||
unsigned sysnext :24;
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
unsigned noreference : 1;
|
||||
unsigned usermapped : 1;
|
||||
unsigned iodirty : 1;
|
||||
unsigned unused : 5;
|
||||
unsigned sysnext : 24;
|
||||
};
|
||||
#endif /* BIGVM */
|
||||
#else
|
||||
struct buf {
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
unsigned sysnext :24;
|
||||
unsigned unused :5;
|
||||
unsigned iodirty :1;
|
||||
unsigned usermapped :1;
|
||||
unsigned noreference :1;
|
||||
LispPTR filepage;
|
||||
LispPTR vmempage;
|
||||
LispPTR buffernext;
|
||||
unsigned sysnext : 24;
|
||||
unsigned unused : 5;
|
||||
unsigned iodirty : 1;
|
||||
unsigned usermapped : 1;
|
||||
unsigned noreference : 1;
|
||||
};
|
||||
#endif /* BYTESWAP */
|
||||
|
||||
@@ -126,24 +118,22 @@ void printarrayblock(LispPTR base);
|
||||
|
||||
/************* The following procedure is common !! **************************/
|
||||
|
||||
int integerlength(unsigned int n)
|
||||
{int cnt;
|
||||
if (n <= 2)
|
||||
return(n);
|
||||
else
|
||||
{cnt = 1;
|
||||
do
|
||||
{cnt++;
|
||||
n = (n >> 1);
|
||||
}while(n != 1);
|
||||
return(cnt);
|
||||
};
|
||||
int integerlength(unsigned int n) {
|
||||
int cnt;
|
||||
if (n <= 2)
|
||||
return (n);
|
||||
else {
|
||||
cnt = 1;
|
||||
do {
|
||||
cnt++;
|
||||
n = (n >> 1);
|
||||
} while (n != 1);
|
||||
return (cnt);
|
||||
};
|
||||
}
|
||||
|
||||
/************* The above procedure is common !! **************************/
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* f i n d p t r s b u f f e r */
|
||||
@@ -154,18 +144,18 @@ int integerlength(unsigned int n)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR findptrsbuffer(LispPTR ptr)
|
||||
{ struct buf *bptr;
|
||||
bptr = (struct buf *)Addr68k_from_LADDR(*System_Buffer_List_word);
|
||||
while(LADDR_from_68k(bptr) != NIL)
|
||||
{if (ptr == bptr->vmempage)
|
||||
return(LADDR_from_68k(bptr));
|
||||
else bptr = (struct buf *)Addr68k_from_LADDR(bptr->sysnext);};
|
||||
return(NIL);
|
||||
LispPTR findptrsbuffer(LispPTR ptr) {
|
||||
struct buf *bptr;
|
||||
bptr = (struct buf *)Addr68k_from_LADDR(*System_Buffer_List_word);
|
||||
while (LADDR_from_68k(bptr) != NIL) {
|
||||
if (ptr == bptr->vmempage)
|
||||
return (LADDR_from_68k(bptr));
|
||||
else
|
||||
bptr = (struct buf *)Addr68k_from_LADDR(bptr->sysnext);
|
||||
};
|
||||
return (NIL);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* r e l e a s i n g v m e m p a g e */
|
||||
@@ -177,19 +167,16 @@ LispPTR findptrsbuffer(LispPTR ptr)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR releasingvmempage(LispPTR ptr)
|
||||
{
|
||||
register struct buf *bptr;
|
||||
register LispPTR bufferptr = findptrsbuffer(ptr);
|
||||
|
||||
if (bufferptr == NIL) return(NIL); /* Not in use, OK to reclaim it */
|
||||
|
||||
bptr = (struct buf *)Addr68k_from_LADDR(bufferptr);
|
||||
bptr->noreference = T; /* Mark the buffer free to use ?? */
|
||||
return(ATOM_T);
|
||||
}
|
||||
LispPTR releasingvmempage(LispPTR ptr) {
|
||||
register struct buf *bptr;
|
||||
register LispPTR bufferptr = findptrsbuffer(ptr);
|
||||
|
||||
if (bufferptr == NIL) return (NIL); /* Not in use, OK to reclaim it */
|
||||
|
||||
bptr = (struct buf *)Addr68k_from_LADDR(bufferptr);
|
||||
bptr->noreference = T; /* Mark the buffer free to use ?? */
|
||||
return (ATOM_T);
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
@@ -199,228 +186,60 @@ LispPTR releasingvmempage(LispPTR ptr)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist)
|
||||
{struct arrayblock *bbase, *btrailer;
|
||||
struct arrayblock *bfwd, *bbwd, *rbase;
|
||||
LispPTR fbl;
|
||||
LispPTR *rover, *tmprover;
|
||||
LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist) {
|
||||
struct arrayblock *bbase, *btrailer;
|
||||
struct arrayblock *bfwd, *bbwd, *rbase;
|
||||
LispPTR fbl;
|
||||
LispPTR *rover, *tmprover;
|
||||
#ifdef ARRAYCHECK
|
||||
if (T)
|
||||
if (T)
|
||||
#else
|
||||
if (*Array_Block_Checking_word != NIL)
|
||||
if (*Array_Block_Checking_word != NIL)
|
||||
#endif
|
||||
{
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
btrailer=(struct arrayblock *)Addr68k_from_LADDR(Trailer(base,bbase));
|
||||
bfwd = (struct arrayblock *)Addr68k_from_LADDR(bbase->fwd);
|
||||
bbwd = (struct arrayblock *)Addr68k_from_LADDR(bbase->bkwd);
|
||||
if (bbase->password != ARRAYBLOCKPASSWORD)
|
||||
{
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK password wrong\n");
|
||||
}
|
||||
else if (bbase->inuse == free)
|
||||
{
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK INUSE bit set wrong\n");
|
||||
}
|
||||
else if (btrailer->password != ARRAYBLOCKPASSWORD)
|
||||
{
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK trailer password wrong\n");
|
||||
}
|
||||
else if (bbase->arlen != btrailer->arlen)
|
||||
{
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK Header and Trailer length don't match\n");
|
||||
}
|
||||
else if (btrailer->inuse == free)
|
||||
/* This is not original source.(in original,
|
||||
btrailer -> bbase) maybe, this is correction. */
|
||||
{
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK Trailer INUSE bit set wrong\n");
|
||||
}
|
||||
else if (!onfreelist || (bbase->arlen < MINARRAYBLOCKSIZE))
|
||||
/* Remaining tests only for free list. */
|
||||
return(NIL);
|
||||
else if ((bbwd->fwd != base) || (bfwd->bkwd != base))
|
||||
{
|
||||
error("ARRAYBLOCK links fouled\n");
|
||||
}
|
||||
else
|
||||
{fbl = FreeBlockChainN(bbase->arlen);
|
||||
rover = tmprover = (LispPTR *)Addr68k_from_LADDR(fbl);
|
||||
/* GETBASEPTR */
|
||||
if ((*rover & POINTERMASK) == NIL)
|
||||
error("Free Block's bucket empty\n");
|
||||
do
|
||||
{if ((*rover & POINTERMASK) == base)
|
||||
return(NIL);
|
||||
checkarrayblock((*rover & POINTERMASK), T, NIL);
|
||||
rbase = (struct arrayblock *)Addr68k_from_LADDR(
|
||||
*rover & POINTERMASK);
|
||||
}while(((*rover = rbase->fwd)& POINTERMASK) !=
|
||||
(*tmprover & POINTERMASK));
|
||||
return(NIL);
|
||||
};
|
||||
};
|
||||
return(NIL);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR deleteblock(LispPTR base)
|
||||
{ struct arrayblock *bbase, *fbbase, *bbbase;
|
||||
LispPTR fwd,bkwd,fbl,freeblocklsp;
|
||||
LispPTR *freeblock;
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
if ((bbase->arlen >= MINARRAYBLOCKSIZE) && (bbase->fwd != NIL))
|
||||
{fwd = bbase->fwd;
|
||||
fbbase = (struct arrayblock *)Addr68k_from_LADDR(fwd);
|
||||
bkwd = bbase->bkwd;
|
||||
bbbase = (struct arrayblock *)Addr68k_from_LADDR(bkwd);
|
||||
fbl = FreeBlockChainN(bbase->arlen);
|
||||
freeblock = (LispPTR *)Addr68k_from_LADDR(fbl);
|
||||
freeblocklsp = POINTERMASK & *freeblock;
|
||||
if (base == fwd)
|
||||
{if (base == freeblocklsp)
|
||||
*freeblock = NIL;
|
||||
else error("GC error:deleting last list # FREEBLOCKLIST\n");
|
||||
return(NIL);
|
||||
}
|
||||
else
|
||||
if (base == freeblocklsp)
|
||||
*freeblock = fwd;
|
||||
fbbase->bkwd = bkwd;
|
||||
bbbase->fwd = fwd;
|
||||
}
|
||||
return(NIL);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR linkblock(LispPTR base)
|
||||
{ struct arrayblock *bbase,*fbbase,*tmpbase;
|
||||
LispPTR fbl,freeblocklsp;
|
||||
LispPTR *freeblock;
|
||||
if (*FreeBlockBuckets_word != NIL)
|
||||
{ bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
if (bbase->arlen < MINARRAYBLOCKSIZE)
|
||||
checkarrayblock(base, T, NIL);
|
||||
else
|
||||
{fbl = FreeBlockChainN(bbase->arlen);
|
||||
freeblock = (LispPTR *)Addr68k_from_LADDR(POINTERMASK & fbl);
|
||||
freeblocklsp = POINTERMASK & (*freeblock);
|
||||
if (freeblocklsp == NIL)
|
||||
{bbase->fwd = base;
|
||||
bbase->bkwd = base;
|
||||
}
|
||||
else
|
||||
{fbbase = (struct arrayblock *)Addr68k_from_LADDR(freeblocklsp);
|
||||
bbase->fwd = freeblocklsp;
|
||||
bbase->bkwd = fbbase->bkwd;
|
||||
tmpbase = (struct arrayblock *)
|
||||
Addr68k_from_LADDR(fbbase->bkwd);
|
||||
tmpbase->fwd = base;
|
||||
fbbase->bkwd = base;
|
||||
};
|
||||
*freeblock = base;
|
||||
checkarrayblock(base, T, T);
|
||||
};
|
||||
};
|
||||
return(base);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR makefreearrayblock(LispPTR block, DLword length)
|
||||
{ LispPTR trailer;
|
||||
struct arrayblock *bbase;
|
||||
struct abdum *dbase;
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(block);
|
||||
dbase = (struct abdum *)WORDPTR(bbase);
|
||||
dbase->abflags = FREEARRAYFLAGWORD;
|
||||
bbase->arlen = length;
|
||||
trailer = Trailer(block,bbase);
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(trailer);
|
||||
dbase = (struct abdum *)WORDPTR(bbase);
|
||||
dbase->abflags = FREEARRAYFLAGWORD;
|
||||
bbase->arlen = length;
|
||||
return(block);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
|
||||
LispPTR arrayblockmerger(LispPTR base, LispPTR nbase)
|
||||
{ DLword arlens, narlens, secondbite, minblocksize, shaveback;
|
||||
struct arrayblock *bbase, *bnbase;
|
||||
{
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
bnbase = (struct arrayblock *)Addr68k_from_LADDR(nbase);
|
||||
arlens = bbase->arlen;
|
||||
narlens = bnbase->arlen;
|
||||
secondbite = MAXARRAYBLOCKSIZE - arlens;
|
||||
if (narlens > secondbite)
|
||||
{arlens = MAXARRAYBLOCKSIZE;
|
||||
narlens = narlens - secondbite;
|
||||
minblocksize = ((*Hunk_word == ATOM_T) ?
|
||||
(ARRAYBLOCKOVERHEADCELLS+MAXCELLSPERHUNK) :
|
||||
MINARRAYBLOCKSIZE);
|
||||
if (narlens < minblocksize)
|
||||
{shaveback = narlens - minblocksize;
|
||||
narlens = minblocksize;
|
||||
arlens += shaveback;
|
||||
secondbite += shaveback;
|
||||
};
|
||||
linkblock(makefreearrayblock(nbase+2*secondbite, narlens));
|
||||
narlens = 0;
|
||||
};
|
||||
return(linkblock(makefreearrayblock(base, arlens+narlens)));
|
||||
btrailer = (struct arrayblock *)Addr68k_from_LADDR(Trailer(base, bbase));
|
||||
bfwd = (struct arrayblock *)Addr68k_from_LADDR(bbase->fwd);
|
||||
bbwd = (struct arrayblock *)Addr68k_from_LADDR(bbase->bkwd);
|
||||
if (bbase->password != ARRAYBLOCKPASSWORD) {
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK password wrong\n");
|
||||
} else if (bbase->inuse == free) {
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK INUSE bit set wrong\n");
|
||||
} else if (btrailer->password != ARRAYBLOCKPASSWORD) {
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK trailer password wrong\n");
|
||||
} else if (bbase->arlen != btrailer->arlen) {
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK Header and Trailer length don't match\n");
|
||||
} else if (btrailer->inuse == free)
|
||||
/* This is not original source.(in original,
|
||||
btrailer -> bbase) maybe, this is correction. */
|
||||
{
|
||||
printarrayblock(base);
|
||||
error("ARRAYBLOCK Trailer INUSE bit set wrong\n");
|
||||
} else if (!onfreelist || (bbase->arlen < MINARRAYBLOCKSIZE))
|
||||
/* Remaining tests only for free list. */
|
||||
return (NIL);
|
||||
else if ((bbwd->fwd != base) || (bfwd->bkwd != base)) {
|
||||
error("ARRAYBLOCK links fouled\n");
|
||||
} else {
|
||||
fbl = FreeBlockChainN(bbase->arlen);
|
||||
rover = tmprover = (LispPTR *)Addr68k_from_LADDR(fbl);
|
||||
/* GETBASEPTR */
|
||||
if ((*rover & POINTERMASK) == NIL) error("Free Block's bucket empty\n");
|
||||
do {
|
||||
if ((*rover & POINTERMASK) == base) return (NIL);
|
||||
checkarrayblock((*rover & POINTERMASK), T, NIL);
|
||||
rbase = (struct arrayblock *)Addr68k_from_LADDR(*rover & POINTERMASK);
|
||||
} while (((*rover = rbase->fwd) & POINTERMASK) != (*tmprover & POINTERMASK));
|
||||
return (NIL);
|
||||
};
|
||||
};
|
||||
return (NIL);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
@@ -429,28 +248,33 @@ LispPTR arrayblockmerger(LispPTR base, LispPTR nbase)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR mergebackward(LispPTR base)
|
||||
{ LispPTR pbase;
|
||||
struct arrayblock *ptrailer;
|
||||
|
||||
ptrailer = (struct arrayblock *)Addr68k_from_LADDR(base -
|
||||
ARRAYBLOCKTRAILERWORDS);
|
||||
if (base == NIL)
|
||||
return(NIL);
|
||||
else if ((*ArrayMerging_word == NIL) || ((base == *ArraySpace_word) ||
|
||||
((base == *ArraySpace2_word) || (ptrailer->inuse == T))))
|
||||
return(linkblock(base));
|
||||
pbase = base - 2*ptrailer->arlen;
|
||||
checkarrayblock(pbase, T,NIL);
|
||||
deleteblock(pbase);
|
||||
return(arrayblockmerger(pbase, base));
|
||||
LispPTR deleteblock(LispPTR base) {
|
||||
struct arrayblock *bbase, *fbbase, *bbbase;
|
||||
LispPTR fwd, bkwd, fbl, freeblocklsp;
|
||||
LispPTR *freeblock;
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
if ((bbase->arlen >= MINARRAYBLOCKSIZE) && (bbase->fwd != NIL)) {
|
||||
fwd = bbase->fwd;
|
||||
fbbase = (struct arrayblock *)Addr68k_from_LADDR(fwd);
|
||||
bkwd = bbase->bkwd;
|
||||
bbbase = (struct arrayblock *)Addr68k_from_LADDR(bkwd);
|
||||
fbl = FreeBlockChainN(bbase->arlen);
|
||||
freeblock = (LispPTR *)Addr68k_from_LADDR(fbl);
|
||||
freeblocklsp = POINTERMASK & *freeblock;
|
||||
if (base == fwd) {
|
||||
if (base == freeblocklsp)
|
||||
*freeblock = NIL;
|
||||
else
|
||||
error("GC error:deleting last list # FREEBLOCKLIST\n");
|
||||
return (NIL);
|
||||
} else if (base == freeblocklsp)
|
||||
*freeblock = fwd;
|
||||
fbbase->bkwd = bkwd;
|
||||
bbbase->fwd = fwd;
|
||||
}
|
||||
return (NIL);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
@@ -459,27 +283,142 @@ LispPTR mergebackward(LispPTR base)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR mergeforward(LispPTR base)
|
||||
{ LispPTR nbase, nbinuse;
|
||||
struct arrayblock *bbase, *bnbase;
|
||||
LispPTR linkblock(LispPTR base) {
|
||||
struct arrayblock *bbase, *fbbase, *tmpbase;
|
||||
LispPTR fbl, freeblocklsp;
|
||||
LispPTR *freeblock;
|
||||
if (*FreeBlockBuckets_word != NIL) {
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
nbase = base + 2*(bbase->arlen);
|
||||
bnbase = (struct arrayblock *)Addr68k_from_LADDR(nbase);
|
||||
if ((*ArrayMerging_word == NIL) || ((base == NIL)
|
||||
|| (checkarrayblock(base, T, T) || ((nbase == *ArrayFrLst_word) ||
|
||||
((nbase == *ArrayFrLst2_word) ||
|
||||
(checkarrayblock(nbase, (! (nbinuse = bnbase->inuse)),NIL) ||
|
||||
nbinuse))))))
|
||||
return(NIL);
|
||||
deleteblock(nbase);
|
||||
deleteblock(base);
|
||||
return(arrayblockmerger(base, nbase));
|
||||
if (bbase->arlen < MINARRAYBLOCKSIZE)
|
||||
checkarrayblock(base, T, NIL);
|
||||
else {
|
||||
fbl = FreeBlockChainN(bbase->arlen);
|
||||
freeblock = (LispPTR *)Addr68k_from_LADDR(POINTERMASK & fbl);
|
||||
freeblocklsp = POINTERMASK & (*freeblock);
|
||||
if (freeblocklsp == NIL) {
|
||||
bbase->fwd = base;
|
||||
bbase->bkwd = base;
|
||||
} else {
|
||||
fbbase = (struct arrayblock *)Addr68k_from_LADDR(freeblocklsp);
|
||||
bbase->fwd = freeblocklsp;
|
||||
bbase->bkwd = fbbase->bkwd;
|
||||
tmpbase = (struct arrayblock *)Addr68k_from_LADDR(fbbase->bkwd);
|
||||
tmpbase->fwd = base;
|
||||
fbbase->bkwd = base;
|
||||
};
|
||||
*freeblock = base;
|
||||
checkarrayblock(base, T, T);
|
||||
};
|
||||
};
|
||||
return (base);
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR makefreearrayblock(LispPTR block, DLword length) {
|
||||
LispPTR trailer;
|
||||
struct arrayblock *bbase;
|
||||
struct abdum *dbase;
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(block);
|
||||
dbase = (struct abdum *)WORDPTR(bbase);
|
||||
dbase->abflags = FREEARRAYFLAGWORD;
|
||||
bbase->arlen = length;
|
||||
trailer = Trailer(block, bbase);
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(trailer);
|
||||
dbase = (struct abdum *)WORDPTR(bbase);
|
||||
dbase->abflags = FREEARRAYFLAGWORD;
|
||||
bbase->arlen = length;
|
||||
return (block);
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR arrayblockmerger(LispPTR base, LispPTR nbase) {
|
||||
DLword arlens, narlens, secondbite, minblocksize, shaveback;
|
||||
struct arrayblock *bbase, *bnbase;
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
bnbase = (struct arrayblock *)Addr68k_from_LADDR(nbase);
|
||||
arlens = bbase->arlen;
|
||||
narlens = bnbase->arlen;
|
||||
secondbite = MAXARRAYBLOCKSIZE - arlens;
|
||||
if (narlens > secondbite) {
|
||||
arlens = MAXARRAYBLOCKSIZE;
|
||||
narlens = narlens - secondbite;
|
||||
minblocksize =
|
||||
((*Hunk_word == ATOM_T) ? (ARRAYBLOCKOVERHEADCELLS + MAXCELLSPERHUNK) : MINARRAYBLOCKSIZE);
|
||||
if (narlens < minblocksize) {
|
||||
shaveback = narlens - minblocksize;
|
||||
narlens = minblocksize;
|
||||
arlens += shaveback;
|
||||
secondbite += shaveback;
|
||||
};
|
||||
linkblock(makefreearrayblock(nbase + 2 * secondbite, narlens));
|
||||
narlens = 0;
|
||||
};
|
||||
return (linkblock(makefreearrayblock(base, arlens + narlens)));
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR mergebackward(LispPTR base) {
|
||||
LispPTR pbase;
|
||||
struct arrayblock *ptrailer;
|
||||
|
||||
ptrailer = (struct arrayblock *)Addr68k_from_LADDR(base - ARRAYBLOCKTRAILERWORDS);
|
||||
if (base == NIL)
|
||||
return (NIL);
|
||||
else if ((*ArrayMerging_word == NIL) ||
|
||||
((base == *ArraySpace_word) || ((base == *ArraySpace2_word) || (ptrailer->inuse == T))))
|
||||
return (linkblock(base));
|
||||
pbase = base - 2 * ptrailer->arlen;
|
||||
checkarrayblock(pbase, T, NIL);
|
||||
deleteblock(pbase);
|
||||
return (arrayblockmerger(pbase, base));
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR mergeforward(LispPTR base) {
|
||||
LispPTR nbase, nbinuse;
|
||||
struct arrayblock *bbase, *bnbase;
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
nbase = base + 2 * (bbase->arlen);
|
||||
bnbase = (struct arrayblock *)Addr68k_from_LADDR(nbase);
|
||||
if ((*ArrayMerging_word == NIL) ||
|
||||
((base == NIL) ||
|
||||
(checkarrayblock(base, T, T) ||
|
||||
((nbase == *ArrayFrLst_word) ||
|
||||
((nbase == *ArrayFrLst2_word) ||
|
||||
(checkarrayblock(nbase, (!(nbinuse = bnbase->inuse)), NIL) || nbinuse))))))
|
||||
return (NIL);
|
||||
deleteblock(nbase);
|
||||
deleteblock(base);
|
||||
return (arrayblockmerger(base, nbase));
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
@@ -489,78 +428,66 @@ LispPTR mergeforward(LispPTR base)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR reclaimarrayblock(LispPTR ptr)
|
||||
{ LispPTR tmpptr, btrailer;
|
||||
struct arrayblock *base;
|
||||
LispPTR *tmpp;
|
||||
int reclaim_p;
|
||||
LispPTR reclaimarrayblock(LispPTR ptr) {
|
||||
LispPTR tmpptr, btrailer;
|
||||
struct arrayblock *base;
|
||||
LispPTR *tmpp;
|
||||
int reclaim_p;
|
||||
|
||||
reclaim_p = T;
|
||||
reclaim_p = T;
|
||||
#ifdef ARRAYCHECK
|
||||
checkarrayblock(ptr-ARRAYBLOCKHEADERWORDS, NIL, NIL);
|
||||
checkarrayblock(ptr - ARRAYBLOCKHEADERWORDS, NIL, NIL);
|
||||
#endif /* ARRAYCHECK */
|
||||
|
||||
base = (struct arrayblock *)Addr68k_from_LADDR(ptr-ARRAYBLOCKHEADERWORDS);
|
||||
base = (struct arrayblock *)Addr68k_from_LADDR(ptr - ARRAYBLOCKHEADERWORDS);
|
||||
#ifdef ARRAYCHECK
|
||||
if (HILOC(ptr) < FIRSTARRAYSEGMENT)
|
||||
{
|
||||
printarrayblock(ptr-ARRAYBLOCKHEADERWORDS);
|
||||
error("Bad array block reclaimed [not in array space].\nContinue with 'q' but save state ASAP. \n");
|
||||
return(T);
|
||||
}
|
||||
else if (ARRAYBLOCKPASSWORD != base->password)
|
||||
{
|
||||
printarrayblock(ptr-ARRAYBLOCKHEADERWORDS);
|
||||
error("Bad array block reclaimed [password wrong].\nContinue with 'q' but save state ASAP. \n");
|
||||
return(T);
|
||||
}
|
||||
else if (base->inuse == NIL)
|
||||
{
|
||||
printarrayblock(ptr-ARRAYBLOCKHEADERWORDS);
|
||||
error("Bad array block reclaimed [block not in use].\nContinue with 'q' but save state ASAP. \n");
|
||||
return(T);
|
||||
}
|
||||
#else
|
||||
/* Normal case, just tell the guy something's wrong: */
|
||||
if ((HILOC(ptr) < FIRSTARRAYSEGMENT) ||
|
||||
((ARRAYBLOCKPASSWORD != base->password) ||
|
||||
(base->inuse == NIL)))
|
||||
{
|
||||
error("Bad array block reclaimed--continue with 'q' but save state ASAP. \n");
|
||||
return(T);
|
||||
};
|
||||
#endif /* ARRAYCHECK */
|
||||
|
||||
|
||||
switch(base->gctype)
|
||||
{
|
||||
case PTRBLOCK_GCT:
|
||||
{btrailer = (ptr-2)+2*(base->arlen - ARRAYBLOCKTRAILERCELLS);
|
||||
tmpptr = ptr;
|
||||
do
|
||||
{
|
||||
tmpp = (LispPTR *)Addr68k_from_LADDR(tmpptr);
|
||||
/* GCLOOKUP(0x8000,DELREF, *tmpp);*/ /* added 8-Oct-87 TT */
|
||||
REC_GCLOOKUP(*tmpp, DELREF);
|
||||
*tmpp = NIL;
|
||||
tmpptr += 2;
|
||||
} while (tmpptr != btrailer);
|
||||
break;
|
||||
};
|
||||
case CODEBLOCK_GCT:
|
||||
reclaim_p = ((reclaimcodeblock(ptr) == NIL)?T:NIL);
|
||||
|
||||
|
||||
/* default: No Action */
|
||||
};
|
||||
if (reclaim_p == T)
|
||||
mergeforward(mergebackward(makefreearrayblock(
|
||||
ptr-ARRAYBLOCKHEADERWORDS
|
||||
,base->arlen)));
|
||||
return(T);
|
||||
if (HILOC(ptr) < FIRSTARRAYSEGMENT) {
|
||||
printarrayblock(ptr - ARRAYBLOCKHEADERWORDS);
|
||||
error(
|
||||
"Bad array block reclaimed [not in array space].\nContinue with 'q' but save state ASAP. "
|
||||
"\n");
|
||||
return (T);
|
||||
} else if (ARRAYBLOCKPASSWORD != base->password) {
|
||||
printarrayblock(ptr - ARRAYBLOCKHEADERWORDS);
|
||||
error("Bad array block reclaimed [password wrong].\nContinue with 'q' but save state ASAP. \n");
|
||||
return (T);
|
||||
} else if (base->inuse == NIL) {
|
||||
printarrayblock(ptr - ARRAYBLOCKHEADERWORDS);
|
||||
error(
|
||||
"Bad array block reclaimed [block not in use].\nContinue with 'q' but save state ASAP. \n");
|
||||
return (T);
|
||||
}
|
||||
#else
|
||||
/* Normal case, just tell the guy something's wrong: */
|
||||
if ((HILOC(ptr) < FIRSTARRAYSEGMENT) ||
|
||||
((ARRAYBLOCKPASSWORD != base->password) || (base->inuse == NIL))) {
|
||||
error("Bad array block reclaimed--continue with 'q' but save state ASAP. \n");
|
||||
return (T);
|
||||
};
|
||||
#endif /* ARRAYCHECK */
|
||||
|
||||
switch (base->gctype) {
|
||||
case PTRBLOCK_GCT: {
|
||||
btrailer = (ptr - 2) + 2 * (base->arlen - ARRAYBLOCKTRAILERCELLS);
|
||||
tmpptr = ptr;
|
||||
do {
|
||||
tmpp = (LispPTR *)Addr68k_from_LADDR(tmpptr);
|
||||
/* GCLOOKUP(0x8000,DELREF, *tmpp);*/ /* added 8-Oct-87 TT */
|
||||
REC_GCLOOKUP(*tmpp, DELREF);
|
||||
*tmpp = NIL;
|
||||
tmpptr += 2;
|
||||
} while (tmpptr != btrailer);
|
||||
break;
|
||||
};
|
||||
case CODEBLOCK_GCT:
|
||||
reclaim_p = ((reclaimcodeblock(ptr) == NIL) ? T : NIL);
|
||||
|
||||
/* default: No Action */
|
||||
};
|
||||
if (reclaim_p == T)
|
||||
mergeforward(mergebackward(makefreearrayblock(ptr - ARRAYBLOCKHEADERWORDS, base->arlen)));
|
||||
return (T);
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
@@ -570,18 +497,16 @@ LispPTR reclaimarrayblock(LispPTR ptr)
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
LispPTR reclaimstackp (LispPTR ptr) /* This is the entry function */
|
||||
/* in stack reclaiming */
|
||||
{
|
||||
register STACKP *stkp;
|
||||
register FX *fxp;
|
||||
stkp = (STACKP*)Addr68k_from_LADDR(ptr);
|
||||
fxp = (FX*)Addr68k_from_StkOffset( stkp->edfxp );
|
||||
decusecount68k(fxp); /* decrement the use-count for the frame it uses */
|
||||
return(NIL); /* and let the normal reclaimer reclaim it */
|
||||
}
|
||||
|
||||
|
||||
LispPTR reclaimstackp(LispPTR ptr) /* This is the entry function */
|
||||
/* in stack reclaiming */
|
||||
{
|
||||
register STACKP *stkp;
|
||||
register FX *fxp;
|
||||
stkp = (STACKP *)Addr68k_from_LADDR(ptr);
|
||||
fxp = (FX *)Addr68k_from_StkOffset(stkp->edfxp);
|
||||
decusecount68k(fxp); /* decrement the use-count for the frame it uses */
|
||||
return (NIL); /* and let the normal reclaimer reclaim it */
|
||||
}
|
||||
|
||||
/************************************************************************/
|
||||
/* */
|
||||
@@ -591,40 +516,33 @@ LispPTR reclaimstackp (LispPTR ptr) /* This is the entry function */
|
||||
/* */
|
||||
/************************************************************************/
|
||||
|
||||
void printarrayblock(LispPTR base)
|
||||
{
|
||||
struct arrayblock *bbase, *btrailer, *ptrailer;
|
||||
struct arrayblock *bfwd, *bbwd, *rbase;
|
||||
LispPTR *addr, *tmprover;
|
||||
void printarrayblock(LispPTR base) {
|
||||
struct arrayblock *bbase, *btrailer, *ptrailer;
|
||||
struct arrayblock *bfwd, *bbwd, *rbase;
|
||||
LispPTR *addr, *tmprover;
|
||||
|
||||
LispPTR pbase, nbase;
|
||||
LispPTR pbase, nbase;
|
||||
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
btrailer=(struct arrayblock *)Addr68k_from_LADDR(Trailer(base,bbase));
|
||||
ptrailer=(struct arrayblock *)Addr68k_from_LADDR(base-ARRAYBLOCKTRAILERWORDS);
|
||||
bfwd = (struct arrayblock *)Addr68k_from_LADDR(bbase->fwd);
|
||||
bbwd = (struct arrayblock *)Addr68k_from_LADDR(bbase->bkwd);
|
||||
bbase = (struct arrayblock *)Addr68k_from_LADDR(base);
|
||||
btrailer = (struct arrayblock *)Addr68k_from_LADDR(Trailer(base, bbase));
|
||||
ptrailer = (struct arrayblock *)Addr68k_from_LADDR(base - ARRAYBLOCKTRAILERWORDS);
|
||||
bfwd = (struct arrayblock *)Addr68k_from_LADDR(bbase->fwd);
|
||||
bbwd = (struct arrayblock *)Addr68k_from_LADDR(bbase->bkwd);
|
||||
|
||||
nbase = base + 2*bbase->arlen;
|
||||
pbase = base - 2*ptrailer->arlen;
|
||||
nbase = base + 2 * bbase->arlen;
|
||||
pbase = base - 2 * ptrailer->arlen;
|
||||
|
||||
printf("This array block: 0x%x. Previous: 0x%x. Next: 0x%x.\n",
|
||||
base, pbase, nbase);
|
||||
printf(" Length: %d cells.\n\n", bbase->arlen);
|
||||
printf("This array block: 0x%x. Previous: 0x%x. Next: 0x%x.\n", base, pbase, nbase);
|
||||
printf(" Length: %d cells.\n\n", bbase->arlen);
|
||||
|
||||
addr = ((LispPTR *) bbase) - 20;
|
||||
for (;addr<(LispPTR *)bbase; addr++)
|
||||
printf("0x%x %8x\n", addr, *addr);
|
||||
printf("0x%x %8x <- array header\n", addr, *addr++);
|
||||
for (; addr < (LispPTR *) bbase + 20; addr++)
|
||||
printf("0x%x %8x\n", addr, *addr);
|
||||
printf(". . .\n");
|
||||
addr = ((LispPTR *)bbase) - 20;
|
||||
for (; addr < (LispPTR *)bbase; addr++) printf("0x%x %8x\n", addr, *addr);
|
||||
printf("0x%x %8x <- array header\n", addr, *addr++);
|
||||
for (; addr < (LispPTR *)bbase + 20; addr++) printf("0x%x %8x\n", addr, *addr);
|
||||
printf(". . .\n");
|
||||
|
||||
addr = ((LispPTR *) btrailer) - 20;
|
||||
for (;addr<(LispPTR *)btrailer; addr++)
|
||||
printf("0x%x %8x\n", addr, *addr);
|
||||
printf("0x%x %8x <- array trailer\n", addr, *addr++);
|
||||
for (; addr < (LispPTR *) btrailer + 20; addr++)
|
||||
printf("0x%x %8x\n", addr, *addr);
|
||||
|
||||
}
|
||||
addr = ((LispPTR *)btrailer) - 20;
|
||||
for (; addr < (LispPTR *)btrailer; addr++) printf("0x%x %8x\n", addr, *addr);
|
||||
printf("0x%x %8x <- array trailer\n", addr, *addr++);
|
||||
for (; addr < (LispPTR *)btrailer + 20; addr++) printf("0x%x %8x\n", addr, *addr);
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user