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

« back to all changes in this revision

Viewing changes to pcl/impl/kcl/misc-kcl-patches.text

  • 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:
 
1
c/cmpaux.c
 
2
*** c/cmpaux.c    Mon Jul  6 00:14:55 1992
 
3
--- ../akcl-1-615/c/cmpaux.c      Thu Jun 18 20:01:07 1992
 
4
***************
 
5
*** 229,239 ****
 
6
      if (leng > 0 && leng < x->st.st_dim && x->st.st_self[leng]==0)
 
7
      return x->st.st_self;
 
8
    if (x->st.st_dim == leng
 
9
        && ( leng % sizeof(object))
 
10
       )
 
11
!     { x->st.st_self[leng] = 0;
 
12
        return x->st.st_self;
 
13
      }
 
14
    else
 
15
      {char *res=malloc(leng+1);
 
16
       bcopy(x->st.st_self,res,leng);
 
17
--- 229,240 ----
 
18
      if (leng > 0 && leng < x->st.st_dim && x->st.st_self[leng]==0)
 
19
      return x->st.st_self;
 
20
    if (x->st.st_dim == leng
 
21
        && ( leng % sizeof(object))
 
22
       )
 
23
!     { if(x->st.st_self[leng] != 0)
 
24
!          x->st.st_self[leng] = 0;
 
25
        return x->st.st_self;
 
26
      }
 
27
    else
 
28
      {char *res=malloc(leng+1);
 
29
       bcopy(x->st.st_self,res,leng);
 
30
c/main.c
 
31
*** c/main.c      Mon Jul  6 00:14:59 1992
 
32
--- ../akcl-1-615/c/main.c        Fri Jul  3 02:19:37 1992
 
33
***************
 
34
*** 611,621 ****
 
35
            {catch_fatal = -1;
 
36
             if (sgc_enabled)
 
37
               { sgc_quit();}
 
38
             if (sgc_enabled==0)
 
39
               { install_segmentation_catcher() ;}
 
40
!            FEerror("Caught fatal error [memory may be damaged]"); }
 
41
          printf("\nUnrecoverable error: %s.\n", s);
 
42
          fflush(stdout);
 
43
  #ifdef UNIX
 
44
          abort();
 
45
  #endif
 
46
--- 611,621 ----
 
47
            {catch_fatal = -1;
 
48
             if (sgc_enabled)
 
49
               { sgc_quit();}
 
50
             if (sgc_enabled==0)
 
51
               { install_segmentation_catcher() ;}
 
52
!            FEerror("Caught fatal error [memory may be damaged] ~A",1,make_simple_string(s)); }
 
53
          printf("\nUnrecoverable error: %s.\n", s);
 
54
          fflush(stdout);
 
55
  #ifdef UNIX
 
56
          abort();
 
57
  #endif
 
58
***************
 
59
*** 853,872 ****
 
60
  
 
61
  siLsave_system()
 
62
  {
 
63
          int i;
 
64
  
 
65
- #ifdef HAVE_YP_UNBIND
 
66
-         extern object truename(),namestring();
 
67
          check_arg(1);
 
68
!         /* prevent subsequent consultation of yp by getting
 
69
!            truename now*/
 
70
!         vs_base[0]=namestring(truename(vs_base[0]));
 
71
!         {char name[200];
 
72
!          char *dom = name;
 
73
!          if (0== getdomainname(dom,sizeof(name)))
 
74
!            yp_unbind(dom);}
 
75
  #endif
 
76
          
 
77
          saving_system = TRUE;
 
78
          GBC(t_contiguous);
 
79
  
 
80
--- 853,867 ----
 
81
  
 
82
  siLsave_system()
 
83
  {
 
84
          int i;
 
85
  
 
86
          check_arg(1);
 
87
! #ifdef HAVE_YP_UNBIND
 
88
!         /* see unixsave.c */
 
89
!         {char *dname;
 
90
!          yp_get_default_domain(&dname);}
 
91
  #endif
 
92
          
 
93
          saving_system = TRUE;
 
94
          GBC(t_contiguous);
 
95
  
 
96
c/num_log.c
 
97
*** c/num_log.c   Mon Jul  6 00:15:00 1992
 
98
--- ../akcl-1-615/c/num_log.c     Mon Jun 15 21:15:59 1992
 
99
***************
 
100
*** 266,286 ****
 
101
          return(~j);
 
102
  }
 
103
  
 
104
  int
 
105
  big_bitp(x, p)
 
106
! object  x;
 
107
! int     p;
 
108
  { GEN u = MP(x);
 
109
    int ans ;
 
110
    int i = p /32;
 
111
    if (signe(u) < 0)
 
112
      {  save_avma;
 
113
         u = complementi(u);
 
114
         restore_avma;
 
115
     }
 
116
!   if (i < lgef(u))
 
117
      { ans = ((MP_ITH_WORD(u,i,lgef(u))) & (1 << p%32));}
 
118
    else if (big_sign(x) < 0) ans = 1;
 
119
    else ans = 0;
 
120
    return ans;
 
121
  }
 
122
--- 266,286 ----
 
123
          return(~j);
 
124
  }
 
125
  
 
126
  int
 
127
  big_bitp(x, p)
 
128
! object  x;
 
129
! int     p;
 
130
  { GEN u = MP(x);
 
131
    int ans ;
 
132
    int i = p /32;
 
133
    if (signe(u) < 0)
 
134
      {  save_avma;
 
135
         u = complementi(u);
 
136
         restore_avma;
 
137
     }
 
138
!   if (i < lgef(u) -MP_CODE_WORDS)
 
139
      { ans = ((MP_ITH_WORD(u,i,lgef(u))) & (1 << p%32));}
 
140
    else if (big_sign(x) < 0) ans = 1;
 
141
    else ans = 0;
 
142
    return ans;
 
143
  }
 
144
c/unixsave.c
 
145
*** c/unixsave.c  Mon Jul  6 00:15:07 1992
 
146
--- ../akcl-1-615/c/unixsave.c    Fri Jul  3 02:52:36 1992
 
147
***************
 
148
*** 71,81 ****
 
149
--- 71,160 ----
 
150
                          break;
 
151
                  } else
 
152
                          break;
 
153
  }
 
