← Back to branch summary

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

« back to all changes in this revision

Viewing changes to unixport/sys_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_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 %-*.*slibgcl.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
        
 
98
  ar_check_init(gcl_cmpinline,no_init);
 
99
  ar_check_init(gcl_cmputil,no_init);
 
100
 
 
101
  ar_check_init(gcl_debug,no_init);
 
102
  ar_check_init(gcl_info,no_init);
 
103
 
 
104
  ar_check_init(gcl_cmptype,no_init);
 
105
  ar_check_init(gcl_cmpbind,no_init);
 
106
  ar_check_init(gcl_cmpblock,no_init);
 
107
  ar_check_init(gcl_cmpcall,no_init);
 
108
  ar_check_init(gcl_cmpcatch,no_init);
 
109
  ar_check_init(gcl_cmpenv,no_init);
 
110
  ar_check_init(gcl_cmpeval,no_init);
 
111
  ar_check_init(gcl_cmpflet,no_init);
 
112
  ar_check_init(gcl_cmpfun,no_init);
 
113
  ar_check_init(gcl_cmpif,no_init);
 
114
  ar_check_init(gcl_cmplabel,no_init);
 
115
  ar_check_init(gcl_cmplam,no_init);
 
116
  ar_check_init(gcl_cmplet,no_init);
 
117
  ar_check_init(gcl_cmploc,no_init);
 
118
  ar_check_init(gcl_cmpmap,no_init);
 
119
  ar_check_init(gcl_cmpmulti,no_init);
 
120
  ar_check_init(gcl_cmpspecial,no_init);
 
121
  ar_check_init(gcl_cmptag,no_init);
 
122
  ar_check_init(gcl_cmptop,no_init);
 
123
  ar_check_init(gcl_cmpvar,no_init);
 
124
  ar_check_init(gcl_cmpvs,no_init);
 
125
  ar_check_init(gcl_cmpwt,no_init);
 
126
 
 
127
  
 
128
}
 
129
 
 
130
int
 
131
gcl_init_cmp_anon(void) {
 
132
 
 
133
  return 1;
 
134
 
 
135
}