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

Adds URaid F command to print array block free list heads

Browse Source
This commit is contained in:
Nick Briggs
2025-07-19 17:50:55 -07:00
parent 3fad090a6c
commit f2bf026b07
3 changed files with 50 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
inc/gcfinaldefs.h
View File

@@ -2,6 +2,7 @@
#define GCFINALDEFS_H 1
#include "lispemul.h" /* for LispPTR, DLword */
void printarrayblock(LispPTR base);
void printfreeblockchainn(int arlen);
LispPTR releasingvmempage(LispPTR ptr);
LispPTR checkarrayblock(LispPTR base, LispPTR free, LispPTR onfreelist);
LispPTR makefreearrayblock(LispPTR block, DLword length);

27
src/gcfinal.c
View File

@@ -610,3 +610,30 @@ void printarrayblock(LispPTR base) {
addr++;
for (; addr < (LispPTR *)trailer_np + 20; addr++) printf("%16p (0x%8x) %8x\n", (void *)addr, LAddrFromNative(addr), *addr);
}
static void printfreeblockchainhead(int index)
{
LispPTR fbl, freeblock;
LispPTR *fbl_np;
fbl = POINTERMASK & ((*FreeBlockBuckets_word) + (DLWORDSPER_CELL * index));
fbl_np = (LispPTR *)NativeAligned4FromLAddr(fbl);
/* lisp pointer to free block on chain */
freeblock = POINTERMASK & (*fbl_np);
if (freeblock == NIL) { /* no blocks in chain */
printf("Free block chain (bucket %d): NIL\n", index);
} else {
printf("Free block chain(bucket %d): 0x%x\n", index, freeblock);
}
}
void printfreeblockchainn(int arlen)
{
if (arlen >= 0) {
printfreeblockchainhead(BucketIndex(arlen));
return;
} else
for (int i = 0; i <= MAXBUCKETINDEX; i++) {
printfreeblockchainhead(i);
}
}

22
src/uraid.c
View File

@@ -168,6 +168,7 @@ static const char *URaid_summary2 =
"\n-- Memory display commands\n\
a litatom\t\tDisplays the top-level value of the litatom\n\
B Xaddress\t\tPrint the contents of the arrayblock at that address.\n\
F [size]\t\tPrint the head of the array free list chain for given size, or all\n\
d litatom\t\tDisplays the definition cell for the litatom\n\
M\t\t\tDisplays TOS,CSP,PVAR,IVAR,PC\n\
m func1 func2\t\tMOVD func1 to func2\n\
@@ -201,6 +202,7 @@ l [type]\t\tDisplays backtrace for specified type of stack. (k|m|r|g|p|u|<null>)
\n-- Memory display commands\n\
a litatom\t\tDisplays the top-level value of the litatom\n\
B Xaddress\t\tDisplays the contents of the arrayblock at that address.\n\
F [size]\t\tPrint the head of the array free list chain for given size, or all\n\
d litatom\t\tDisplays the definition cell of the litatom\n\
M\t\t\tDisplays TOS,CSP,PVAR,IVAR,PC\n\
m func1 func2\t\tMoves definition of func1 to func2 (MOVD)\n\
@@ -467,6 +469,26 @@ LispPTR uraid_commands(void) {
}
break;
case 'F': { /* print array block free list head(s) */
long size;
if (URaid_argnum != 1 && URaid_argnum != 2) {
printf("FREE-BLOCK-CHAIN: F [block-size (cells)]\n");
return (T);
}
if (URaid_argnum == 1) {
size = -1;
} else {
errno = 0;
size = (LispPTR)strtol(URaid_arg1, &endpointer, 0);
if (errno != 0 || *endpointer != '\0') {
printf("Arg not number\n");
return (T);
}
}
printfreeblockchainn(size);
}
break;
case 'd': /* DEFCELL */
if (URaid_argnum != 2) {
printf("GETD: d litatom\n");