154
  
 
155
+ #include "page.h"
 
156
  
 
157
+ /* string is aligned on a word boundary */
 
158
+ int
 
159
+ find_string_in_memory(string,length,other_p,function)
 
160
+      char *string;
 
161
+      int length,other_p;
 
162
+      int *function();
 
163
+ {
 
164
+   int *imem_first,*imem_last,*imem,word;
 
165
+   char *mem;
 
166
+   int len,page_first,page_last,i;
 
167
+   int maxpage = page(heap_end);
 
168
+   if(((int)string & 3) == 0 && length >= 4) /* just to be safe */
 
169
+     {word=*(int *)string;
 
170
+      for (page_first = 0;  page_first < maxpage;  page_first++)
 
171
+        if ((enum type)type_map[page_first] != t_other)
 
172
+          break;
 
173
+      for (;  page_first < maxpage;  page_first++)
 
174
+        if (((enum type)type_map[page_first] == t_other)?other_p:!other_p)
 
175
+          {for (page_last = page_first+1;  page_last < maxpage;  page_last++)
 
176
+             if ( !(((enum type)type_map[page_last] == t_other)?other_p:!other_p) )
 
177
+               break;
 
178
+           imem_first=(int *)pagetochar(page_first);
 
179
+           imem_last=(int *)( ( ((int)pagetochar(page_last)) - length) &~3 );
 
180
+           for (imem = imem_first; imem <= imem_last; imem++)
 
181
+             if (*imem == word)
 
182
+               {mem=(char *)imem;
 
183
+                for(i=4; i<length && mem[i]==string[i]; i++);
 
184
+                if(i>=length)
 
185
+                  if((*function)(mem))
 
186
+                    return TRUE;}}}
 
187
+   return FALSE;
 
188
+ }
 
189
 
190
+ int 
 
191
+ fsim_first(address)
 
192
+      char *address;
 
193
+ {
 
194
+   return TRUE;
 
195
+ }
 
196
 
197
+ int 
 
198
+ fsim_reset_pointer(address)
 
199
+      char **address;
 
200
+ {
 
201
+   *address = NULL;
 
202
+   return FALSE;
 
203
+ }
 
204
 
205
+ #define t_other_PAGES TRUE
 
206
+ #define NOT_t_other_PAGES FALSE
 
207
 
208
+ int
 
209
+ reset_other_pointers(address)
 
210
+      char *address;
 
211
+ {
 
212
+   int word=(int)address;
 
213
+   find_string_in_memory(&word,4,t_other_PAGES,fsim_reset_pointer);
 
214
+ }
 
215
 
216
+ int
 
217
+ maybe_reset_pointers(address)
 
218
+      char *address;
 
219
+ {
 
220
+   int word=(int)address;
 
221
+   if(!find_string_in_memory(&word,4,NOT_t_other_PAGES,fsim_first))
 
222
+     reset_other_pointers(address);
 
223
+   return FALSE;
 
224
+ }
 
225
 
226
+ reset_other_pointers_to_string(string)
 
227
+      char *string;
 
228
+ {
 
229
+   int length=strlen(string)+1;
 
230
+   find_string_in_memory(string,length,t_other_PAGES,maybe_reset_pointers);
 
231
+ }
 
232
 
233
+ bool saving_system;
 
234
 
235
  memory_save(original_file, save_file)
 
236
  char *original_file, *save_file;
 
