/*
* pack40 - takes in a 2 x 2 block of CV structs and packs it into a codeword
*/
extern uint64_t pack40(UArray_T block)
{
bitWord word = initialize_bitWord(block);
uint64_t codeword = pack_word(word);
free(word);
return codeword;
}
static OBJ parse(FILE *f, HASHTAB t, OBJ *ep){
OBJ d;
int shared;
d = read_obj(f,ep);
if (*ep) return NIL;
if (isVal(d)) {
return d;
} else if (isRefToCell(d)) {
WORD lab = getLabel(d);
int i; HASHENTRY e;
i = lab % HASHSIZE;
for (e = t->tab[i]; e; e = e->next) {
if (e->label == lab) {
/* increment RC of refered cell and return it. */
_incRc(_header(e->obj),1);
return e->obj;
}
}
/* Format error. */
copy_some(__ABinFile_AinvalidFormat,1);
*ep = __ABinFile_AinvalidFormat;
return NIL;
} else if ((shared = isSharedCell(d)) || isExclCell(d)) {
int sz = getSize(d), fs = getFlags(d), i;
intptr_t flds;
OBJ * data; OBJ ob; WORD lab;
if (shared) {
lab = (WORD)read_obj(f,ep);
if (*ep) return NIL;
if (!isRefToCell(lab)){
copy_some(__ABinFile_AinvalidFormat,1);
*ep = __ABinFile_AinvalidFormat;
return NIL;
}
}
if (sz % flat_offset_ssize == big_escape_ssize){
flds = (intptr_t)read_obj(f,ep);
if (*ep) return NIL;
ob = _bigAlloc(flds);
_mkHeader(_header(ob),sz,1);
((BCELL)ob)->size = pack_word(flds);
data = _bdata(ob);
} else {
flds = sz % flat_offset_ssize;
_alloc(flds,ob);
_mkHeader(_header(ob),sz,1);
data = _data(ob);
}
_flags(_header(ob)) = fs;
if (shared){
HASHENTRY e;
lab = getLabel(lab);
e = newEntry();
e->label = lab; e->obj = ob;
i = lab % HASHSIZE;
e->next = t->tab[i]; t->tab[i] = e;
}
if (sz >= flat_offset_ssize) {
if (fs & (1 << byte_flat_sflag)){
/* read two words and rest as char stream */
/* (UPDATE STRING FORMAT) */
unsigned char * cdata = (unsigned char*)(data+2);
int ch, cflds = (flds-2) * sizeof(OBJ);
data[0] = read_obj(f,ep); data[1] = read_obj(f,ep);
for (i = 0; i < cflds && !*ep; i++) {
if ((ch = getc(f)) != EOF){
cdata[i] = ch;
} else
get_unix_failure(errno,*ep);
}
} else {
/* read contents of unstructured cell. */
for (i = 0; i < flds && !*ep; i++) {
data[i] = read_obj(f,ep);
}
}
} else {
/* recursivly parse structured cell. */
for (i = 0; i < flds && !*ep; i++) {
data[i] = parse(f,t,ep);
}
}
/* process closures */
if (tst_sflag(ob, closure_sflag)){
char msgbuf[128];
char * msg = link_closure(ob);
if (msg){
strcpy(msgbuf, (char*)
data_denotation(__ABinFile_AlinkErrorPrefix));
strcat(msgbuf, (char*)
data_denotation(((CLOSURE)ob)->symbolid));
strcat(msgbuf,"': ");
strcat(msgbuf,msg);
*ep = declare_failure_answer(msgbuf);
return NIL;
}
}
return ob;
} else {
copy_some(__ABinFile_AinvalidFormat,1);
*ep = __ABinFile_AinvalidFormat;
return NIL;
}
}
