/[gcl]/gcl/o/package.d
ViewVC logotype

Diff of /gcl/o/package.d

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

revision 1.3 by camm, Mon Jun 17 04:44:30 2002 UTC revision 1.4 by camm, Sat Jul 20 07:10:56 2002 UTC
# Line 26  Foundation, 675 Mass Ave, Cambridge, MA Line 26  Foundation, 675 Mass Ave, Cambridge, MA
26    
27  #define HASHCOEF        12345           /*  hashing coefficient  */  #define HASHCOEF        12345           /*  hashing coefficient  */
28    
29  int check_type_or_symbol_string_package();  void check_type_or_symbol_string_package(object *);
30    
31  #define INTERNAL        1  #define INTERNAL        1
32  #define EXTERNAL        2  #define EXTERNAL        2
# Line 48  object x, l; Line 48  object x, l;
48          return(FALSE);          return(FALSE);
49  }  }
50    
51    void
52  rehash_pack(ptab,n,m)  rehash_pack(ptab,n,m)
53       object **ptab;       object **ptab;
54       int *n,m;       int *n,m;
# Line 79  static int package_sizes[]={ Line 80  static int package_sizes[]={
80    97,251, 509, 1021, 2039, 4093, 8191, 16381,    97,251, 509, 1021, 2039, 4093, 8191, 16381,
81    32749, 65521, 131071, 262139,   524287, 1048573};    32749, 65521, 131071, 262139,   524287, 1048573};
82    
83    int
84  suitable_package_size(n)  suitable_package_size(n)
85  {int *i=package_sizes;  {int *i=package_sizes;
86   if (n>= 1000000) return 1048573;   if (n>= 1000000) return 1048573;
# Line 92  suitable_package_size(n) Line 94  suitable_package_size(n)
94          and uses packages in list ul, which must be a list of packages          and uses packages in list ul, which must be a list of packages
95          or package names i.e. strings or symbols.          or package names i.e. strings or symbols.
96  */  */
97    void
98    package_already(object);
99    void
100    no_package(object);
101    
102  object  object
103  make_package(n, ns, ul,isize,esize)  make_package(n, ns, ul,isize,esize)
104  object n, ns, ul;  object n, ns, ul;
# Line 163  int isize,esize; Line 170  int isize,esize;
170          return(x);          return(x);
171  }  }
172    
173    void
174    use_package(object,object);
175    
176  object  object
177  in_package(n, ns, ul,isize,esize)  in_package(n, ns, ul,isize,esize)
178  object n, ns, ul;  object n, ns, ul;
# Line 171  int isize,esize; Line 181  int isize,esize;
181          object endp_temp;          object endp_temp;
182    
183          object x, y;          object x, y;
         int i;  
