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

Diff of /gcl/o/sfaslmacosx.c

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

revision 1.6 by rlbrk, Wed Feb 18 23:33:11 2004 UTC revision 1.7 by camm, Sat May 7 02:52:30 2005 UTC
# Line 49  static void sfasl_error (char *format, . Line 49  static void sfasl_error (char *format, .
49      exit (1);      exit (1);
50  }  }
51    
52  static void get_init_name (object faslfile, char *init_fun)  /* static void get_init_name (object faslfile, char *init_fun) */
53  {  /* { */
54      object path = coerce_to_pathname (faslfile);  /*     object path = coerce_to_pathname (faslfile); */
55      char *p;  /*     char *p; */
56        
57      strcpy (init_fun, "_init_");  /*     strcpy (init_fun, "_init_"); */
58      coerce_to_filename (path->pn.pn_name, init_fun + 6);  /*     coerce_to_filename (path->pn.pn_name, init_fun + 6); */
59        
60      for (p = init_fun + 6 ; *p ; p++)  /*     for (p = init_fun + 6 ; *p ; p++) */
61        if (*p == '-') *p = '_';  /*       if (*p == '-') *p = '_'; */
62    /* } */
63    
64    static NSSymbol
65    get_init_sym(NSModule module,object ff) {
66    
67      static object inf;
68      struct string st;
69      object x;
70      char ib[MAXPATHLEN+1];
71      NSSymbol v;
72    
73      if (!inf) {
74    
75        object x;
76        struct string st;
77        st.t=t_string;
78        st.st_self="COMPILER";
79        st.st_dim=st.st_fillp=strlen(st.st_self);
80        if ((x=find_package((object)&st))==Cnil)
81          sfasl_error("Cannot find compiler package\n");
82        st.st_self="INIT-NAME";
83        st.st_dim=st.st_fillp=strlen(st.st_self);
84        if ((inf=find_symbol((object)&st,x))==Cnil) {
85          inf=NULL;
86          sfasl_error("Cannot find function COMPILER::INIT-NAME\n");
87        }
88        
89      }
90    
91      st.t=t_string;
92      st.st_self=ff->st.st_self;
93      st.st_dim=st.st_fillp=ff->st.st_dim;
94      x=ifuncall1(inf,(object)&st);
95      if (x->d.t!=t_string)
96        sfasl_error("INIT-NAME error\n");
97      assert(snprintf(ib,sizeof(ib),"_init_%-.*s",x->st.st_dim,x->st.st_self)>0);
98    
99      if (!(v=NSLookupSymbolInModule(module, ib))) {
100        x=ifuncall2(inf,(object)&st,Ct);
101        if (x->d.t!=t_string)
102          sfasl_error("INIT-NAME error\n");
103        assert(snprintf(ib,sizeof(ib),"_init_%-.*s",x->st.st_dim,x->st.st_self)>0);
104        if (!(v=NSLookupSymbolInModule(module, ib)))
105          sfasl_error("Cannot lookup init-name\n");
106      }
107    
108      return v;
109    
110  }  }
111    
112  static func prepare_bundle (object faslfile, char *filename)  static func prepare_bundle (object faslfile, char *filename)
# Line 84  static func prepare_bundle (object faslf Line 132  static func prepare_bundle (object faslf
132          sfasl_error ("cannot link bundle\n");          sfasl_error ("cannot link bundle\n");
133      }      }
134            
135      if (!(nssym = NSLookupSymbolInModule (module, "_init_code")))      nssym=get_init_sym(module,faslfile);
136      {  /*     if (!(nssym = NSLookupSymbolInModule (module, "_init_code"))) */
137          char init_fun [256];  /*     { */
138    /*         char init_fun [256]; */
139                    
140          get_init_name (faslfile, init_fun);  /*         get_init_name (faslfile, init_fun); */
141                    
142          if (!(nssym = NSLookupSymbolInModule (module, init_fun))) {  /*         if (!(nssym = NSLookupSymbolInModule (module, init_fun))) { */
143              sfasl_error ("cannot retrieve entry point symbol in bundle\n");  /*             sfasl_error ("cannot retrieve entry point symbol in bundle\n"); */
144          }  /*         } */
145      }  /*     } */
146            
147      if (!(fptr = (int (*) ()) NSAddressOfSymbol (nssym))) {      if (!(fptr = (int (*) ()) NSAddressOfSymbol (nssym))) {
148          sfasl_error ("cannot retrieve entry point address\n");          sfasl_error ("cannot retrieve entry point address\n");

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

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