/[gcl]/gcl/o/fasdump.c
ViewVC logotype

Diff of /gcl/o/fasdump.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by wfs, Sun May 6 15:59:23 2001 UTC revision 1.3 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 26  Line 26 
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    
# Line 153  enum dump_type { Line 153  enum dump_type {
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,
# Line 432  getd(str) Line 432  getd(str)
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 */
# Line 482  do_hash(obj,dot) Line 479  do_hash(obj,dot)
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);
# Line 507  write_fasd_top(obj,x) Line 503  write_fasd_top(obj,x)
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;
# Line 554  object sSPinit; Line 549  object sSPinit;
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)
# Line 606  open_fasd(stream,direction,eof,tabl) Line 600  open_fasd(stream,direction,eof,tabl)
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)
# Line 642  close_fasd(ar) Line 635  close_fasd(ar)
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 */
# Line 854  write_fasd(obj) Line 846  write_fasd(obj)
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);
# Line 870  object x; Line 860  object x;
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)
# Line 943  object x; Line 932  object x;
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)){
# Line 971  is_it_there(x) Line 959  is_it_there(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:
# Line 1019  object x; Line 1006  object x;
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;
# Line 1039  object x,table; Line 1025  object x,table;
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;
# Line 1066  object x; Line 1050  object x;
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;
# Line 1084  grow_vector(ar) Line 1067  grow_vector(ar)
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:
# Line 1117  read_fasd1(i,loc) Line 1098  read_fasd1(i,loc)
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)
# Line 1214  read_fasd1(i,loc) Line 1194  read_fasd1(i,loc)
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:
# Line 1281  read_fasd1(i,loc) Line 1261  read_fasd1(i,loc)
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);
# Line 1375  read_fasd1(i,loc) Line 1355  read_fasd1(i,loc)
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));}
# Line 1400  read_fasd1(i,loc) Line 1379  read_fasd1(i,loc)
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;
# Line 1447  read_fasd1(i,loc) Line 1426  read_fasd1(i,loc)
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;
# Line 1461  object table; Line 1439  object table;
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;
# Line 1492  object in; Line 1469  object in;
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
# Line 1522  object in; Line 1499  object in;
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
# Line 1554  IreadFasdData() Line 1531  IreadFasdData()
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);

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26