237
  {       MEM_SAVE_LOCALS;
 
238
          char *data_begin, *data_end;
 
239
          int original_data;
 
240
***************
 
241
*** 100,110 ****
 
242
--- 179,206 ----
 
243
          n = open(save_file, O_CREAT|O_WRONLY, 0777);
 
244
          if (n != 1 || (save = fdopen(n, "w")) != stdout) {
 
245
                  fprintf(stderr, "Can't open the save file.\n");
 
246
                  exit(1);
 
247
          }
 
248
 
249
          setbuf(save, stdout_buf);
 
250
 
251
+ #ifdef HAVE_YP_UNBIND
 
252
+ /* yp_get_default_domain() caches the result of getdomainname() in
 
253
+    a malloc'ed block of memory; and gethostbyname saves the result of
 
254
+    yp_get_default_domain() in yet another chunk of memory.  These
 
255
+    cached values will cause problems if the saved image is run on a
 
256
+    machine having a different local domainname.  [When getdomainname 
 
257
+    is called (by CLX, for example) KCL will wait forever.]  There doesn't
 
258
+    seem to be any way to uncache these things (apparently yp_unbind does 
 
259
+    not do this), nor any good way to find these blocks of memory.         */
 
260
+    
 
261
+         if(saving_system)
 
262
+           {char *dname;
 
263
+            yp_get_default_domain(&dname);
 
264
+            reset_other_pointers(dname);}
 
265
+ #endif
 
266
  
 
267
          READ_HEADER;
 
268
          FILECPY_HEADER;
 
269
  
 
270
          for (n = header.a_data, p = data_begin;  ;  n -= BUFSIZ, p += BUFSIZ)
 
271
cmpnew/cmpcall.lsp
 
272
*** cmpnew/cmpcall.lsp    Mon Jul  6 00:15:13 1992
 
273
--- ../akcl-1-615/cmpnew/cmpcall.lsp      Thu Jun 18 21:43:24 1992
 
274
***************
 
275
*** 118,127 ****
 
276
--- 118,128 ----
 
277
                          ;;; responsible for maintaining this condition.
 
278
        (let ((*vs* *vs*) (form (caddr funob)))
 
279
             (declare (object form))
 
280
             (cond ((and (listp args)
 
281
                         *use-sfuncall*
 
282
+                        (<= (length (cdr args)) 10)
 
283
                         ;;Determine if only one value at most is required:
 
284
                         (or
 
285
                          (eq *value-to-go* 'trash)
 
286
                          (and (consp *value-to-go*)
 
287
                               (eq (car *value-to-go*) 'var))
 
288
lsp/autoload.lsp
 
289
*** lsp/autoload.lsp      Mon Jul  6 00:15:27 1992
 
290
--- ../akcl-1-615/lsp/autoload.lsp        Tue Jun 16 02:36:45 1992
 
291
***************
 
292
*** 430,440 ****
 
293
          '(cons
 
294
            fixnum bignum ratio short-float long-float complex
 
295
            character symbol package hash-table
 
296
            array vector string bit-vector
 
297
            structure stream random-state readtable pathname
 
298
!           cfun cclosure sfun gfun cfdata spice fat-string ))
 
299
  
 
300
  (defun room (&optional x)
 
301
    (let ((l (multiple-value-list (si:room-report)))
 
302
          maxpage leftpage ncbpage maxcbpage ncb cbgbccount npage
 
303
          rbused rbfree nrbpage
 
304
--- 430,440 ----
 
305
          '(cons
 
306
            fixnum bignum ratio short-float long-float complex
 
307
            character symbol package hash-table
 
308
            array vector string bit-vector
 
309
            structure stream random-state readtable pathname
 
310
!           cfun cclosure sfun gfun vfun cfdata spice fat-string dclosure))
 
311
  
 
312
  (defun room (&optional x)
 
313
    (let ((l (multiple-value-list (si:room-report)))
 
314
          maxpage leftpage ncbpage maxcbpage ncb cbgbccount npage
 
315
          rbused rbfree nrbpage
 
316
lsp/cmpinit.lsp
 
317
*** lsp/cmpinit.lsp       Mon Jul  6 00:15:28 1992
 
318
--- ../akcl-1-615/lsp/cmpinit.lsp Mon Jun 22 17:11:11 1992
 
319
***************
 
320
*** 4,12 ****
 
321
  (setq compiler::*eval-when-defaults* '(compile eval load))
 
322
  (or (fboundp 'si::get-&environment) (load "defmacro.lsp"))
 
323
  ;(or (get 'si::s-data 'si::s-data)
 
324
  ;    (progn (load "../lsp/setf.lsp") (load "../lsp/defstruct.lsp")))
 
325
  (if (probe-file "sys-proclaim.lisp")(load "sys-proclaim.lisp"))
 
326
 
327
 
328
  
 
329
  ;;;;;
 
330
--- 4,13 ----
 
331
  (setq compiler::*eval-when-defaults* '(compile eval load))
 
332
  (or (fboundp 'si::get-&environment) (load "defmacro.lsp"))
 
333
  ;(or (get 'si::s-data 'si::s-data)
 
334
  ;    (progn (load "../lsp/setf.lsp") (load "../lsp/defstruct.lsp")))
 
335
  (if (probe-file "sys-proclaim.lisp")(load "sys-proclaim.lisp"))
 
336
! (unless (get 'si::basic-wrapper 'si::s-data)
 
337
!   (setf (get 'si::s-data 'si::s-data) nil)
 
338
!   (load "../lsp/defstruct.lsp"))
 
339
  
 
340
  ;;;;;