github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-05-01 14:16:47 +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); void printarrayblock(LispPTR base);
LispPTR releasingvmempage(LispPTR ptr); LispPTR releasingvmempage(LispPTR ptr);
LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist); LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist);
LispPTR deleteblock(LispPTR base);
LispPTR linkblock(LispPTR base); LispPTR linkblock(LispPTR base);
LispPTR makefreearrayblock(LispPTR block, DLword length); LispPTR makefreearrayblock(LispPTR block, DLword length);
LispPTR arrayblockmerger(LispPTR base, LispPTR nbase); LispPTR arrayblockmerger(LispPTR base, LispPTR nbase);

54
src/gcfinal.c
View File

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