Adding integral bytes to foo pointers
Chris Torek
chris at umcp-cs.UUCP
Sun Sep 8 13:44:45 AEST 1985
>I have an application where I want to be able to save masses of objects
>most with lots of pointers in them to other objects, and then use this
>result to initialize the program the next time it runs. . . .
Here is a fairly hacky way we did this for Franz Lisp under 4.1BSD.
It has a couple of nonportable things in it (``but *I* didn't write
them,'' he protests): in particular, readint() is wrong; it assumes
32 bit integers; and it uses a free()d value in HashFree().
However, it does handle circular data structures and show how to
dump pointers to objects, then restore them.
Credit department: this idea was originated by Rehmi Post; the code
was rewritten by Craig Stanfill, Randy Trigg, and myself.
-------------------------------------------------------------------
/*
* This file contains C code for the lisp structure dumper package. The main
* lisp-callable functions are sdump and sscoop. The format is
* (sdump <lispobj> <filename>)
* (sscoop <filename>)
*
* Sdump takes a pointer to an (almost) arbitrary data structure in lisp and
* dumps the contents in binary to the file. It handles cons nodes, atoms
* (including value, pname, and plist), hunks, integers, and strings. It DOES
* watch out for cycles (using a hash table of pointers) and so will preserve
* any in the structure. Sscoop returns the pointer that was originally
* dumped.
*
* One weird feature: if an atom is actually a flavor then its property list
* is NOT followed. The check for flavor works by checking the plist of the
* atom for a property 'type' with value 'flavor'.
*/
#include <sys/types.h>
#include <stdio.h>
#include "global.h"
/*
* Give lisp the following to start 'er up:
* (cfasl 'strc.o '_init_strc 'init-strc "function")
* (init-strc)
*/
extern lispval matom(), inewint(), mstr(), newdot(), newhunk();
static int MaxHash;
static FILE *dumpfile;
typedef struct Bucket {
struct Bucket *next;
lispval lval;
int ival;
} bucket;
#define HashLog 9
#define HashMask ((1<<HashLog)-1)
#define HashTabSize (1<<HashLog)
#define HashFunc(x) (((x)>>4)&HashMask)
#define NODUMP 99
#define FLAVOR OTHER
#define NOTSEEN (-100)
#define readbyt() (getc(dumpfile))
#define printbyt(b) (putc(b,dumpfile))
#define printint(i) (putc(i,dumpfile),putc((i)>>8,dumpfile),\
putc((i)>>16,dumpfile),putc((i)>>24,dumpfile))
#define printptr(p) (printint((int)(p)))
#define MAXSTRLEN 2*STRBLEN+1
static bucket HashTable[HashTabSize];
static char locstrbuf[MAXSTRLEN];
/* clear all elements in this bucket */
static
HashFree(b)
register bucket *b;
{
while (b->next)
free(b = b->next);
}
/*
* called when sdumping - checks whether x is in the hash table - If so,
* return 1. If not, return 0 after installing.
*/
static
dump_seen(x)
register lispval x;
{
register bucket *buck1, *buck2;
register int i;
for (buck1 = &HashTable[HashFunc((int) x)], i = 0;
buck1->lval != x && buck1->next;
buck1 = buck1->next, i++)
/*void*/;
if (buck1->lval == x)
return (1);
if (MaxHash < i)
MaxHash = i;
buck2 = (bucket *) malloc(sizeof (bucket));
buck1->next = buck2;
buck2->next = 0;
buck2->lval = x;
return (0);
}
/*
* like the above, this searches down the hash table. The difference is that
* this one (called when scooping) returns the bucket itself - either the
* found bucket, or the new one just created.
*/
static bucket *
scoop_seen(x)
register int x;
{
register bucket *buck1, *buck2;
register int i;
for (buck1 = &HashTable[HashFunc((int) x)], i = 0;
buck1->ival != x && buck1->next;
buck1 = buck1->next, i++)
/*void*/;
if (buck1->ival == x)
return (buck1);
if (MaxHash < i)
MaxHash = i;
buck2 = (bucket *) malloc(sizeof (bucket));
buck1->next = buck2;
buck2->next = 0;
buck2->ival = x;
buck2->lval = (lispval) NOTSEEN;
return (buck2);
}
/*
* 'main' lisp-callable function to do the structure dumping - checks file
* arg and then calls dump with the first pointer.
*/
static lispval
Lsdump()
{
register int i;
char *dfile;
chkarg(2, "sdump");
if (TYPE(lbot[1].val) == ATOM)
dfile = lbot[1].val->a.pname;
else if (TYPE(lbot[1].val) == STRNG)
dfile = (char *) lbot[1].val;
else {
error("Improper file argument");
return (nil);
}
if ((dumpfile = fopen(dfile, "w")) == NULL) {
perror(dfile);
return (nil);
}
MaxHash = 0;
for (i = 0; i < HashTabSize; i++) {
if (HashTable[i].next) {
HashFree(HashTable[i]);
HashTable[i].next = 0;
}
HashTable[i].lval = 0;
}
printptr(lbot[0].val);
dump(lbot[0].val);
fclose(dumpfile);
return (inewint(MaxHash));
}
/* the */
static
dump(lispptr)
register lispval lispptr;
{
if (!dump_seen(lispptr))
switch (TYPE(lispptr)) {
case UNBO:
error("sdump: Can't handle this type: UNBO");
case STRNG:
printbyt(TYPE(lispptr));
printstr(lispptr);
break;
case ATOM:
dump_atom(lispptr);
break;
case INT:
printbyt(TYPE(lispptr));
printint(lispptr->i);
break;
case DTPR:
printbyt(TYPE(lispptr));
printptr(lispptr->d.car);
dump(lispptr->d.car);
printptr(lispptr->d.cdr);
dump(lispptr->d.cdr);
break;
case DOUB:
error("sdump: Can't handle this type: DOUB");
case BCD:
error("sdump: Can't handle this type: BCD");
case PORT:
error("sdump: Can't handle this type: PORT");
case ARRAY:
error("sdump: Can't handle this type: ARRAY");
case OTHER:
error("sdump: Can't handle this type: OTHER");
case SDOT:
error("sdump: Can't handle this type: SDOT");
case VALUE:
error("sdump: Can't handle this type: VALUE");
case HUNK2:
dump_hunk(2, lispptr);
break;
case HUNK4:
dump_hunk(4, lispptr);
break;
case HUNK8:
dump_hunk(8, lispptr);
break;
case HUNK16:
dump_hunk(16, lispptr);
break;
case HUNK32:
dump_hunk(32, lispptr);
break;
case HUNK64:
dump_hunk(64, lispptr);
break;
case HUNK128:
dump_hunk(128, lispptr);
break;
default:
error("Unknown type: sdump");
break;
}
}
/* dumps an atom or a flavor - in the latter case we don't dump plist */
static
dump_atom(ptr)
register lispval ptr;
{
switch (atomtype(ptr)) {
case NODUMP:
printbyt(NODUMP);
printstr(ptr->a.pname);
break;
case FLAVOR:
printbyt(FLAVOR);
printstr(ptr->a.pname);
printptr(ptr->a.clb);
if (ptr->a.clb != CNIL)
dump(ptr->a.clb);
break;
default:
printbyt(TYPE(ptr));
printstr(ptr->a.pname);
printptr(ptr->a.clb);
if (ptr->a.clb != CNIL)
dump(ptr->a.clb);
printptr(ptr->a.plist);
dump(ptr->a.plist);
}
}
/* run down hunk elements (num of them) dumping */
static
dump_hunk(num, ptr)
register int num;
register lispval ptr;
{
register int i;
printbyt(TYPE(ptr));
for (i = 0; i < num; i++) {
printptr(ptr->h.hunk[i]);
dump(ptr->h.hunk[i]);
}
}
/*
* check whether ptr has either the si:flavor (it's a flavor) or the $$NODUMP
* property. In the latter case we dump only the name, in the former, we
* also dump the value - neither dumps the plist
*/
static
atomtype(ptr)
register lispval ptr;
{
register lispval tmp;
int nodump = 0;
static beenhere;
static lispval tmptype, tmptype1;
if (!beenhere) {
beenhere++;
tmptype = matom("si:flavor");
tmptype1 = matom("$$NODUMP");
}
for (tmp = ptr->a.plist; tmp != nil; tmp = tmp->d.cdr->d.cdr)
if (tmp->d.car == tmptype)
return (FLAVOR);
else if (tmp->d.car == tmptype1)
nodump++;
return (nodump ? NODUMP : 0);
}
/* dumps a string with 0 at the end */
static
printstr(str)
register char *str;
{
do {
putc(*str, dumpfile);
} while (*str++);
}
/*
* the lisp-callable scoop'er - checks file arg and calls scoop with the
* first pointer in the file.
*/
static
lispval
Lsscoop()
{
lispval scoop(), ptr;
register int i;
char *dfile;
chkarg(1, "sscoop");
if (TYPE(lbot[0].val) == ATOM)
dfile = lbot[0].val->a.pname;
else if (TYPE(lbot[0].val) == STRNG)
dfile = (char *) lbot[0].val;
else {
error("Improper file argument");
return (nil);
}
if ((dumpfile = fopen(dfile, "r")) == NULL) {
perror(dfile);
return (nil);
}
/* clean out hash table */
MaxHash = 0;
for (i = 0; i < HashTabSize; i++) {
if (HashTable[i].next) {
HashFree(HashTable[i]);
HashTable[i].next = 0;
}
HashTable[i].lval = 0;
HashTable[i].ival = 0;
}
ptr = scoop(readint());
fclose(dumpfile);
return (ptr);
}
/*
* the scoop'ing workhorse - if seen before (present in hash table) then
* return the lispval entry in the hash table - otherwise, build the lispval
* and stick in hash table.
*/
static
lispval
scoop(iptr)
int iptr;
{
register lispval ptr1;
register bucket *buck;
int type, hunknum;
register i;
char *readstr();
buck = scoop_seen(iptr);
if (buck->lval != (lispval) NOTSEEN)
return (buck->lval);
switch (type = readbyt()) {
case STRNG:
return (buck->lval = mstr(readstr()));
break;
case NODUMP:
return (buck->lval = matom(readstr()));
break;
case ATOM:
buck->lval = ptr1 = matom(readstr());
if ((i = readint()) != (int) CNIL)
ptr1->a.clb = scoop(i);
else
ptr1->a.clb = CNIL;
ptr1->a.plist = scoop(readint());
return (ptr1);
break;
case FLAVOR:
buck->lval = ptr1 = matom(readstr());
if ((i = readint()) != (int) CNIL)
ptr1->a.clb = scoop(i);
else
ptr1->a.clb = CNIL;
return (ptr1);
break;
case INT:
return (buck->lval = inewint(readint()));
break;
case DTPR:
protect(buck->lval = ptr1 = newdot());
ptr1->d.car = scoop(readint());
ptr1->d.cdr = scoop(readint());
--np;
return (ptr1);
break;
case HUNK2:
case HUNK4:
case HUNK8:
case HUNK16:
case HUNK32:
case HUNK64:
case HUNK128:
hunknum = type - HUNK2;
protect(buck->lval = ptr1 = newhunk(hunknum));
for (i = 0; i < (2 << hunknum); i++)
ptr1->h.hunk[i] = scoop(readint());
--np;
return (ptr1);
break;
default:
error("unknown type in scoop");
}
}
/* reads one int as 4 bytes */
static
readint()
{
union {
int i;
char c[4];
} u;
u.c[0] = readbyt();
u.c[1] = readbyt();
u.c[2] = readbyt();
u.c[3] = readbyt();
return u.i;
}
/*
* reads a string - uses locstrbuf for storage. Size of locstrbuf is a
* function of STRBLEN (which is defined in global.h)
*/
static char *
readstr()
{
register char *s = locstrbuf;
while (*s++ = getc(dumpfile))
/*void*/;
return (locstrbuf);
}
/* initializer for this package - should call after doing cfasl */
lispval
init_strc()
{
mfun("sdump", Lsdump, lambda);
mfun("sscoop", Lsscoop, lambda);
}
--
In-Real-Life: Chris Torek, Univ of MD Comp Sci Dept (+1 301 454 4251)
UUCP: seismo!umcp-cs!chris
CSNet: chris at umcp-cs ARPA: chris at maryland
More information about the Comp.lang.c
mailing list