184          vs_mark;          vs_mark;
185    
186          x = find_package(n);          x = find_package(n);
# Line 472  UNINTERN: Line 481  UNINTERN:
481          END_NO_INTERRUPT;return(TRUE);          END_NO_INTERRUPT;return(TRUE);
482  }}  }}
483    
484    void
485  export(s, p)  export(s, p)
486  object s, p;  object s, p;
487  {  {
# Line 514  in ~S.", 3, s, p, l->c.c_car); Line 524  in ~S.", 3, s, p, l->c.c_car);
524          *ep = make_cons(s, *ep);          *ep = make_cons(s, *ep);
525  }  }
526    
527    void
528  unexport(s, p)  unexport(s, p)
529  object s, p;  object s, p;
530  {  {
# Line 536  of the package.", 2, s, p); Line 547  of the package.", 2, s, p);
547          *ip = make_cons(s, *ip);          *ip = make_cons(s, *ip);
548  }  }
549    
550    void
551  import(s, p)  import(s, p)
552  object s, p;  object s, p;
553  {  {
554          object x;          object x;
555          int j;          int j;
556          object *ip, l;          object *ip;
557    
558          x = find_symbol(s, p);          x = find_symbol(s, p);
559          if (intern_flag) {          if (intern_flag) {
# Line 559  in the package.", 2, s, p); Line 571  in the package.", 2, s, p);
571          *ip = make_cons(s, *ip);          *ip = make_cons(s, *ip);
572  }  }
573    
574    void
575  shadowing_import(s, p)  shadowing_import(s, p)
576  object s, p;  object s, p;
577  {  {
# Line 589  object s, p; Line 602  object s, p;
602          p->p.p_shadowings = make_cons(s, p->p.p_shadowings);          p->p.p_shadowings = make_cons(s, p->p.p_shadowings);
603  }  }
604    
605    void
606  shadow(s, p)  shadow(s, p)
607  object s, p;  object s, p;
608  {  {
# Line 605  object s, p; Line 619  object s, p;
619          *ip = make_cons(vs_head, *ip);          *ip = make_cons(vs_head, *ip);
620          p->p.p_internal_fp++;          p->p.p_internal_fp++;
621          p->p.p_shadowings = make_cons(vs_head, p->p.p_shadowings);          p->p.p_shadowings = make_cons(vs_head, p->p.p_shadowings);
622          vs_pop;          vs_popp;
623  }  }
624    
625    void
626  use_package(x0, p)  use_package(x0, p)
627  object x0, p;  object x0, p;
628  {  {
# Line 643  a name conflict.", 4, x, p, l->c.c_car, Line 658  a name conflict.", 4, x, p, l->c.c_car,
658          x->p.p_usedbylist = make_cons(p, x->p.p_usedbylist);          x->p.p_usedbylist = make_cons(p, x->p.p_usedbylist);
659  }  }
660    
661    void
662  unuse_package(x0, p)  unuse_package(x0, p)
663  object x0, p;  object x0, p;
664  {  {
# Line 680  object x0, p; Line 696  object x0, p;
696          @(return `in_package(pack_name, nicknames, use,fix(internal),fix(external))`)          @(return `in_package(pack_name, nicknames, use,fix(internal),fix(external))`)
697  @)  @)
698    
699    void
700  Lfind_package()  Lfind_package()
701  {  {
702          check_arg(1);          check_arg(1);
# Line 687  Lfind_package() Line 704  Lfind_package()
704          vs_base[0] = find_package(vs_base[0]);          vs_base[0] = find_package(vs_base[0]);
705  }  }
706    
707    void
708  Lpackage_name()  Lpackage_name()
709  {  {
710          check_arg(1);          check_arg(1);
# Line 695  Lpackage_name() Line 713  Lpackage_name()
713          vs_base[0] = vs_base[0]->p.p_name;          vs_base[0] = vs_base[0]->p.p_name;
714  }  }
715    
716    void
717  Lpackage_nicknames()  Lpackage_nicknames()
718  {  {
719          check_arg(1);          check_arg(1);
# Line 712  Lpackage_nicknames() Line 731  Lpackage_nicknames()
731          @(return `rename_package(pack, new_name, new_nicknames)`)          @(return `rename_package(pack, new_name, new_nicknames)`)
732  @)  @)
733    
734    void
735  Lpackage_use_list()  Lpackage_use_list()
736  {  {
737          check_arg(1);          check_arg(1);
# Line 721  Lpackage_use_list() Line 741  Lpackage_use_list()
741          vs_base[0] = vs_base[0]->p.p_uselist;          vs_base[0] = vs_base[0]->p.p_uselist;
742  }  }
743    
744    void
745  Lpackage_used_by_list()  Lpackage_used_by_list()
746  {  {
747          check_arg(1);          check_arg(1);
# Line 730  Lpackage_used_by_list() Line 751  Lpackage_used_by_list()
751          vs_base[0] = vs_base[0]->p.p_usedbylist;          vs_base[0] = vs_base[0]->p.p_usedbylist;
752  }  }
753    
754    void
755  Lpackage_shadowing_symbols()  Lpackage_shadowing_symbols()
756  {  {
757          check_arg(1);          check_arg(1);
# Line 739  Lpackage_shadowing_symbols() Line 761  Lpackage_shadowing_symbols()
761          vs_base[0] = vs_base[0]->p.p_shadowings;          vs_base[0] = vs_base[0]->p.p_shadowings;
762  }  }
763    
764    void
765  Llist_all_packages()  Llist_all_packages()
766  {  {
767          struct package *p;          struct package *p;
# Line 784  Llist_all_packages() Line 807  Llist_all_packages()
807  @)  @)
808    
809  @(defun unintern (symbl &optional (p `current_package()`))  @(defun unintern (symbl &optional (p `current_package()`))
         object x;  
810  @  @
811          check_type_symbol(&symbl);          check_type_symbol(&symbl);
812          check_type_or_symbol_string_package(&p);          check_type_or_symbol_string_package(&p);
# Line 985  BEGIN: Line 1007  BEGIN:
1007          @(return Ct)          @(return Ct)
1008  @)  @)
1009    
1010    void
1011  siLpackage_internal()  siLpackage_internal()
1012  {  {
1013    
1014          int j;          int j=0;
1015    
1016          check_arg(2);          check_arg(2);
1017          check_type_package(&vs_base[0]);          check_type_package(&vs_base[0]);
# Line 997  siLpackage_internal() Line 1020  siLpackage_internal()
1020                  FEerror("~S is an illgal index to a package hashtable.",                  FEerror("~S is an illgal index to a package hashtable.",
1021                          1, vs_base[1]);                          1, vs_base[1]);
1022          vs_base[0] = P_INTERNAL(vs_base[0],j);          vs_base[0] = P_INTERNAL(vs_base[0],j);
1023          vs_pop;          vs_popp;
1024  }  }
1025    
1026    void
1027  siLpackage_external()  siLpackage_external()
1028  {  {
1029          int j;          int j=0;
1030    
1031          check_arg(2);          check_arg(2);
1032          check_type_package(&vs_base[0]);          check_type_package(&vs_base[0]);
# Line 1011  siLpackage_external() Line 1035  siLpackage_external()
1035                  FEerror("~S is an illegal index to a package hashtable.",                  FEerror("~S is an illegal index to a package hashtable.",
1036                          1, vs_base[1]);                          1, vs_base[1]);
1037          vs_base[0] = P_EXTERNAL(vs_base[0],j);          vs_base[0] = P_EXTERNAL(vs_base[0],j);
1038          vs_pop;          vs_popp;
1039  }  }
1040    
1041    void
1042  no_package(n)  no_package(n)
1043  object n;  object n;
1044  {  {
1045          FEerror("There is no package with the name ~A.", 1, n);          FEerror("There is no package with the name ~A.", 1, n);
1046  }  }
1047    
1048    void
1049  package_already(n)  package_already(n)
1050  object n;  object n;
1051  {  {
# Line 1046  DEF_ORDINARY("USE",sKuse,KEYWORD,""); Line 1072  DEF_ORDINARY("USE",sKuse,KEYWORD,"");
1072  DEFVAR("*PACKAGE*",sLApackageA,LISP,lisp_package,"");  DEFVAR("*PACKAGE*",sLApackageA,LISP,lisp_package,"");
1073    
1074    
1075    void
1076  init_package()  init_package()
1077  {  {
1078    
# Line 1075  init_package() Line 1102  init_package()
1102          enter_mark_origin(&uninterned_list);          enter_mark_origin(&uninterned_list);
1103  }  }
1104    
1105    void
1106  init_package_function()  init_package_function()
1107  {  {
1108          make_function("MAKE-PACKAGE", Lmake_package);          make_function("MAKE-PACKAGE", Lmake_package);

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

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