github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-02-27 17:12:42 +00:00
Code Issues Projects Releases Wiki Activity

Cleans up deleteblock implementation to increase clarity

Browse Source 
Procedure can be static void as there was only an unused constant result.
  Uses consistent naming (_np) for native pointer equivalents of Lisp
    addresses, and better matches Lisp implementation naming of variables.
  Adds comments with a little explanation of what the code is doing.
This commit is contained in:
Nick Briggs
2025-07-18 10:09:41 -07:00
parent 357336b5f1
commit 1f18779eb8
2 changed files with 30 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
inc/gcfinaldefs.h
View File

@@ -4,7 +4,6 @@
void printarrayblock(LispPTR base);
LispPTR releasingvmempage(LispPTR ptr);
LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist);
LispPTR deleteblock(LispPTR base);
LispPTR linkblock(LispPTR base);
LispPTR makefreearrayblock(LispPTR block, DLword length);
LispPTR arrayblockmerger(LispPTR base, LispPTR nbase);

54
src/gcfinal.c
View File

@@ -51,7 +51,7 @@
#include "gccodedefs.h" // for reclaimcodeblock
#include "gcdata.h" // for DELREF, REC_GCLOOKUP
#include "gchtfinddefs.h" // for htfind, rec_htfind
#include "gcfinaldefs.h" // for arrayblockmerger, checkarrayblock, deleteblock
#include "gcfinaldefs.h" // for arrayblockmerger, checkarrayblock
#include "lispemul.h" // for LispPTR, NIL, T, POINTERMASK, DLword, ATOM_T
#include "llstkdefs.h" // for decusecount68k
#include "lspglob.h" // for FreeBlockBuckets_word, ArrayMerging_word
@@ -243,32 +243,38 @@ LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist) {
/* */
/* */
/************************************************************************/
LispPTR deleteblock(LispPTR base) {
struct arrayblock *bbase, *fbbase, *bbbase;
LispPTR fwd, bkwd, fbl, freeblocklsp;
LispPTR *freeblock;
bbase = (struct arrayblock *)NativeAligned4FromLAddr(base);
if ((bbase->arlen >= MINARRAYBLOCKSIZE) && (bbase->fwd != NIL)) {
fwd = bbase->fwd;
fbbase = (struct arrayblock *)NativeAligned4FromLAddr(fwd);
bkwd = bbase->bkwd;
bbbase = (struct arrayblock *)NativeAligned4FromLAddr(bkwd);
fbl = FreeBlockChainN(bbase->arlen);
freeblock = (LispPTR *)NativeAligned4FromLAddr(fbl);
freeblocklsp = POINTERMASK & *freeblock;
if (base == fwd) {
if (base == freeblocklsp)
*freeblock = NIL;
/*
* Removes "base", a block from the free list and
* adjusts the forward and backward pointers of the blocks behind and
* ahead of the deleted block.
* The forward and backward pointers of this deleted block are left
* dangling - as in the Lisp implementation. Also does not affect the
* inuse bit in header and trailer.
*/
static void deleteblock(LispPTR base) {
struct arrayblock *base_np, *f_np, *b_np;
LispPTR f, b, fbl, freeblock;
LispPTR *fbl_np;
base_np = (struct arrayblock *)NativeAligned4FromLAddr(base);
if ((base_np->arlen >= MINARRAYBLOCKSIZE) && (base_np->fwd != NIL)) {
f = base_np->fwd;
f_np = (struct arrayblock *)NativeAligned4FromLAddr(f);
b = base_np->bkwd;
b_np = (struct arrayblock *)NativeAligned4FromLAddr(b);
fbl = FreeBlockChainN(base_np->arlen);
fbl_np = (LispPTR *)NativeAligned4FromLAddr(fbl);
freeblock = POINTERMASK & *fbl_np;
if (base == f) {
if (base == freeblock)
*fbl_np = 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;
} else if (base == freeblock)
*fbl_np = f;
f_np->bkwd = b;
b_np->fwd = f;
}
return (NIL);
}
/************************************************************************/