26 |
|
|
27 |
|
|
28 |
object coerce_stream(); |
object coerce_stream(); |
29 |
object fasd_patch_sharp(); |
object fasd_patch_sharp(object x, int depth); |
30 |
object make_pathname (); |
object make_pathname (); |
31 |
|
|
32 |
|
|
153 |
FILE *fas_stream; |
FILE *fas_stream; |
154 |
int dump_index; |
int dump_index; |
155 |
struct htent *gethash(); |
struct htent *gethash(); |
156 |
void read_fasd1(); |
void read_fasd1(int i, object *loc); |
157 |
object extended_read(); |
object extended_read(); |
158 |
|
|
159 |
/* to enable debugging define the following, |
/* to enable debugging define the following, |
432 |
|
|
433 |
|
|
434 |
enum circ_ind |
enum circ_ind |
435 |
do_hash(obj,dot) |
do_hash(object obj, int dot) |
|
object obj; |
|
|
int dot; |
|
436 |
{ struct htent *e; |
{ struct htent *e; |
437 |
int i; |
int i; |
|
int result; |
|
438 |
e=gethash(obj,dump_hash_table); |
e=gethash(obj,dump_hash_table); |
439 |
if (e->hte_key==OBJNULL) |
if (e->hte_key==OBJNULL) |
440 |
/* We won't index things unless they have < -2 in the hash table */ |
/* We won't index things unless they have < -2 in the hash table */ |
479 |
return LATER_INDEX; |
return LATER_INDEX; |
480 |
} |
} |
481 |
|
|
482 |
void write_fasd(); |
void write_fasd(object obj); |
483 |
object |
object |
484 |
write_fasd_top(obj,x) |
write_fasd_top(object obj, object x) |
485 |
object x,obj; |
{struct fasd *fd = (struct fasd *) x->v.v_self; |
|
{struct fasd *fd = (struct fasd *) x->v.v_self; |
|
486 |
if (fd->direction == sKoutput) |
if (fd->direction == sKoutput) |
487 |
SETUP_FASD_IN(fd); |
SETUP_FASD_IN(fd); |
488 |
else FEerror("bad value for open slot of fasd",0); |
else FEerror("bad value for open slot of fasd",0); |
503 |
if (needs_patching) result =fasd_patch_sharp(result,0) |
if (needs_patching) result =fasd_patch_sharp(result,0) |
504 |
|
|
505 |
object |
object |
506 |
read_fasd_top(x) |
read_fasd_top(object x) |
|
object x; |
|
507 |
{ struct fasd *fd = (struct fasd *) x->v.v_self; |
{ struct fasd *fd = (struct fasd *) x->v.v_self; |
508 |
VOL int e=0; |
VOL int e=0; |
509 |
object result; |
object result; |
549 |
void Lmake_hash_table(); |
void Lmake_hash_table(); |
550 |
|
|
551 |
object |
object |
552 |
open_fasd(stream,direction,eof,tabl) |
open_fasd(object stream, object direction, object eof, object tabl) |
|
object stream,direction,eof,tabl; |
|
553 |
{ object str=Cnil; |
{ object str=Cnil; |
554 |
object result; |
object result; |
555 |
if(direction==sKinput) |
if(direction==sKinput) |
600 |
}} |
}} |
601 |
|
|
602 |
object |
object |
603 |
close_fasd(ar) |
close_fasd(object ar) |
|
object ar; |
|
604 |
{ struct fasd *fd= (struct fasd *)(ar->v.v_self); |
{ struct fasd *fd= (struct fasd *)(ar->v.v_self); |
605 |
check_type(ar,t_vector); |
check_type(ar,t_vector); |
606 |
if (type_of(fd->table)==t_vector) |
if (type_of(fd->table)==t_vector) |
635 |
if(do_hash(obj,0)==LATER_INDEX) return; |
if(do_hash(obj,0)==LATER_INDEX) return; |
636 |
|
|
637 |
void |
void |
638 |
write_fasd(obj) |
write_fasd(object obj) |
|
object obj; |
|
639 |
{ int j,leng; |
{ int j,leng; |
640 |
|
|
641 |
/* hook for writing other data in fasd file */ |
/* hook for writing other data in fasd file */ |
846 |
|
|
847 |
|
|
848 |
static void |
static void |
849 |
fasd_patch_sharp_cons(x,depth) |
fasd_patch_sharp_cons(object x, int depth) |
|
int depth; |
|
|
object x; |
|
850 |
{ |
{ |
851 |
for (;;) { |
for (;;) { |
852 |
x->c.c_car = fasd_patch_sharp(x->c.c_car,depth+1); |
x->c.c_car = fasd_patch_sharp(x->c.c_car,depth+1); |
860 |
} |
} |
861 |
|
|
862 |
object |
object |
863 |
fasd_patch_sharp(x,depth) |
fasd_patch_sharp(object x, int depth) |
|
object x; |
|
864 |
{ |
{ |
865 |
cs_check(x); |
cs_check(x); |
866 |
if (++depth > 1000) |
if (++depth > 1000) |
932 |
|
|
933 |
object sharing_table; |
object sharing_table; |
934 |
enum circ_ind |
enum circ_ind |
935 |
is_it_there(x) |
is_it_there(object x) |
|
object x; |
|
936 |
{ struct htent *e; |
{ struct htent *e; |
937 |
object table=sharing_table; |
object table=sharing_table; |
938 |
switch(type_of(x)){ |
switch(type_of(x)){ |
959 |
|
|
960 |
|
|
961 |
static void |
static void |
962 |
find_sharing(x) |
find_sharing(object x) |
|
object x; |
|
963 |
{ |
{ |
964 |
cs_check(x); |
cs_check(x); |
965 |
BEGIN: |
BEGIN: |
1006 |
while (i--> 0) |
while (i--> 0) |
1007 |
find_sharing(structure_ref(x,def,i)); |
find_sharing(structure_ref(x,def,i)); |
1008 |
break; |
break; |
1009 |
} |
} |
1010 |
|
default: |
1011 |
|
break; |
1012 |
} |
} |
1013 |
return; |
return; |
1014 |
} |
} |
1015 |
|
|
1016 |
object |
object |
1017 |
find_sharing_top(x,table) |
find_sharing_top(object x, object table) |
|
object x,table; |
|
1018 |
{sharing_table=table; |
{sharing_table=table; |
1019 |
find_sharing(x); |
find_sharing(x); |
1020 |
return Ct; |
return Ct; |
1025 |
|
|
1026 |
|
|
1027 |
object |
object |
1028 |
read_fasd(i) |
read_fasd(int i) |
1029 |
int i; |
{object tem; |
|
{object tem; |
|
1030 |
read_fasd1(i,&tem); |
read_fasd1(i,&tem); |
1031 |
return tem;} |
return tem;} |
1032 |
|
|
1033 |
|
|
1034 |
/* I am not sure if saving vs_top,vs_base is necessary */ |
/* I am not sure if saving vs_top,vs_base is necessary */ |
1035 |
object |
object |
1036 |
lisp_eval(x) |
lisp_eval(object x) |
|
object x; |
|
1037 |
{ object *b,*t; |
{ object *b,*t; |
1038 |
SAVE_CURRENT_FASD; |
SAVE_CURRENT_FASD; |
1039 |
b=vs_base; |
b=vs_base; |
1050 |
|
|
1051 |
|
|
1052 |
|
|
1053 |
#define CHECK_CH(i) do{if ((i)==EOF & feof(fas_stream)) bad_eof();}while (0) |
#define CHECK_CH(i) do{if ((i)==EOF && feof(fas_stream)) bad_eof();}while (0) |
1054 |
/* grow vector AR of general type */ |
/* grow vector AR of general type */ |
1055 |
static void |
static void |
1056 |
grow_vector(ar) |
grow_vector(object ar) |
|
object ar; |
|
1057 |
{ int len=ar->v.v_dim; |
{ int len=ar->v.v_dim; |
1058 |
int nl=(int) (1.5*len); |
int nl=(int) (1.5*len); |
1059 |
{BEGIN_NO_INTERRUPT; |
{BEGIN_NO_INTERRUPT; |
1067 |
} |
} |
1068 |
|
|
1069 |
static void |
static void |
1070 |
bad_eof() |
bad_eof(void) |
1071 |
{ FEerror("Unexpected end of file",0);} |
{ FEerror("Unexpected end of file",0);} |
1072 |
|
|
1073 |
|
|
1074 |
|
|
1075 |
/* read one starting with byte i into location loc */ |
/* read one starting with byte i into location loc */ |
1076 |
void |
void |
1077 |
read_fasd1(i,loc) |
read_fasd1(int i, object *loc) |
|
object *loc; |
|
|
int i; |
|
1078 |
{ object tem; |
{ object tem; |
1079 |
int leng; |
int leng; |
1080 |
BEGIN: |
BEGIN: |
1098 |
while(1) |
while(1) |
1099 |
{int j; |
{int j; |
1100 |
if (--i < 0) {*loc=Cnil; return;} |
if (--i < 0) {*loc=Cnil; return;} |
|
DP(reading_list:) ; |
|
1101 |
j=GET_OP(); |
j=GET_OP(); |
1102 |
CHECK_CH(j); |
CHECK_CH(j); |
1103 |
if (j==d_delimiter) |
if (j==d_delimiter) |
1194 |
case DP(d_new_indexed_items:) |
case DP(d_new_indexed_items:) |
1195 |
case DP(d_new_indexed_item:) |
case DP(d_new_indexed_item:) |
1196 |
|
|
1197 |
{object tem; |
{ |
1198 |
int cindex,k; |
int cindex,k; |
1199 |
k=GET_OP(); |
k=GET_OP(); |
1200 |
MORE: |
MORE: |
1261 |
*loc=0; return; |
*loc=0; return; |
1262 |
|
|
1263 |
case DP(d_structure:) |
case DP(d_structure:) |
1264 |
{ int narg,i,tem; |
{ int narg,i; |
1265 |
object name; |
object name; |
1266 |
narg=GETD("narg=%d"); |
narg=GETD("narg=%d"); |
1267 |
read_fasd1(GET_OP(),& name); |
read_fasd1(GET_OP(),& name); |
1355 |
|
|
1356 |
case DP(d_begin_dump:) |
case DP(d_begin_dump:) |
1357 |
{int vers=GETD("version=%d"); |
{int vers=GETD("version=%d"); |
|
object tem; |
|
1358 |
if(vers!=FASD_VERSION) |
if(vers!=FASD_VERSION) |
1359 |
FEerror("This file was dumped with FASD version ~a not ~a.", |
FEerror("This file was dumped with FASD version ~a not ~a.", |
1360 |
2,make_fixnum(vers),make_fixnum(FASD_VERSION));} |
2,make_fixnum(vers),make_fixnum(FASD_VERSION));} |
1379 |
*/ |
*/ |
1380 |
|
|
1381 |
case DP(d_enter_vector:) |
case DP(d_enter_vector:) |
1382 |
{object *base=vs_top,x,y; |
{ |
1383 |
extern object sSPmemory; |
extern object sSPmemory; |
1384 |
int print_only=0; |
int print_only=0; |
1385 |
int n = 0; |
int n = 0; |
1426 |
|
|
1427 |
}} |
}} |
1428 |
|
|
1429 |
|
void |
1430 |
clrhash(table) |
clrhash(object table) |
1431 |
object table; |
{int i; |
|
{int i; |
|
1432 |
if (table->ht.ht_nent > 0 ) |
if (table->ht.ht_nent > 0 ) |
1433 |
for(i = 0; i < table->ht.ht_size; i++) { |
for(i = 0; i < table->ht.ht_size; i++) { |
1434 |
table->ht.ht_self[i].hte_key = OBJNULL; |
table->ht.ht_self[i].hte_key = OBJNULL; |
1439 |
|
|
1440 |
object read_fasl_vector1(); |
object read_fasl_vector1(); |
1441 |
object |
object |
1442 |
read_fasl_vector(in) |
read_fasl_vector(object in) |
|
object in; |
|
1443 |
{char ch; |
{char ch; |
1444 |
object orig = in; |
object orig = in; |
1445 |
object d; |
object d; |
1469 |
break;}} |
break;}} |
1470 |
{object ar=open_fasd(in,sKinput,0,Cnil); |
{object ar=open_fasd(in,sKinput,0,Cnil); |
1471 |
int n=fix(current_fasd.table_length); |
int n=fix(current_fasd.table_length); |
1472 |
object result,tem,last; |
object result,last; |
1473 |
{ BEGIN_NO_INTERRUPT; |
{ BEGIN_NO_INTERRUPT; |
1474 |
#ifdef HAVE_ALLOCA |
#ifdef HAVE_ALLOCA |
1475 |
current_fasd.table->v.v_self |
current_fasd.table->v.v_self |
1499 |
|
|
1500 |
object IfaslInStream; |
object IfaslInStream; |
1501 |
void |
void |
1502 |
IreadFasdData() |
IreadFasdData(void) |
1503 |
|
|
1504 |
/* While executing this the siPMemory should be bound to the cfdata |
/* While executing this the siPMemory should be bound to the cfdata |
1505 |
and the sSPinit to a vector of addresses. */ |
and the sSPinit to a vector of addresses. */ |
1506 |
{object ar=open_fasd(IfaslInStream,sKinput,0,Cnil); |
{object ar=open_fasd(IfaslInStream,sKinput,0,Cnil); |
1507 |
int n=fix(current_fasd.table_length); |
int n=fix(current_fasd.table_length); |
1508 |
object result,tem,last; |
object result; |
1509 |
{BEGIN_NO_INTERRUPT; |
{BEGIN_NO_INTERRUPT; |
1510 |
#ifdef HAVE_ALLOCA |
#ifdef HAVE_ALLOCA |
1511 |
current_fasd.table->v.v_self |
current_fasd.table->v.v_self |
1531 |
|
|
1532 |
|
|
1533 |
void |
void |
1534 |
init_fasdump() |
init_fasdump(void) |
1535 |
{ |
{ |
1536 |
make_si_sfun("READ-FASD-TOP",read_fasd_top,1); |
make_si_sfun("READ-FASD-TOP",read_fasd_top,1); |
1537 |
make_si_sfun("WRITE-FASD-TOP",write_fasd_top,2); |
make_si_sfun("WRITE-FASD-TOP",write_fasd_top,2); |