← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to unixport/sys_pcl_gcl.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
unixport/sys_pcl_gcl.c
 
1
#include <string.h>
 
2
#include <stdlib.h>
 
3
#include "../h/include.h"
 
4
 
 
5
extern object user_init();
 
6
 
 
7
 
 
8
void gcl_init_or_load1 (void (*)(void),char *);
 
9
#define init_or_load(fn,file) do {extern void fn(void); gcl_init_or_load1(fn,file);} \
 
10
  while(0)
 
11
 
 
12
/* #define mjoin(a,b) a ## b */
 
13
/* #define Mjoin(a,b) mjoin(a,b) */
 
14
 
 
15
#define ar_init(a) do {\
 
16
  char b[200];\
 
17
  \
 
18
  if (snprintf(b,sizeof(b),"ar x %-*.*slibpcl_gcl.a %s.o",\
 
19
                sSAsystem_directoryA->s.s_dbind->st.st_fillp,\
 
20
                sSAsystem_directoryA->s.s_dbind->st.st_fillp,\
 
21
                sSAsystem_directoryA->s.s_dbind->st.st_self,#a)<=0)\
 
22
    error("Cannot unpack module " #a "o\n");\
 
23
  if (system(b)) \
 
24
    error("Cannot run ar command to unpack module " #a ".o\n");\
 
25
  init_or_load(Mjoin(init_,a),#a ".o");\
 
26
  if (unlink(#a ".o"))\
 
27
    error("Cannot unlink " #a ".o\n");\
 
28
} while(0)
 
29
 
 
30
#define ar_check_init(a,b) do {\
 
31
   object t;\
 
32
   \
 
33
   for (t=b->s.s_dbind;!endp(t) && type_of(t->c.c_car)==t_string && strcmp(#a,t->c.c_car->st.st_self);t=t->c.c_cdr);\
 
34
   if (endp(t))\
 
35
     ar_init(a);\
 
36
} while(0)
 
37
 
 
38
 
 
39
static void
 
40
load1(x)
 
41
     char *x;
 
42
{printf("loading %s\n",x);
 
43
 fflush(stdout);
 
44
 load(x);}
 
45
 
 
46
#define lsp_init(a) do {\
 
47
   char b[200];\
 
48
   \
 
49
   if (snprintf(b,sizeof(b),"%-*.*s%s",\
 
50
                sSAsystem_directoryA->s.s_dbind->st.st_fillp,\
 
51
                sSAsystem_directoryA->s.s_dbind->st.st_fillp,\
 
52
                sSAsystem_directoryA->s.s_dbind->st.st_self,a)<=0)\
 
53
     error("Cannot append system directory\n");\
 
54
   load1(b);\
 
55
} while(0)
 
56
 
 
57
void
 
58
gcl_init_init()
 
59
{
 
60
 
 
61
  build_symbol_table();
 
62
 
 
63
  lsp_init("../lsp/gcl_export.lsp");
 
64
 
 
65
  ar_init(gcl_defmacro);
 
66
  ar_init(gcl_evalmacros);
 
67
  ar_init(gcl_top);
 
68
  ar_init(gcl_module);
 
69
 
 
70
  lsp_init("../lsp/gcl_autoload.lsp");
 
71
 
 
72
}
 
73
 
 
74
void
 
75
gcl_init_system(object no_init)
 
76
{
 
77
 
 
78
  if (type_of(no_init)!=t_symbol)
 
79
    error("Supplied no_init is not of type symbol\n");
 
80
 
 
81
  ar_check_init(gcl_predlib,no_init);
 
82
  ar_check_init(gcl_setf,no_init);
 
83
  ar_check_init(gcl_arraylib,no_init);
 
84
  ar_check_init(gcl_assert,no_init);
 
85
  ar_check_init(gcl_defstruct,no_init);
 
86
  ar_check_init(gcl_describe,no_init);
 
87
  ar_check_init(gcl_iolib,no_init);
 
88
  ar_check_init(gcl_listlib,no_init);
 
89
  ar_check_init(gcl_mislib,no_init);
 
90
  ar_check_init(gcl_numlib,no_init);
 
91
  ar_check_init(gcl_packlib,no_init);
 
92
  ar_check_init(gcl_seq,no_init);
 
93
  ar_check_init(gcl_seqlib,no_init);
 
94
  ar_check_init(gcl_trace,no_init);
 
95
  ar_check_init(gcl_sloop,no_init);
 
96
  ar_check_init(gcl_serror,no_init);
 
97
  ar_check_init(gcl_destructuring_bind,no_init);
 
98
  ar_check_init(gcl_loop,no_init);
 
99
  ar_check_init(gcl_defpackage,no_init);
 
100
  ar_check_init(gcl_make_defpackage,no_init);
 
101
 
 
102
        
 
103
  ar_check_init(gcl_cmpinline,no_init);
 
104
  ar_check_init(gcl_cmputil,no_init);
 
105
 
 
106
  ar_check_init(gcl_debug,no_init);
 
107
  ar_check_init(gcl_info,no_init);
 
108
 
 
109
  ar_check_init(gcl_cmptype,no_init);
 
110
  ar_check_init(gcl_cmpbind,no_init);
 
111
  ar_check_init(gcl_cmpblock,no_init);
 
112
  ar_check_init(gcl_cmpcall,no_init);
 
113
  ar_check_init(gcl_cmpcatch,no_init);
 
114
  ar_check_init(gcl_cmpenv,no_init);
 
115
  ar_check_init(gcl_cmpeval,no_init);
 
116
  ar_check_init(gcl_cmpflet,no_init);
 
117
  ar_check_init(gcl_cmpfun,no_init);
 
118
  ar_check_init(gcl_cmpif,no_init);
 
119
  ar_check_init(gcl_cmplabel,no_init);
 
120
  ar_check_init(gcl_cmplam,no_init);
 
121
  ar_check_init(gcl_cmplet,no_init);
 
122
  ar_check_init(gcl_cmploc,no_init);
 
123
  ar_check_init(gcl_cmpmap,no_init);
 
124
  ar_check_init(gcl_cmpmulti,no_init);
 
125
  ar_check_init(gcl_cmpspecial,no_init);
 
126
  ar_check_init(gcl_cmptag,no_init);
 
127
  ar_check_init(gcl_cmptop,no_init);
 
128
  ar_check_init(gcl_cmpvar,no_init);
 
129
  ar_check_init(gcl_cmpvs,no_init);
 
130
  ar_check_init(gcl_cmpwt,no_init);
 
131
 
 
132
  lsp_init("../clcs/package.lisp");
 
133
  lsp_init("../clcs/myload1.lisp");
 
134
 
 
135
  ar_check_init(pcl_pkg,no_init);
 
136
  ar_check_init(pcl_walk,no_init);
 
137
  ar_check_init(pcl_iterate,no_init);
 
138
  ar_check_init(pcl_macros,no_init);
 
139
  ar_check_init(pcl_low,no_init);
 
140
  ar_check_init(pcl_gcl_low,no_init);
 
141
  ar_check_init(pcl_fin,no_init);
 
142
  ar_check_init(pcl_defclass,no_init);
 
143
  ar_check_init(pcl_defs,no_init);
 
144
  ar_check_init(pcl_fngen,no_init);
 
145
  ar_check_init(pcl_cache,no_init);
 
146
  ar_check_init(pcl_dlisp,no_init);
 
147
  ar_check_init(pcl_dlisp2,no_init);
 
148
  ar_check_init(pcl_boot,no_init);
 
149
  ar_check_init(pcl_vector,no_init);
 
150
  ar_check_init(pcl_slots_boot,no_init);
 
151
  ar_check_init(pcl_combin,no_init);
 
152
  ar_check_init(pcl_dfun,no_init);
 
153
  ar_check_init(pcl_fast_init,no_init);
 
154
  ar_check_init(pcl_braid,no_init);
 
155
  ar_check_init(pcl_generic_functions,no_init);
 
156
  ar_check_init(pcl_slots,no_init);
 
157
  ar_check_init(pcl_init,no_init);
 
158
  ar_check_init(pcl_std_class,no_init);
 
159
  ar_check_init(pcl_cpl,no_init);
 
160
  ar_check_init(pcl_fsc,no_init);
 
161
  ar_check_init(pcl_methods,no_init);
 
162
  ar_check_init(pcl_fixup,no_init);
 
163
  ar_check_init(pcl_defcombin,no_init);
 
164
  ar_check_init(pcl_ctypes,no_init);
 
165
  ar_check_init(pcl_env,no_init);
 
166
  ar_check_init(pcl_compat,no_init);
 
167
  ar_check_init(pcl_precom1,no_init);
 
168
  ar_check_init(pcl_precom2,no_init);
 
169
 
 
170
}
 
171
 
 
172
static int ngazonk;
 
173
 
 
174
int
 
175
gcl_init_cmp_anon(void) {
 
176
 
 
177
  int i=0;
 
178
 
 
179
  switch(ngazonk++) {
 
180
  case 0:
 
181
    ar_check_init(pcl_gazonk0,Cnil);
 
182
    break;
 
183
  case 1:
 
184
    ar_check_init(pcl_gazonk1,Cnil);
 
185
    break;
 
186
  case 2:
 
187
    ar_check_init(pcl_gazonk2,Cnil);
 
188
    break;
 
189
  case 3:
 
190
    ar_check_init(pcl_gazonk3,Cnil);
 
191
    break;
 
192
  case 4:
 
193
    ar_check_init(pcl_gazonk4,Cnil);
 
194
    break;
 
195
  case 5:
 
196
    ar_check_init(pcl_gazonk5,Cnil);
 
197
    break;
 
198
  case 6:
 
199
    ar_check_init(pcl_gazonk6,Cnil);
 
200
    break;
 
201
  case 7:
 
202
    ar_check_init(pcl_gazonk7,Cnil);
 
203
    break;
 
204
  case 8:
 
205
    ar_check_init(pcl_gazonk8,Cnil);
 
206
    i=1;
 
207
    break;
 
208
  default:
 
209
    i=-1;
 
210
    break;
 
211
  }
 
212
 
 
213
  return i;
 
214
 
 
215
}