source: trunk/source/lisp-kernel/pmcl-kernel.c @ 12196

Last change on this file since 12196 was 12196, checked in by gz, 10 years ago

Merge r11497:r11498 into trunk: pass signal number through to async quit handler so can exit by resignalling.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 51.9 KB
Line 
1/*
2   Copyright (C) 1994-2001 Digitool, Inc
3   This file is part of OpenMCL. 
4
5   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
6   License , known as the LLGPL and distributed with OpenMCL as the
7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8   which is distributed with OpenMCL as the file "LGPL".  Where these
9   conflict, the preamble takes precedence. 
10
11   OpenMCL is referenced in the preamble as the "LIBRARY."
12
13   The LLGPL is also available online at
14   http://opensource.franz.com/preamble.html
15*/
16
17#ifdef DARWIN
18/*      dyld.h included here because something in "lisp.h" causes
19    a conflict (actually I think the problem is in "constants.h")
20*/
21#include <mach-o/dyld.h>
22
23#endif
24#include "lisp.h"
25#include "lisp_globals.h"
26#include "gc.h"
27#include "area.h"
28#include <stdlib.h>
29#include <string.h>
30#include "lisp-exceptions.h"
31#include <stdio.h>
32#include <stdlib.h>
33#ifndef WINDOWS
34#include <sys/mman.h>
35#endif
36#include <fcntl.h>
37#include <signal.h>
38#include <errno.h>
39#ifndef WINDOWS
40#include <sys/utsname.h>
41#include <unistd.h>
42#endif
43
44#ifdef LINUX
45#include <mcheck.h>
46#include <dirent.h>
47#include <dlfcn.h>
48#include <sys/time.h>
49#include <sys/resource.h>
50#include <link.h>
51#include <elf.h>
52
53/*
54   The version of <asm/cputable.h> provided by some distributions will
55   claim that <asm-ppc64/cputable.h> doesn't exist.  It may be present
56   in the Linux kernel source tree even if it's not copied to
57   /usr/include/asm-ppc64.  Hopefully, this will be straightened out
58   soon (and/or the PPC_FEATURE_HAS_ALTIVEC constant will be defined
59   in a less volatile place.)  Until that's straightened out, it may
60   be necessary to install a copy of the kernel header in the right
61   place and/or persuade <asm/cputable> to lighten up a bit.
62*/
63
64#ifdef PPC
65#ifndef PPC64
66#include <asm/cputable.h>
67#endif
68#ifndef PPC_FEATURE_HAS_ALTIVEC
69#define PPC_FEATURE_HAS_ALTIVEC 0x10000000
70#endif
71#endif
72#endif
73
74Boolean use_mach_exception_handling = 
75#ifdef DARWIN
76  true
77#else
78  false
79#endif
80;
81
82#ifdef DARWIN
83#include <sys/types.h>
84#include <sys/time.h>
85#include <sys/mman.h>
86#include <sys/resource.h>
87#include <mach/mach_types.h>
88#include <mach/message.h>
89#include <mach/vm_region.h>
90#include <mach/port.h>
91#include <sys/sysctl.h>
92
93Boolean running_under_rosetta = false;
94
95#if WORD_SIZE == 64 || defined(X8632)
96/* Assume that if the OS is new enough to support PPC64/X8664, it has
97   a reasonable dlfcn.h
98*/
99#include <dlfcn.h>
100#endif
101#endif
102
103#if defined(FREEBSD) || defined(SOLARIS)
104#include <sys/time.h>
105#include <sys/resource.h>
106#include <dlfcn.h>
107#include <elf.h> 
108#include <link.h>
109#endif
110
111#include <ctype.h>
112#ifndef WINDOWS
113#include <sys/select.h>
114#endif
115#include "Threads.h"
116
117#include <fenv.h>
118#include <sys/stat.h>
119
120#ifndef MAP_NORESERVE
121#define MAP_NORESERVE (0)
122#endif
123
124#ifdef WINDOWS
125#include <windows.h>
126#include <stdio.h>
127void
128wperror(char* message)
129{
130  char* buffer;
131  DWORD last_error = GetLastError();
132 
133  FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER|
134                FORMAT_MESSAGE_FROM_SYSTEM|
135                FORMAT_MESSAGE_IGNORE_INSERTS,
136                NULL,
137                last_error,
138                MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
139                (LPTSTR)&buffer,
140                0, NULL);
141  fprintf(dbgout, "%s: 0x%x %s\n", message, (unsigned) last_error, buffer);
142  LocalFree(buffer);
143}
144#endif
145
146LispObj lisp_nil = (LispObj) 0;
147bitvector global_mark_ref_bits = NULL;
148
149
150/* These are all "persistent" : they're initialized when
151   subprims are first loaded and should never change. */
152extern LispObj ret1valn;
153extern LispObj nvalret;
154extern LispObj popj;
155
156LispObj text_start = 0;
157
158/* A pointer to some of the kernel's own data; also persistent. */
159
160extern LispObj import_ptrs_base;
161
162
163
164void
165xMakeDataExecutable(void *, unsigned long);
166
167void
168make_dynamic_heap_executable(LispObj *p, LispObj *q)
169{
170  void * cache_start = (void *) p;
171  natural ncacheflush = (natural) q - (natural) p;
172
173  xMakeDataExecutable(cache_start, ncacheflush); 
174}
175     
176size_t
177ensure_stack_limit(size_t stack_size)
178{
179#ifdef WINDOWS
180  extern void os_get_current_thread_stack_bounds(void **, natural*);
181  natural totalsize;
182  void *ignored;
183 
184  os_get_current_thread_stack_bounds(&ignored, &totalsize);
185
186  return (size_t)totalsize-(size_t)(CSTACK_HARDPROT+CSTACK_SOFTPROT);
187
188#else
189  struct rlimit limits;
190  rlim_t cur_stack_limit, max_stack_limit;
191 
192  stack_size += (CSTACK_HARDPROT+CSTACK_SOFTPROT);
193  getrlimit(RLIMIT_STACK, &limits);
194  cur_stack_limit = limits.rlim_cur;
195  max_stack_limit = limits.rlim_max;
196  if (stack_size > max_stack_limit) {
197    stack_size = max_stack_limit;
198  }
199  if (cur_stack_limit < stack_size) {
200    limits.rlim_cur = stack_size;
201    errno = 0;
202    if (setrlimit(RLIMIT_STACK, &limits)) {
203      int e = errno;
204      fprintf(dbgout, "errno = %d\n", e);
205      Fatal(": Stack resource limit too small", "");
206    }
207  }
208#endif
209  return stack_size;
210}
211
212
213/* This should write-protect the bottom of the stack.
214   Doing so reliably involves ensuring that everything's unprotected on exit.
215*/
216
217BytePtr
218allocate_lisp_stack(natural useable,
219                    unsigned softsize,
220                    unsigned hardsize,
221                    lisp_protection_kind softkind,
222                    lisp_protection_kind hardkind,
223                    Ptr *h_p,
224                    BytePtr *base_p,
225                    protected_area_ptr *softp,
226                    protected_area_ptr *hardp)
227{
228  void *allocate_stack(natural);
229  void free_stack(void *);
230  natural size = useable+softsize+hardsize;
231  natural overhead;
232  BytePtr base, softlimit, hardlimit;
233  Ptr h = allocate_stack(size+4095);
234  protected_area_ptr hprotp = NULL, sprotp;
235
236  if (h == NULL) {
237    return NULL;
238  }
239  if (h_p) *h_p = h;
240  base = (BytePtr) align_to_power_of_2( h, log2_page_size);
241  hardlimit = (BytePtr) (base+hardsize);
242  softlimit = hardlimit+softsize;
243
244  overhead = (base - (BytePtr) h);
245  if (hardsize) {
246    hprotp = new_protected_area((BytePtr)base,hardlimit,hardkind, hardsize, true);
247    if (hprotp == NULL) {
248      if (base_p) *base_p = NULL;
249      if (h_p) *h_p = NULL;
250      deallocate(h);
251      return NULL;
252    }
253    if (hardp) *hardp = hprotp;
254  }
255  if (softsize) {
256    sprotp = new_protected_area(hardlimit,softlimit, softkind, softsize, true);
257    if (sprotp == NULL) {
258      if (base_p) *base_p = NULL;
259      if (h_p) *h_p = NULL;
260      if (hardp) *hardp = NULL;
261      if (hprotp) delete_protected_area(hprotp);
262      free_stack(h);
263      return NULL;
264    }
265    if (softp) *softp = sprotp;
266  }
267  if (base_p) *base_p = base;
268  return (BytePtr) ((natural)(base+size));
269}
270
271/*
272  This should only called by something that owns the area_lock, or
273  by the initial thread before other threads exist.
274*/
275area *
276allocate_lisp_stack_area(area_code stack_type,
277                         natural usable,
278                         unsigned softsize, 
279                         unsigned hardsize, 
280                         lisp_protection_kind softkind, 
281                         lisp_protection_kind hardkind)
282
283{
284  BytePtr base, bottom;
285  Ptr h;
286  area *a = NULL;
287  protected_area_ptr soft_area=NULL, hard_area=NULL;
288
289  bottom = allocate_lisp_stack(usable, 
290                               softsize, 
291                               hardsize, 
292                               softkind, 
293                               hardkind, 
294                               &h, 
295                               &base,
296                               &soft_area, 
297                               &hard_area);
298
299  if (bottom) {
300    a = new_area(base, bottom, stack_type);
301    a->hardlimit = base+hardsize;
302    a->softlimit = base+hardsize+softsize;
303    a->h = h;
304    a->softprot = soft_area;
305    a->hardprot = hard_area;
306    add_area_holding_area_lock(a);
307  }
308  return a;
309}
310
311/*
312  Also assumes ownership of the area_lock
313*/
314area*
315register_cstack_holding_area_lock(BytePtr bottom, natural size)
316{
317  BytePtr lowlimit = (BytePtr) (((((natural)bottom)-size)+4095)&~4095);
318  area *a = new_area((BytePtr) bottom-size, bottom, AREA_CSTACK);
319  a->hardlimit = lowlimit+CSTACK_HARDPROT;
320  a->softlimit = a->hardlimit+CSTACK_SOFTPROT;
321#ifdef USE_SIGALTSTACK
322  setup_sigaltstack(a);
323#endif
324  add_area_holding_area_lock(a);
325  return a;
326}
327 
328
329area*
330allocate_vstack_holding_area_lock(natural usable)
331{
332  return allocate_lisp_stack_area(AREA_VSTACK, 
333                                  usable > MIN_VSTACK_SIZE ?
334                                  usable : MIN_VSTACK_SIZE,
335                                  VSTACK_SOFTPROT,
336                                  VSTACK_HARDPROT,
337                                  kVSPsoftguard,
338                                  kVSPhardguard);
339}
340
341area *
342allocate_tstack_holding_area_lock(natural usable)
343{
344  return allocate_lisp_stack_area(AREA_TSTACK, 
345                                  usable > MIN_TSTACK_SIZE ?
346                                  usable : MIN_TSTACK_SIZE,
347                                  TSTACK_SOFTPROT,
348                                  TSTACK_HARDPROT,
349                                  kTSPsoftguard,
350                                  kTSPhardguard);
351}
352
353
354/* It's hard to believe that max & min don't exist already */
355unsigned unsigned_min(unsigned x, unsigned y)
356{
357  if (x <= y) {
358    return x;
359  } else {
360    return y;
361  }
362}
363
364unsigned unsigned_max(unsigned x, unsigned y)
365{
366  if (x >= y) {
367    return x;
368  } else {
369    return y;
370  }
371}
372
373#if WORD_SIZE == 64
374#ifdef DARWIN
375#define MAXIMUM_MAPPABLE_MEMORY (512L<<30L)
376#endif
377#ifdef FREEBSD
378#define MAXIMUM_MAPPABLE_MEMORY (512L<<30L)
379#endif
380#ifdef SOLARIS
381#define MAXIMUM_MAPPABLE_MEMORY (128L<<30L)
382#endif
383#ifdef LINUX
384#ifdef X8664
385#define MAXIMUM_MAPPABLE_MEMORY (512L<<30L)
386#endif
387#ifdef PPC
388#define MAXIMUM_MAPPABLE_MEMORY (128L<<30L)
389#endif
390#endif
391#ifdef WINDOWS
392/* Supposedly, the high-end version of Vista allow 128GB of pageable memory */
393#define MAXIMUM_MAPPABLE_MEMORY (120LL<<30LL)
394#endif
395#else
396#ifdef DARWIN
397#define MAXIMUM_MAPPABLE_MEMORY ((1U<<31)-2*heap_segment_size)
398#endif
399#ifdef LINUX
400#ifdef X86
401#define MAXIMUM_MAPPABLE_MEMORY (9U<<28)
402#else
403#define MAXIMUM_MAPPABLE_MEMORY (1U<<30)
404#endif
405#endif
406#ifdef WINDOWS
407#define MAXIMUM_MAPPABLE_MEMORY (1U<<30)
408#endif
409#ifdef FREEBSD
410#define MAXIMUM_MAPPABLE_MEMORY (1U<<30)
411#endif
412#ifdef SOLARIS
413#define MAXIMUM_MAPPABLE_MEMORY (1U<<30)
414#endif
415#endif
416
417natural
418reserved_area_size = MAXIMUM_MAPPABLE_MEMORY;
419
420area
421  *nilreg_area=NULL,
422  *tenured_area=NULL, 
423  *g2_area=NULL, 
424  *g1_area=NULL,
425  *managed_static_area=NULL,
426  *readonly_area=NULL;
427
428area *all_areas=NULL;
429int cache_block_size=32;
430
431
432#if WORD_SIZE == 64
433#define DEFAULT_LISP_HEAP_GC_THRESHOLD (32<<20)
434#define G2_AREA_THRESHOLD (8<<20)
435#define G1_AREA_THRESHOLD (4<<20)
436#define G0_AREA_THRESHOLD (2<<20)
437#else
438#define DEFAULT_LISP_HEAP_GC_THRESHOLD (16<<20)
439#define G2_AREA_THRESHOLD (4<<20)
440#define G1_AREA_THRESHOLD (2<<20)
441#define G0_AREA_THRESHOLD (1<<20)
442#endif
443
444#define MIN_DYNAMIC_SIZE (DEFAULT_LISP_HEAP_GC_THRESHOLD *2)
445
446#if (WORD_SIZE == 32)
447#define DEFAULT_INITIAL_STACK_SIZE (1<<20)
448#else
449#define DEFAULT_INITIAL_STACK_SIZE (2<<20)
450#endif
451
452natural
453lisp_heap_gc_threshold = DEFAULT_LISP_HEAP_GC_THRESHOLD;
454
455natural
456initial_stack_size = DEFAULT_INITIAL_STACK_SIZE;
457
458natural
459thread_stack_size = 0;
460
461
462/*
463  'start' should be on a segment boundary; 'len' should be
464  an integral number of segments.  remap the entire range.
465*/
466
467void 
468uncommit_pages(void *start, size_t len)
469{
470  UnCommitMemory(start, len);
471}
472
473#define TOUCH_PAGES_ON_COMMIT 0
474
475Boolean
476touch_all_pages(void *start, size_t len)
477{
478#if TOUCH_PAGES_ON_COMMIT
479  extern Boolean touch_page(void *);
480  char *p = (char *)start;
481
482  while (len) {
483    if (!touch_page(p)) {
484      return false;
485    }
486    len -= page_size;
487    p += page_size;
488  }
489#endif
490  return true;
491}
492
493Boolean
494commit_pages(void *start, size_t len)
495{
496  if (len != 0) {
497    if (CommitMemory(start, len)) {
498      if (touch_all_pages(start, len)) {
499        return true;
500      }
501    }
502  }
503  return true;
504}
505
506area *
507find_readonly_area()
508{
509  area *a;
510
511  for (a = active_dynamic_area->succ; a != all_areas; a = a->succ) {
512    if (a->code == AREA_READONLY) {
513      return a;
514    }
515  }
516  return NULL;
517}
518
519area *
520extend_readonly_area(unsigned more)
521{
522  area *a;
523  unsigned mask;
524  BytePtr new_start, new_end;
525
526  if ((a = find_readonly_area()) != NULL) {
527    if ((a->active + more) > a->high) {
528      return NULL;
529    }
530    mask = ((natural)a->active) & (page_size-1);
531    if (mask) {
532      UnProtectMemory(a->active-mask, page_size);
533    }
534    new_start = (BytePtr)(align_to_power_of_2(a->active,log2_page_size));
535    new_end = (BytePtr)(align_to_power_of_2(a->active+more,log2_page_size));
536    if (!CommitMemory(new_start, new_end-new_start)) {
537      return NULL;
538    }
539    return a;
540  }
541  return NULL;
542}
543
544LispObj image_base=0;
545BytePtr pure_space_start, pure_space_active, pure_space_limit;
546BytePtr static_space_start, static_space_active, static_space_limit;
547
548void
549raise_limit()
550{
551#ifdef RLIMIT_AS
552  struct rlimit r;
553  if (getrlimit(RLIMIT_AS, &r) == 0) {
554    r.rlim_cur = r.rlim_max;
555    setrlimit(RLIMIT_AS, &r);
556    /* Could limit heaplimit to rlim_max here if smaller? */
557  }
558#endif
559} 
560
561
562area *
563create_reserved_area(natural totalsize)
564{
565  Ptr h;
566  natural base;
567  BytePtr
568    end, 
569    lastbyte, 
570    start, 
571    want = (BytePtr)IMAGE_BASE_ADDRESS;
572  area *reserved;
573  Boolean fatal = false;
574
575  totalsize = align_to_power_of_2((void *)totalsize, log2_heap_segment_size);
576   
577  if (totalsize < (PURESPACE_RESERVE + MIN_DYNAMIC_SIZE)) {
578    totalsize = PURESPACE_RESERVE + MIN_DYNAMIC_SIZE;
579    fatal = true;
580  }
581
582  start = ReserveMemoryForHeap(want, totalsize);
583
584  if (start == NULL) {
585    if (fatal) {
586      perror("minimal initial mmap");
587      exit(1);
588    }
589    return NULL;
590  }
591
592  h = (Ptr) start;
593  base = (natural) start;
594  image_base = base;
595  lastbyte = (BytePtr) (start+totalsize);
596  static_space_start = static_space_active = (BytePtr)STATIC_BASE_ADDRESS;
597  static_space_limit = static_space_start + STATIC_RESERVE;
598  pure_space_start = pure_space_active = start;
599  pure_space_limit = start + PURESPACE_RESERVE;
600  start = pure_space_limit;
601
602  /*
603    Allocate mark bits here.  They need to be 1/64 the size of the
604     maximum useable area of the heap (+ 3 words for the EGC.)
605  */
606  end = lastbyte;
607  end = (BytePtr) ((natural)((((natural)end) - ((totalsize+63)>>6)) & ~4095));
608
609  global_mark_ref_bits = (bitvector)end;
610  end = (BytePtr) ((natural)((((natural)end) - ((totalsize+63) >> 6)) & ~4095));
611  global_reloctab = (LispObj *) end;
612  reserved = new_area(start, end, AREA_VOID);
613  /* The root of all evil is initially linked to itself. */
614  reserved->pred = reserved->succ = reserved;
615  all_areas = reserved;
616  reserved->markbits = global_mark_ref_bits;
617  return reserved;
618}
619
620void *
621allocate_from_reserved_area(natural size)
622{
623  area *reserved = reserved_area;
624  BytePtr low = reserved->low, high = reserved->high;
625  natural avail = high-low;
626 
627  size = align_to_power_of_2(size, log2_heap_segment_size);
628
629  if (size > avail) {
630    return NULL;
631  }
632  reserved->low += size;
633  reserved->active = reserved->low;
634  reserved->ndnodes -= (size>>dnode_shift);
635  return low;
636}
637
638
639
640BytePtr reloctab_limit = NULL, markbits_limit = NULL;
641
642void
643ensure_gc_structures_writable()
644{
645  natural
646    ndnodes = area_dnode(lisp_global(HEAP_END),lisp_global(HEAP_START)),
647    markbits_size = (3*sizeof(LispObj))+((ndnodes+7)>>3),
648    reloctab_size = (sizeof(LispObj)*(((ndnodes+((1<<bitmap_shift)-1))>>bitmap_shift)+1)),
649    n;
650  BytePtr
651    new_reloctab_limit = (BytePtr)align_to_power_of_2(((natural)global_reloctab)+reloctab_size,log2_page_size),
652    new_markbits_limit = (BytePtr)align_to_power_of_2(((natural)global_mark_ref_bits)+markbits_size,log2_page_size);
653
654  if (new_reloctab_limit > reloctab_limit) {
655    n = new_reloctab_limit - reloctab_limit;
656    CommitMemory(reloctab_limit, n);
657    UnProtectMemory(reloctab_limit, n);
658    reloctab_limit = new_reloctab_limit;
659  }
660 
661  if (new_markbits_limit > markbits_limit) {
662    n = new_markbits_limit-markbits_limit;
663    CommitMemory(markbits_limit, n);
664    UnProtectMemory(markbits_limit, n);
665    markbits_limit = new_markbits_limit;
666  }
667}
668
669
670area *
671allocate_dynamic_area(natural initsize)
672{
673  natural totalsize = align_to_power_of_2(initsize, log2_heap_segment_size);
674  BytePtr start, end;
675  area *a;
676
677  start = allocate_from_reserved_area(totalsize);
678  if (start == NULL) {
679    fprintf(dbgout, "reserved area too small to load heap image\n");
680    exit(1);
681  }
682  end = start + totalsize;
683  a = new_area(start, end, AREA_DYNAMIC);
684  a->active = start+initsize;
685  add_area_holding_area_lock(a);
686  a->markbits = reserved_area->markbits;
687  reserved_area->markbits = NULL;
688  CommitMemory(start, end-start);
689  a->h = start;
690  a->softprot = NULL;
691  a->hardprot = NULL;
692  lisp_global(HEAP_START) = ptr_to_lispobj(a->low);
693  lisp_global(HEAP_END) = ptr_to_lispobj(a->high);
694  markbits_limit = (BytePtr)global_mark_ref_bits;
695  reloctab_limit = (BytePtr)global_reloctab;
696  ensure_gc_structures_writable();
697  return a;
698 }
699
700
701Boolean
702grow_dynamic_area(natural delta)
703{
704  area *a = active_dynamic_area, *reserved = reserved_area;
705  natural avail = reserved->high - reserved->low;
706 
707  delta = align_to_power_of_2(delta, log2_heap_segment_size);
708  if (delta > avail) {
709    return false;
710  }
711
712  if (!commit_pages(a->high,delta)) {
713    return false;
714  }
715
716
717  if (!allocate_from_reserved_area(delta)) {
718    return false;
719  }
720
721
722  a->high += delta;
723  a->ndnodes = area_dnode(a->high, a->low);
724  lisp_global(HEAP_END) += delta;
725  ensure_gc_structures_writable();
726  return true;
727}
728
729/*
730  As above.  Pages that're returned to the reserved_area are
731  "condemned" (e.g, we try to convince the OS that they never
732  existed ...)
733*/
734Boolean
735shrink_dynamic_area(natural delta)
736{
737  area *a = active_dynamic_area, *reserved = reserved_area;
738 
739  delta = align_to_power_of_2(delta, log2_heap_segment_size);
740
741  a->high -= delta;
742  a->ndnodes = area_dnode(a->high, a->low);
743  a->hardlimit = a->high;
744  uncommit_pages(a->high, delta);
745  reserved->low -= delta;
746  reserved->ndnodes += (delta>>dnode_shift);
747  lisp_global(HEAP_END) -= delta;
748  return true;
749}
750
751
752
753void
754user_signal_handler (int signum, siginfo_t *info, ExceptionInformation *context)
755{
756  if (signum == SIGINT) {
757    lisp_global(INTFLAG) = (((signum<<8) + 1) << fixnumshift);
758  }
759  else if (signum == SIGTERM) {
760    lisp_global(INTFLAG) = (((signum<<8) + 2) << fixnumshift);
761  }
762  else if (signum == SIGQUIT) {
763    lisp_global(INTFLAG) = (((signum<<8) + 2) << fixnumshift);
764  }
765#ifdef DARWIN
766  DarwinSigReturn(context);
767#endif
768}
769
770
771void
772register_user_signal_handler()
773{
774#ifdef WINDOWS
775  extern BOOL CALLBACK ControlEventHandler(DWORD);
776
777  signal(SIGINT, SIG_IGN);
778
779  SetConsoleCtrlHandler(ControlEventHandler,TRUE);
780#else
781  install_signal_handler(SIGINT, (void *)user_signal_handler);
782  install_signal_handler(SIGTERM, (void *)user_signal_handler);
783#endif
784}
785
786
787
788BytePtr
789initial_stack_bottom()
790{
791#ifndef WINDOWS
792  extern char **environ;
793  char *p = *environ;
794  while (*p) {
795    p += (1+strlen(p));
796  }
797  return (BytePtr)((((natural) p) +4095) & ~4095);
798#endif
799#ifdef WINDOWS
800  return (BytePtr)((current_stack_pointer() + 4095) & ~ 4095);
801#endif
802}
803
804
805 
806Ptr fatal_spare_ptr = NULL;
807
808
809void
810Fatal(StringPtr param0, StringPtr param1)
811{
812
813  if (fatal_spare_ptr) {
814    deallocate(fatal_spare_ptr);
815    fatal_spare_ptr = NULL;
816  }
817  fprintf(dbgout, "Fatal error: %s\n%s\n", param0, param1);
818  _exit(-1);
819}
820
821OSErr application_load_err = noErr;
822
823area *
824set_nil(LispObj);
825
826
827/* Check for the existence of a file named by 'path'; return true
828   if it seems to exist, without checking size, permissions, or
829   anything else. */
830Boolean
831probe_file(char *path)
832{
833  struct stat st;
834
835  return (stat(path,&st) == 0);
836}
837
838
839#ifdef WINDOWS
840/* Chop the trailing ".exe" from the kernel image name */
841wchar_t *
842chop_exe_suffix(wchar_t *path)
843{
844  int len = wcslen(path);
845  wchar_t *copy = malloc((len+1)*sizeof(wchar_t)), *tail;
846
847  wcscpy(copy,path);
848  tail = wcsrchr(copy, '.');
849  if (tail) {
850    *tail = 0;
851  }
852  return copy;
853}
854#endif
855
856#ifdef WINDOWS
857wchar_t *
858path_by_appending_image(wchar_t *path)
859{
860  int len = wcslen(path) + wcslen(L".image") + 1;
861  wchar_t *copy = (wchar_t *) malloc(len*sizeof(wchar_t));
862
863  if (copy) {
864    wcscpy(copy, path);
865    wcscat(copy, L".image");
866  }
867  return copy;
868}
869#else
870char *
871path_by_appending_image(char *path)
872{
873  int len = strlen(path) + strlen(".image") + 1;
874  char *copy = (char *) malloc(len);
875
876  if (copy) {
877    strcpy(copy, path);
878    strcat(copy, ".image");
879  }
880  return copy;
881}
882#endif
883
884char *
885case_inverted_path(char *path)
886{
887  char *copy = strdup(path), *base = copy, *work = copy, c;
888  if (copy == NULL) {
889    return NULL;
890  }
891  while(*work) {
892    if (*work++ == '/') {
893      base = work;
894    }
895  }
896  work = base;
897  while ((c = *work) != '\0') {
898    if (islower(c)) {
899      *work++ = toupper(c);
900    } else {
901      *work++ = tolower(c);
902    }
903  }
904  return copy;
905}
906/*
907   The underlying file system may be case-insensitive (e.g., HFS),
908   so we can't just case-invert the kernel's name.
909   Tack ".image" onto the end of the kernel's name.  Much better ...
910*/
911#ifdef WINDOWS
912wchar_t *
913default_image_name(wchar_t *orig)
914{
915  wchar_t *path = chop_exe_suffix(orig);
916  wchar_t *image_name = path_by_appending_image(path);
917  return image_name;
918}
919#else
920char *
921default_image_name(char *orig)
922{
923#ifdef WINDOWS
924  char *path = chop_exe_suffix(orig);
925#else
926  char *path = orig;
927#endif
928  char *image_name = path_by_appending_image(path);
929#if !defined(WINDOWS) && !defined(DARWIN)
930  if (!probe_file(image_name)) {
931    char *legacy = case_inverted_path(path);
932    if (probe_file(legacy)) {
933      image_name = legacy;
934    }
935  }
936#endif
937  return image_name;
938}
939#endif
940
941
942
943char *program_name = NULL;
944#ifdef WINDOWS
945wchar_t *real_executable_name = NULL;
946#else
947char *real_executable_name = NULL;
948#endif
949
950#ifndef WINDOWS
951
952char *
953ensure_real_path(char *path)
954{
955  char buf[PATH_MAX*2], *p, *q;
956  int n;
957
958  p = realpath(path, buf);
959 
960  if (p == NULL) {
961    return path;
962  }
963  n = strlen(p);
964  q = malloc(n+1);
965  strcpy(q,p);
966  return q;
967}
968
969char *
970determine_executable_name(char *argv0)
971{
972#ifdef DARWIN
973  uint32_t len = 1024;
974  char exepath[1024], *p = NULL;
975
976  if (_NSGetExecutablePath(exepath, (void *)&len) == 0) {
977    p = malloc(len+1);
978    memmove(p, exepath, len);
979    p[len]=0;
980    return ensure_real_path(p);
981  } 
982  return ensure_real_path(argv0);
983#endif
984#ifdef LINUX
985  char exepath[PATH_MAX], *p;
986  int n;
987
988  if ((n = readlink("/proc/self/exe", exepath, PATH_MAX)) > 0) {
989    p = malloc(n+1);
990    memmove(p,exepath,n);
991    p[n]=0;
992    return p;
993  }
994  return argv0;
995#endif
996#ifdef FREEBSD
997  return ensure_real_path(argv0);
998#endif
999#ifdef SOLARIS
1000  char exepath[PATH_MAX], proc_path[PATH_MAX], *p;
1001  int n;
1002
1003  snprintf(proc_path,PATH_MAX-1,"/proc/%d/path/a.out",getpid());
1004
1005  if ((n = readlink(proc_path, exepath, PATH_MAX)) > 0) {
1006    p = malloc(n+1);
1007    memmove(p,exepath,n);
1008    p[n]=0;
1009    return p;
1010  }
1011  return ensure_real_path(argv0);
1012#endif
1013  return ensure_real_path(argv0);
1014}
1015#endif
1016
1017#ifdef WINDOWS
1018wchar_t *
1019ensure_real_path(wchar_t *path)
1020{
1021  int bufsize = 256, n;
1022
1023  do {
1024    wchar_t buf[bufsize];
1025
1026    n = GetFullPathNameW(path,bufsize,buf,NULL);
1027    if (n == 0) {
1028      return path;
1029    }
1030
1031    if (n < bufsize) {
1032      int i;
1033      wchar_t *q = calloc(n+1,sizeof(wchar_t));
1034
1035      for (i = 0; i < n; i++) {
1036        q[i] = buf[i];
1037      }
1038      return q;
1039    }
1040    bufsize = n+1;
1041  } while (1);
1042}
1043#endif
1044
1045void
1046usage_exit(char *herald, int exit_status, char* other_args)
1047{
1048  if (herald && *herald) {
1049    fprintf(dbgout, "%s\n", herald);
1050  }
1051  fprintf(dbgout, "usage: %s <options>\n", program_name);
1052  fprintf(dbgout, "\t or %s <image-name>\n", program_name);
1053  fprintf(dbgout, "\t where <options> are one or more of:\n");
1054  if (other_args && *other_args) {
1055    fputs(other_args, dbgout);
1056  }
1057  fprintf(dbgout, "\t-R, --heap-reserve <n>: reserve <n> (default: %lld)\n",
1058          (u64_t) reserved_area_size);
1059  fprintf(dbgout, "\t\t bytes for heap expansion\n");
1060  fprintf(dbgout, "\t-S, --stack-size <n>: set  size of initial thread's control stack to <n>\n");
1061  fprintf(dbgout, "\t-Z, --thread-stack-size <n>: set default size of first (listener)  thread's stacks based on <n>\n");
1062  fprintf(dbgout, "\t-b, --batch: exit when EOF on *STANDARD-INPUT*\n");
1063  fprintf(dbgout, "\t--no-sigtrap : obscure option for running under GDB\n");
1064  fprintf(dbgout, "\t-I, --image-name <image-name>\n");
1065#ifndef WINDOWS
1066  fprintf(dbgout, "\t and <image-name> defaults to %s\n", 
1067          default_image_name(program_name));
1068#endif
1069  fprintf(dbgout, "\n");
1070  _exit(exit_status);
1071}
1072
1073int no_sigtrap = 0;
1074#ifdef WINDOWS
1075wchar_t *image_name = NULL;
1076#else
1077char *image_name = NULL;
1078#endif
1079int batch_flag = 0;
1080
1081
1082natural
1083parse_numeric_option(char *arg, char *argname, natural default_val)
1084{
1085  char *tail;
1086  natural val = 0;
1087
1088  val = strtoul(arg, &tail, 0);
1089  switch(*tail) {
1090  case '\0':
1091    break;
1092   
1093  case 'M':
1094  case 'm':
1095    val = val << 20;
1096    break;
1097   
1098  case 'K':
1099  case 'k':
1100    val = val << 10;
1101    break;
1102   
1103  case 'G':
1104  case 'g':
1105    val = val << 30;
1106    break;
1107   
1108  default:
1109    fprintf(dbgout, "couldn't parse %s argument %s", argname, arg);
1110    val = default_val;
1111    break;
1112  }
1113  return val;
1114}
1115 
1116
1117
1118/*
1119   The set of arguments recognized by the kernel is
1120   likely to remain pretty small and pretty simple.
1121   This removes everything it recognizes from argv;
1122   remaining args will be processed by lisp code.
1123*/
1124
1125void
1126process_options(int argc, char *argv[], wchar_t *shadow[])
1127{
1128  int i, j, k, num_elide, flag, arg_error;
1129  char *arg, *val;
1130  wchar_t *warg, *wval;
1131#ifdef DARWIN
1132  extern int NXArgc;
1133#endif
1134
1135  for (i = 1; i < argc;) {
1136    arg = argv[i];
1137    if (shadow) {
1138      warg = shadow[i];
1139    }
1140    arg_error = 0;
1141    if (*arg != '-') {
1142      i++;
1143    } else {
1144      num_elide = 0;
1145      val = NULL;
1146      if ((flag = (strncmp(arg, "-I", 2) == 0)) ||
1147          (strcmp (arg, "--image-name") == 0)) {
1148        if (flag && arg[2]) {
1149          val = arg+2;         
1150          if (shadow) {
1151            wval = warg+2;
1152          }
1153          num_elide = 1;
1154        } else {
1155          if ((i+1) < argc) {
1156            val = argv[i+1];
1157            if (shadow) {
1158              wval = shadow[i+1];
1159            }
1160            num_elide = 2;
1161          } else {
1162            arg_error = 1;
1163          }
1164        }
1165        if (val) {
1166#ifdef WINDOWS
1167          image_name = wval;
1168#else
1169          image_name = val;
1170#endif
1171        }
1172      } else if ((flag = (strncmp(arg, "-R", 2) == 0)) ||
1173                 (strcmp(arg, "--heap-reserve") == 0)) {
1174        natural reserved_size = reserved_area_size;
1175
1176        if (flag && arg[2]) {
1177          val = arg+2;
1178          num_elide = 1;
1179        } else {
1180          if ((i+1) < argc) {
1181            val = argv[i+1];
1182            num_elide = 2;
1183          } else {
1184            arg_error = 1;
1185          }
1186        }
1187
1188        if (val) {
1189          reserved_size = parse_numeric_option(val, 
1190                                               "-R/--heap-reserve", 
1191                                               reserved_area_size);
1192        }
1193
1194        if (reserved_size <= MAXIMUM_MAPPABLE_MEMORY) {
1195          reserved_area_size = reserved_size;
1196        }
1197
1198      } else if ((flag = (strncmp(arg, "-S", 2) == 0)) ||
1199                 (strcmp(arg, "--stack-size") == 0)) {
1200        natural stack_size;
1201
1202        if (flag && arg[2]) {
1203          val = arg+2;
1204          num_elide = 1;
1205        } else {
1206          if ((i+1) < argc) {
1207            val = argv[i+1];
1208            num_elide = 2;
1209          } else {
1210            arg_error = 1;
1211          }
1212        }
1213
1214        if (val) {
1215          stack_size = parse_numeric_option(val, 
1216                                            "-S/--stack-size", 
1217                                            initial_stack_size);
1218         
1219
1220          if (stack_size >= MIN_CSTACK_SIZE) {
1221            initial_stack_size = stack_size;
1222          }
1223        }
1224
1225      } else if ((flag = (strncmp(arg, "-Z", 2) == 0)) ||
1226                 (strcmp(arg, "--thread-stack-size") == 0)) {
1227        natural stack_size;
1228
1229        if (flag && arg[2]) {
1230          val = arg+2;
1231          num_elide = 1;
1232        } else {
1233          if ((i+1) < argc) {
1234            val = argv[i+1];
1235            num_elide = 2;
1236          } else {
1237            arg_error = 1;
1238          }
1239        }
1240
1241        if (val) {
1242          stack_size = parse_numeric_option(val, 
1243                                            "-Z/--thread-stack-size", 
1244                                            thread_stack_size);
1245         
1246
1247          if (stack_size >= MIN_CSTACK_SIZE) {
1248           thread_stack_size = stack_size;
1249          }
1250          if (thread_stack_size >= (1LL<<((WORD_SIZE-fixnumshift)-1))) {
1251            thread_stack_size = (1LL<<((WORD_SIZE-fixnumshift)-1))-1;
1252          }
1253         
1254        }
1255
1256      } else if (strcmp(arg, "--no-sigtrap") == 0) {
1257        no_sigtrap = 1;
1258        num_elide = 1;
1259      } else if ((strcmp(arg, "-b") == 0) ||
1260                 (strcmp(arg, "--batch") == 0)) {
1261        batch_flag = 1;
1262        num_elide = 1;
1263      } else if (strcmp(arg,"--") == 0) {
1264        break;
1265      } else {
1266        i++;
1267      }
1268      if (arg_error) {
1269        usage_exit("error in program arguments", 1, "");
1270      }
1271      if (num_elide) {
1272        for (j = i+num_elide, k=i; j < argc; j++, k++) {
1273          argv[k] = argv[j];
1274          if (shadow) {
1275            shadow[k] = shadow[j];
1276          }
1277        }
1278        argc -= num_elide;
1279#ifdef DARWIN
1280        NXArgc -= num_elide;
1281#endif
1282        argv[argc] = NULL;
1283      }
1284    }
1285  }
1286}
1287
1288#ifdef WINDOWS
1289void
1290terminate_lisp()
1291{
1292  _exit(EXIT_FAILURE);
1293}
1294#else
1295pid_t main_thread_pid = (pid_t)0;
1296
1297void
1298terminate_lisp()
1299{
1300  kill(main_thread_pid, SIGKILL);
1301  _exit(-1);
1302}
1303#endif
1304
1305#ifdef DARWIN
1306#define min_os_version "8.0"    /* aka Tiger */
1307#endif
1308#ifdef LINUX
1309#ifdef PPC
1310#define min_os_version "2.2"
1311#endif
1312#ifdef X86
1313#define min_os_version "2.6"
1314#endif
1315#endif
1316#ifdef FREEBSD
1317#define min_os_version "6.0"
1318#endif
1319#ifdef SOLARIS
1320#define min_os_version "5.10"
1321#endif
1322
1323#ifdef PPC
1324#if defined(PPC64) || !defined(DARWIN)
1325/* ld64 on Darwin doesn't offer anything close to reliable control
1326   over the layout of a program in memory.  About all that we can
1327   be assured of is that the canonical subprims jump table address
1328   (currently 0x5000) is unmapped.  Map that page, and copy the
1329   actual spjump table there. */
1330
1331
1332void
1333remap_spjump()
1334{
1335  extern opcode spjump_start, spjump_end;
1336  pc new,
1337    old = &spjump_start,
1338    limit = &spjump_end,
1339    work;
1340  opcode instr;
1341  void *target;
1342  int disp;
1343 
1344  if (old != (pc)SPJUMP_TARGET_ADDRESS) {
1345    new = mmap((pc) SPJUMP_TARGET_ADDRESS,
1346               0x1000,
1347               PROT_READ | PROT_WRITE | PROT_EXEC,
1348               MAP_PRIVATE | MAP_ANON | MAP_FIXED,
1349               -1,
1350               0);
1351    if (new != (pc) SPJUMP_TARGET_ADDRESS) {
1352      perror("remap spjump");
1353      _exit(1);
1354    }
1355   
1356    for (work = new; old < limit; work++, old++) {
1357      instr = *old;
1358      disp = instr & ((1<<26)-1);
1359      target = (void*)old+disp;
1360      disp = target-(void *)work;
1361      *work = ((instr >> 26) << 26) | disp;
1362    }
1363    xMakeDataExecutable(new, (void*)work-(void*)new);
1364    ProtectMemory(new, 0x1000);
1365  }
1366}
1367#endif
1368#endif
1369
1370#ifdef X86
1371#ifdef WINDOWS
1372
1373/* By using linker tricks, we ensure there's memory between 0x11000
1374   and 0x21000, so we just need to fix permissions and copy the spjump
1375   table. */
1376
1377void
1378remap_spjump()
1379{
1380  extern opcode spjump_start;
1381  DWORD old_protect;
1382
1383  if ((void *)(&spjump_start) != (void *) SPJUMP_TARGET_ADDRESS) {
1384    if (!VirtualProtect((pc) SPJUMP_TARGET_ADDRESS,
1385                        0x1000,
1386                        PAGE_EXECUTE_READWRITE,
1387                        &old_protect)) {
1388      wperror("VirtualProtect spjump");
1389      _exit(1);
1390    }
1391    memmove((pc) SPJUMP_TARGET_ADDRESS, &spjump_start, 0x1000);
1392  }
1393}
1394#else
1395void
1396remap_spjump()
1397{
1398  extern opcode spjump_start;
1399  pc new = mmap((pc) SPJUMP_TARGET_ADDRESS,
1400                0x1000,
1401                PROT_READ | PROT_WRITE | PROT_EXEC,
1402                MAP_PRIVATE | MAP_ANON | MAP_FIXED,
1403                -1,
1404                0),
1405    old = &spjump_start;
1406  if (new == (pc)-1) {
1407    perror("remap spjump");
1408    _exit(1);
1409  }
1410  memmove(new, old, 0x1000);
1411}
1412#endif
1413#endif
1414
1415
1416void
1417check_os_version(char *progname)
1418{
1419#ifdef WINDOWS
1420  /* We should be able to run with any version of Windows that actually gets here executing the binary, so don't do anything for now. */
1421#else
1422  struct utsname uts;
1423  long got, want;
1424  char *got_end,*want_end;
1425#ifdef X8632
1426  extern Boolean rcontext_readonly;
1427#endif
1428
1429  want = strtoul(min_os_version,&want_end,10);
1430
1431  uname(&uts);
1432  got = strtoul(uts.release,&got_end,10);
1433#ifdef X8632
1434#ifdef FREEBSD
1435  if (!strcmp(uts.machine,"amd64")) {
1436    rcontext_readonly = true;
1437  }
1438#endif
1439#endif
1440  while (got == want) {
1441    if (*want_end == '.') {
1442      want = strtoul(want_end+1,&want_end,10);
1443      got = 0;
1444      if (*got_end == '.') {
1445        got = strtoul(got_end+1,&got_end,10);
1446      } else {
1447        break;
1448      }
1449    } else {
1450      break;
1451    }
1452  }
1453
1454  if (got < want) {
1455    fprintf(dbgout, "\n%s requires %s version %s or later; the current version is %s.\n", progname, uts.sysname, min_os_version, uts.release);
1456    exit(1);
1457  }
1458#ifdef PPC
1459#ifdef DARWIN
1460  {
1461    char *hosttype = getenv("HOSTTYPE");
1462    if (hosttype && !strncmp("intel", hosttype, 5)) {
1463      running_under_rosetta = true;
1464      use_mach_exception_handling = false;
1465      reserved_area_size = 1U << 30;
1466    }
1467  }
1468#endif
1469#endif
1470#endif
1471}
1472
1473#ifdef X86
1474/*
1475  This should determine the cache block size.  It should also
1476  probably complain if we don't have (at least) SSE2.
1477*/
1478extern int cpuid(natural, natural*, natural*, natural*);
1479
1480#define X86_FEATURE_CMOV    (1<<15)
1481#define X86_FEATURE_CLFLUSH (1<<19)
1482#define X86_FEATURE_MMX     (1<<23)
1483#define X86_FEATURE_SSE     (1<<25)
1484#define X86_FEATURE_SSE2    (1<<26)
1485
1486#define X86_REQUIRED_FEATURES (X86_FEATURE_CMOV|X86_FEATURE_MMX|X86_FEATURE_SSE|X86_FEATURE_SSE2)
1487
1488Boolean
1489check_x86_cpu()
1490{
1491  natural eax, ebx, ecx, edx;
1492
1493  eax = cpuid(0, &ebx, &ecx, &edx);
1494
1495  if (eax >= 1) {
1496    eax = cpuid(1, &ebx, &ecx, &edx);
1497    cache_block_size = (ebx & 0xff00) >> 5;
1498    if ((X86_REQUIRED_FEATURES & edx) == X86_REQUIRED_FEATURES) {
1499      return true;
1500    }
1501    /* It's very unlikely that SSE2 would be present and other things
1502       that we want wouldn't.  If they don't have MMX or CMOV either,
1503       might as well tell them. */
1504    if ((edx & X86_FEATURE_SSE2) == 0) {
1505      fprintf(dbgout, "This CPU doesn't support the SSE2 instruction set\n");
1506    }
1507    if ((edx & X86_FEATURE_MMX) == 0) {
1508      fprintf(dbgout, "This CPU doesn't support the MMX instruction set\n");
1509    }
1510    if ((edx & X86_FEATURE_CMOV) == 0) {
1511      fprintf(dbgout, "This CPU doesn't support the CMOV instruction\n");
1512    }
1513   
1514  }
1515  return false;
1516}
1517#endif
1518
1519void
1520lazarus()
1521{
1522  TCR *tcr = get_tcr(false);
1523  if (tcr) {
1524    /* Some threads may be dying; no threads should be created. */
1525    LOCK(lisp_global(TCR_AREA_LOCK),tcr);
1526    tcr->vs_area->active = tcr->vs_area->high - node_size;
1527    tcr->save_vsp = (LispObj *)(tcr->vs_area->active);
1528    tcr->ts_area->active = tcr->ts_area->high;
1529    tcr->save_tsp = (LispObj *)(tcr->ts_area->active);
1530    tcr->catch_top = 0;
1531    tcr->db_link = 0;
1532    tcr->xframe = 0;
1533    start_lisp(tcr, 0);
1534  }
1535}
1536
1537#ifdef LINUX
1538#ifdef X8664
1539#include <asm/prctl.h>
1540#include <sys/prctl.h>
1541
1542void
1543ensure_gs_available(char *progname)
1544{
1545  LispObj fs_addr = 0L, gs_addr = 0L, cur_thread = (LispObj)pthread_self();
1546  char *gnu_get_libc_version(void);
1547 
1548  arch_prctl(ARCH_GET_GS, &gs_addr);
1549  arch_prctl(ARCH_GET_FS, &fs_addr);
1550  if ((gs_addr == cur_thread) && (fs_addr != cur_thread)) {
1551    fprintf(dbgout, "The installed C library - version %s - seems to be using the %%gs register for thread storage.\n\"%s\" cannot run, since it expects to be\nable to use that register for its own purposes.\n", gnu_get_libc_version(),progname);
1552    _exit(1);
1553  }
1554}
1555#endif
1556#endif
1557
1558Boolean
1559bogus_fp_exceptions = false;
1560
1561typedef
1562float (*float_arg_returns_float)(float);
1563
1564float
1565fcallf(float_arg_returns_float fun, float arg)
1566{
1567  return fun(arg);
1568}
1569
1570void
1571check_bogus_fp_exceptions()
1572{
1573#ifdef X8664
1574  float asinf(float),result;
1575   
1576
1577  natural save_mxcsr = get_mxcsr(), post_mxcsr;
1578  set_mxcsr(0x1f80);
1579
1580  result = fcallf(asinf, 1.0);
1581  post_mxcsr = get_mxcsr();
1582  set_mxcsr(save_mxcsr);
1583  if (post_mxcsr & (FE_ALL_EXCEPT & (~FE_INEXACT))) {
1584    bogus_fp_exceptions = true;
1585  }
1586#endif
1587}
1588
1589#ifdef WINDOWS
1590char *
1591utf_16_to_utf_8(wchar_t *utf_16)
1592{
1593  int utf8len = WideCharToMultiByte(CP_UTF8,
1594                                    0,
1595                                    utf_16,
1596                                    -1,
1597                                    NULL,
1598                                    0,
1599                                    NULL,
1600                                    NULL);
1601
1602  char *utf_8 = malloc(utf8len);
1603
1604  WideCharToMultiByte(CP_UTF8,
1605                      0,
1606                      utf_16,
1607                      -1,
1608                      utf_8,
1609                      utf8len,
1610                      NULL,
1611                      NULL);
1612
1613  return utf_8;
1614}
1615
1616char **
1617wide_argv_to_utf_8(wchar_t *wide_argv[], int argc)
1618{
1619  char** argv = calloc(argc+1,sizeof(char *));
1620  int i;
1621
1622  for (i = 0; i < argc; i++) {
1623    argv[i] = utf_16_to_utf_8(wide_argv[i]);
1624  }
1625  return argv;
1626}
1627#endif
1628
1629
1630 
1631
1632
1633int
1634main(int argc, char *argv[]
1635#ifndef WINDOWS
1636, char *envp[], void *aux
1637#endif
1638)
1639{
1640  extern int page_size;
1641  natural default_g0_threshold = G0_AREA_THRESHOLD,
1642    default_g1_threshold = G1_AREA_THRESHOLD,
1643    default_g2_threshold = G2_AREA_THRESHOLD,
1644    lisp_heap_threshold_from_image = 0;
1645  Boolean egc_enabled =
1646#ifdef DISABLE_EGC
1647    false
1648#else
1649    true
1650#endif
1651    ;
1652  Boolean lisp_heap_threshold_set_from_command_line = false;
1653  wchar_t **utf_16_argv = NULL;
1654
1655#ifdef PPC
1656  extern int altivec_present;
1657#endif
1658#ifdef WINDOWS
1659  extern LispObj load_image(wchar_t *);
1660#else
1661  extern LispObj load_image(char *);
1662#endif
1663  area *a;
1664  BytePtr stack_base, current_sp = (BytePtr) current_stack_pointer();
1665  TCR *tcr;
1666
1667  dbgout = stderr;
1668
1669#ifdef WINDOWS
1670  {
1671    int wide_argc;
1672    extern void init_winsock(void);
1673    extern void init_windows_io(void);
1674
1675    _fmode = O_BINARY;
1676    _setmode(1, O_BINARY);
1677    _setmode(2, O_BINARY);
1678    setvbuf(dbgout, NULL, _IONBF, 0);
1679    init_winsock();
1680    init_windows_io();
1681    utf_16_argv = CommandLineToArgvW(GetCommandLineW(),&wide_argc);
1682  }
1683#endif
1684
1685  check_os_version(argv[0]);
1686#ifdef WINDOWS
1687  real_executable_name = utf_16_argv[0];
1688#else
1689  real_executable_name = determine_executable_name(argv[0]);
1690#endif
1691  page_size = getpagesize(); /* Implement with GetSystemInfo on Windows w/o MinGW */
1692
1693  check_bogus_fp_exceptions();
1694#ifdef LINUX
1695#ifdef X8664
1696  ensure_gs_available(real_executable_name);
1697#endif
1698#endif
1699#if (defined(DARWIN) && defined(PPC64)) || (defined(LINUX) && defined(PPC))|| defined(X8664) || (defined(X8632) && !defined(DARWIN))
1700  remap_spjump();
1701#endif
1702
1703#ifdef PPC
1704#ifdef LINUX
1705  {
1706    ElfW(auxv_t) *av = aux;
1707    int hwcap, done = false;
1708   
1709    if (av) {
1710      do {
1711        switch (av->a_type) {
1712        case AT_DCACHEBSIZE:
1713          cache_block_size = av->a_un.a_val;
1714          break;
1715
1716        case AT_HWCAP:
1717          hwcap = av->a_un.a_val;
1718          altivec_present = ((hwcap & PPC_FEATURE_HAS_ALTIVEC) != 0);
1719          break;
1720
1721        case AT_NULL:
1722          done = true;
1723          break;
1724        }
1725        av++;
1726      } while (!done);
1727    }
1728  }
1729#endif
1730#ifdef DARWIN
1731  {
1732    unsigned value = 0;
1733    size_t len = sizeof(value);
1734    int mib[2];
1735   
1736    mib[0] = CTL_HW;
1737    mib[1] = HW_CACHELINE;
1738    if (sysctl(mib,2,&value,&len, NULL, 0) != -1) {
1739      if (len == sizeof(value)) {
1740        cache_block_size = value;
1741      }
1742    }
1743    mib[1] = HW_VECTORUNIT;
1744    value = 0;
1745    len = sizeof(value);
1746    if (sysctl(mib,2,&value,&len, NULL, 0) != -1) {
1747      if (len == sizeof(value)) {
1748        altivec_present = value;
1749      }
1750    }
1751  }
1752#endif
1753#endif
1754
1755#ifdef X86
1756  if (!check_x86_cpu()) {
1757    fprintf(dbgout, "CPU doesn't support required features\n");
1758    exit(1);
1759  }
1760#endif
1761
1762#ifdef SOLARIS
1763#ifdef X8632
1764  {
1765    extern void solaris_ldt_init(void);
1766    solaris_ldt_init();
1767  }
1768#endif
1769#endif
1770
1771#ifndef WINDOWS
1772  main_thread_pid = getpid();
1773#endif
1774  tcr_area_lock = (void *)new_recursive_lock();
1775
1776  program_name = argv[0];
1777  if ((argc == 2) && (*argv[1] != '-')) {
1778#ifdef WINDOWS
1779    image_name = utf_16_argv[1];
1780#else
1781    image_name = argv[1];
1782#endif
1783    argv[1] = NULL;
1784#ifdef WINDOWS
1785    utf_16_argv[1] = NULL;
1786#endif
1787  } else {
1788    process_options(argc,argv,utf_16_argv);
1789  }
1790  if (lisp_heap_gc_threshold != DEFAULT_LISP_HEAP_GC_THRESHOLD) {
1791    lisp_heap_threshold_set_from_command_line = true;
1792  }
1793
1794  initial_stack_size = ensure_stack_limit(initial_stack_size);
1795  if (image_name == NULL) {
1796    if (check_for_embedded_image(real_executable_name)) {
1797      image_name = real_executable_name;
1798    } else {
1799      image_name = default_image_name(real_executable_name);
1800    }
1801  }
1802
1803  while (1) {
1804    if (create_reserved_area(reserved_area_size)) {
1805      break;
1806    }
1807    reserved_area_size = reserved_area_size *.9;
1808  }
1809
1810  gc_init();
1811
1812  set_nil(load_image(image_name));
1813  lisp_heap_threshold_from_image = lisp_global(LISP_HEAP_THRESHOLD);
1814  if (lisp_heap_threshold_from_image) {
1815    if ((!lisp_heap_threshold_set_from_command_line) &&
1816        (lisp_heap_threshold_from_image != lisp_heap_gc_threshold)) {
1817      lisp_heap_gc_threshold = lisp_heap_threshold_from_image;
1818      resize_dynamic_heap(active_dynamic_area->active,lisp_heap_gc_threshold);
1819    }
1820    /* If lisp_heap_threshold_from_image was set, other image params are
1821       valid. */
1822    default_g0_threshold = lisp_global(G0_THRESHOLD);
1823    default_g1_threshold = lisp_global(G1_THRESHOLD);
1824    default_g2_threshold = lisp_global(G2_THRESHOLD);
1825    egc_enabled = lisp_global(EGC_ENABLED);
1826  }
1827
1828  lisp_global(TCR_AREA_LOCK) = ptr_to_lispobj(tcr_area_lock);
1829
1830#ifdef X86
1831  lisp_global(SUBPRIMS_BASE) = (LispObj)((1<<16)+(5<<10));
1832#else
1833  lisp_global(SUBPRIMS_BASE) = (LispObj)(5<<10);
1834#endif
1835  lisp_global(RET1VALN) = (LispObj)&ret1valn;
1836  lisp_global(LEXPR_RETURN) = (LispObj)&nvalret;
1837  lisp_global(LEXPR_RETURN1V) = (LispObj)&popj;
1838  lisp_global(ALL_AREAS) = ptr_to_lispobj(all_areas);
1839  lisp_global(DEFAULT_ALLOCATION_QUANTUM) = log2_heap_segment_size << fixnumshift;
1840  lisp_global(STACK_SIZE) = thread_stack_size<<fixnumshift;
1841
1842
1843  exception_init();
1844
1845 
1846
1847#ifdef WINDOWS
1848  lisp_global(IMAGE_NAME) = ptr_to_lispobj(utf_16_to_utf_8(ensure_real_path(image_name)));
1849  lisp_global(KERNEL_PATH) = ptr_to_lispobj(utf_16_to_utf_8(real_executable_name));
1850  lisp_global(ARGV) = ptr_to_lispobj(wide_argv_to_utf_8(utf_16_argv, argc));
1851#else
1852  lisp_global(IMAGE_NAME) = ptr_to_lispobj(ensure_real_path(image_name));
1853  lisp_global(KERNEL_PATH) = ptr_to_lispobj(real_executable_name);
1854  lisp_global(ARGV) = ptr_to_lispobj(argv);
1855#endif
1856  lisp_global(KERNEL_IMPORTS) = (LispObj)import_ptrs_base;
1857
1858  lisp_global(GET_TCR) = (LispObj) get_tcr;
1859  *(double *) &(lisp_global(DOUBLE_FLOAT_ONE)) = (double) 1.0;
1860
1861  lisp_global(HOST_PLATFORM) = (LispObj) PLATFORM << fixnumshift;
1862
1863  lisp_global(BATCH_FLAG) = (batch_flag << fixnumshift);
1864
1865  a = active_dynamic_area;
1866
1867  if (nilreg_area != NULL) {
1868    BytePtr lowptr = (BytePtr) a->low;
1869
1870    /* Create these areas as AREA_STATIC, change them to AREA_DYNAMIC */
1871    g1_area = new_area(lowptr, lowptr, AREA_STATIC);
1872    g2_area = new_area(lowptr, lowptr, AREA_STATIC);
1873    tenured_area = new_area(lowptr, lowptr, AREA_STATIC);
1874    add_area_holding_area_lock(tenured_area);
1875    add_area_holding_area_lock(g2_area);
1876    add_area_holding_area_lock(g1_area);
1877
1878    g1_area->code = AREA_DYNAMIC;
1879    g2_area->code = AREA_DYNAMIC;
1880    tenured_area->code = AREA_DYNAMIC;
1881
1882/*    a->older = g1_area; */ /* Not yet: this is what "enabling the EGC" does. */
1883    g1_area->younger = a;
1884    g1_area->older = g2_area;
1885    g2_area->younger = g1_area;
1886    g2_area->older = tenured_area;
1887    tenured_area->younger = g2_area;
1888    tenured_area->refbits = a->markbits;
1889    tenured_area->static_dnodes = a->static_dnodes;
1890    a->static_dnodes = 0;
1891    tenured_area->static_used = a->static_used;
1892    a->static_used = 0;
1893    lisp_global(TENURED_AREA) = ptr_to_lispobj(tenured_area);
1894    lisp_global(REFBITS) = ptr_to_lispobj(tenured_area->refbits);
1895    g2_area->threshold = default_g2_threshold;
1896    g1_area->threshold = default_g1_threshold;
1897    a->threshold = default_g0_threshold;
1898  }
1899
1900  tcr = new_tcr(initial_stack_size, MIN_TSTACK_SIZE);
1901  stack_base = initial_stack_bottom()-xStackSpace();
1902  init_threads((void *)(stack_base), tcr);
1903  thread_init_tcr(tcr, current_sp, current_sp-stack_base);
1904
1905  lisp_global(EXCEPTION_LOCK) = ptr_to_lispobj(new_recursive_lock());
1906  enable_fp_exceptions();
1907  register_user_signal_handler();
1908
1909#ifdef PPC
1910  lisp_global(ALTIVEC_PRESENT) = altivec_present << fixnumshift;
1911#endif
1912#if STATIC
1913  lisp_global(STATICALLY_LINKED) = 1 << fixnumshift;
1914#endif
1915  tcr->prev = tcr->next = tcr;
1916#ifndef WINDOWS
1917  lisp_global(INTERRUPT_SIGNAL) = (LispObj) box_fixnum(SIGNAL_FOR_PROCESS_INTERRUPT);
1918#endif
1919  tcr->vs_area->active -= node_size;
1920  *(--tcr->save_vsp) = nrs_TOPLFUNC.vcell;
1921  nrs_TOPLFUNC.vcell = lisp_nil;
1922#ifdef GC_INTEGRITY_CHECKING
1923  (nrs_GC_EVENT_STATUS_BITS.vcell |= gc_integrity_check_bit);
1924#endif
1925  if (egc_enabled) {
1926    egc_control(true, NULL);
1927  }
1928  atexit(lazarus);
1929  start_lisp(TCR_TO_TSD(tcr), 0);
1930  _exit(0);
1931}
1932
1933area *
1934set_nil(LispObj r)
1935{
1936
1937  if (lisp_nil == (LispObj)NULL) {
1938
1939    lisp_nil = r;
1940  }
1941  return NULL;
1942}
1943
1944
1945void
1946xMakeDataExecutable(void *start, unsigned long nbytes)
1947{
1948  extern void flush_cache_lines();
1949  natural ustart = (natural) start, base, end;
1950 
1951  base = (ustart) & ~(cache_block_size-1);
1952  end = (ustart + nbytes + cache_block_size - 1) & ~(cache_block_size-1);
1953#ifdef DARWIN
1954  if (running_under_rosetta) {
1955    /* We probably need to flush something's cache even if running
1956       under Rosetta, but (a) this is agonizingly slow and (b) we're
1957       dying before we get to the point where this would matter.
1958    */
1959    return;
1960  }
1961#endif
1962#ifndef X86
1963  flush_cache_lines(base, (end-base)/cache_block_size, cache_block_size);
1964#endif
1965}
1966
1967natural
1968xStackSpace()
1969{
1970  return initial_stack_size+CSTACK_HARDPROT+CSTACK_SOFTPROT;
1971}
1972
1973#ifndef DARWIN
1974#ifdef WINDOWS
1975extern void *windows_open_shared_library(char *);
1976
1977void *
1978xGetSharedLibrary(char *path, int mode)
1979{
1980  return windows_open_shared_library(path);
1981}
1982#else
1983void *
1984xGetSharedLibrary(char *path, int mode)
1985{
1986  return dlopen(path, mode);
1987}
1988#endif
1989#else
1990void *
1991xGetSharedLibrary(char *path, int *resultType)
1992{
1993#if defined(PPC) && (WORD_SIZE == 32)
1994  NSObjectFileImageReturnCode code;
1995  NSObjectFileImage              moduleImage;
1996  NSModule                       module;
1997  const struct mach_header *     header;
1998  const char *                   error;
1999  void *                         result;
2000  /* not thread safe */
2001  /*
2002  static struct {
2003    const struct mach_header  *header;
2004    NSModule                  *module;
2005    const char                *error;
2006  } results;   
2007  */
2008  result = NULL;
2009  error = NULL;
2010
2011  /* first try to open this as a bundle */
2012  code = NSCreateObjectFileImageFromFile(path,&moduleImage);
2013  if (code != NSObjectFileImageSuccess &&
2014      code != NSObjectFileImageInappropriateFile &&
2015      code != NSObjectFileImageAccess)
2016    {
2017      /* compute error strings */
2018      switch (code)
2019        {
2020        case NSObjectFileImageFailure:
2021          error = "NSObjectFileImageFailure";
2022          break;
2023        case NSObjectFileImageArch:
2024          error = "NSObjectFileImageArch";
2025          break;
2026        case NSObjectFileImageFormat:
2027          error = "NSObjectFileImageFormat";
2028          break;
2029        case NSObjectFileImageAccess:
2030          /* can't find the file */
2031          error = "NSObjectFileImageAccess";
2032          break;
2033        default:
2034          error = "unknown error";
2035        }
2036      *resultType = 0;
2037      return (void *)error;
2038    }
2039  if (code == NSObjectFileImageInappropriateFile ||
2040      code == NSObjectFileImageAccess ) {
2041    /* the pathname might be a partial pathane (hence the access error)
2042       or it might be something other than a bundle, if so perhaps
2043       it is a .dylib so now try to open it as a .dylib */
2044
2045    /* protect against redundant loads, Gary Byers noticed possible
2046       heap corruption if this isn't done */
2047    header = NSAddImage(path, NSADDIMAGE_OPTION_RETURN_ON_ERROR |
2048                        NSADDIMAGE_OPTION_WITH_SEARCHING |
2049                        NSADDIMAGE_OPTION_RETURN_ONLY_IF_LOADED);
2050    if (!header)
2051      header = NSAddImage(path, NSADDIMAGE_OPTION_RETURN_ON_ERROR |
2052                          NSADDIMAGE_OPTION_WITH_SEARCHING);
2053    result = (void *)header;
2054    *resultType = 1;
2055  }
2056  else if (code == NSObjectFileImageSuccess) {
2057    /* we have a sucessful module image
2058       try to link it, don't bind symbols privately */
2059
2060    module = NSLinkModule(moduleImage, path,
2061                          NSLINKMODULE_OPTION_RETURN_ON_ERROR | NSLINKMODULE_OPTION_BINDNOW);
2062    NSDestroyObjectFileImage(moduleImage);     
2063    result = (void *)module;
2064    *resultType = 2;
2065  }
2066  if (!result)
2067    {
2068      /* compute error string */
2069      NSLinkEditErrors ler;
2070      int lerno;
2071      const char* file;
2072      NSLinkEditError(&ler,&lerno,&file,&error);
2073      if (error) {
2074        result = (void *)error;
2075        *resultType = 0;
2076      }
2077    }
2078  return result;
2079#else
2080  const char *                   error;
2081  void *                         result;
2082
2083  result = dlopen(path, RTLD_NOW | RTLD_GLOBAL);
2084 
2085  if (result == NULL) {
2086    error = dlerror();
2087    *resultType = 0;
2088    return (void *)error;
2089  }
2090  *resultType = 1;
2091  return result;
2092#endif
2093}
2094#endif
2095
2096
2097
2098int
2099fd_setsize_bytes()
2100{
2101  return FD_SETSIZE/8;
2102}
2103
2104void
2105do_fd_set(int fd, fd_set *fdsetp)
2106{
2107  FD_SET(fd, fdsetp);
2108}
2109
2110void
2111do_fd_clr(int fd, fd_set *fdsetp)
2112{
2113  FD_CLR(fd, fdsetp);
2114}
2115
2116int
2117do_fd_is_set(int fd, fd_set *fdsetp)
2118{
2119  return FD_ISSET(fd,fdsetp);
2120}
2121
2122
2123void
2124do_fd_zero(fd_set *fdsetp)
2125{
2126  FD_ZERO(fdsetp);
2127}
2128
2129#include "image.h"
2130
2131
2132
2133Boolean
2134check_for_embedded_image (
2135#ifdef WINDOWS
2136                          wchar_t *path
2137#else
2138                          char *path
2139#endif
2140                          )
2141{
2142#ifdef WINDOWS
2143  int fd = wopen(path, O_RDONLY);
2144#else 
2145  int fd = open(path, O_RDONLY);
2146#endif
2147
2148  Boolean image_is_embedded = false;
2149
2150  if (fd >= 0) {
2151    openmcl_image_file_header h;
2152
2153    if (find_openmcl_image_file_header (fd, &h)) {
2154      image_is_embedded = true;
2155    }
2156    close (fd);
2157  }
2158  return image_is_embedded;
2159}
2160
2161LispObj
2162load_image(
2163#ifdef WINDOWS
2164           wchar_t * path
2165#else
2166           char *path
2167#endif
2168)
2169{
2170#ifdef WINDOWS
2171  int fd = wopen(path, O_RDONLY, 0666), err;
2172#else
2173  int fd = open(path, O_RDONLY, 0666), err;
2174#endif
2175  LispObj image_nil = 0;
2176
2177  if (fd > 0) {
2178    openmcl_image_file_header ih;
2179
2180    errno = 0;
2181    image_nil = load_openmcl_image(fd, &ih);
2182    /* We -were- using a duplicate fd to map the file; that
2183       seems to confuse Darwin (doesn't everything ?), so
2184       we'll instead keep the original file open.
2185    */
2186    err = errno;
2187    if (!image_nil) {
2188      close(fd);
2189    }
2190#ifdef WINDOWS
2191    /* We currently don't actually map the image, and leaving the file
2192       open seems to make it difficult to write to reliably. */
2193    if (image_nil) {
2194      close(fd);
2195    }
2196#endif
2197  } else {
2198    err = errno;
2199  }
2200  if (image_nil == 0) {
2201    if (err == 0) {
2202      fprintf(dbgout, "Couldn't load lisp heap image from %s\n", path);
2203    } else {
2204      fprintf(dbgout, "Couldn't load lisp heap image from %s:\n%s\n", path, strerror(err));
2205    }
2206    exit(-1);
2207  }
2208  return image_nil;
2209}
2210
2211int
2212set_errno(int val)
2213{
2214  errno = val;
2215  return -1;
2216}
2217
2218/* A horrible hack to allow us to initialize a JVM instance from lisp.
2219   On Darwin, creating a JVM instance clobbers the thread's existing
2220   Mach exception infrastructure, so we save and restore it here.
2221*/
2222
2223typedef int (*jvm_initfunc)(void*,void*,void*);
2224
2225int
2226jvm_init(jvm_initfunc f,void*arg0,void*arg1,void*arg2)
2227{
2228  int result = -1;
2229  TCR *tcr = get_tcr(1);
2230#ifdef DARWIN
2231  extern kern_return_t tcr_establish_lisp_exception_port(TCR *);
2232#endif
2233 
2234  result = f(arg0,arg1,arg2);
2235#ifdef DARWIN
2236  tcr_establish_lisp_exception_port(tcr);
2237#endif
2238  return result;
2239}
2240 
2241
2242
2243
2244void *
2245xFindSymbol(void* handle, char *name)
2246{
2247#if defined(LINUX) || defined(FREEBSD) || defined(SOLARIS)
2248  return dlsym(handle, name);
2249#endif
2250#ifdef DARWIN
2251#if defined(PPC64) || defined(X86)
2252  if ((handle == NULL) || (handle == ((void *) -1))) {
2253    handle = RTLD_DEFAULT;
2254  }   
2255  if (*name == '_') {
2256    name++;
2257  }
2258  return dlsym(handle, name);
2259#else
2260  natural address = 0;
2261
2262  if ((handle == NULL) ||
2263      (handle == (void *)-1) ||
2264      (handle == (void *)-2)){
2265    if (NSIsSymbolNameDefined(name)) { /* Keep dyld_lookup from crashing */
2266      _dyld_lookup_and_bind(name, (void *) &address, (void*) NULL);
2267    }
2268    return (void *)address;
2269  }
2270  Bug(NULL, "How did this happen ?");
2271#endif
2272#endif
2273#ifdef WINDOWS
2274  extern void *windows_find_symbol(void *, char *);
2275  return windows_find_symbol(handle, name);
2276#endif
2277}
2278
2279void *
2280get_r_debug()
2281{
2282#if defined(LINUX) || defined(FREEBSD) || defined(SOLARIS)
2283#if WORD_SIZE == 64
2284  extern Elf64_Dyn _DYNAMIC[];
2285  Elf64_Dyn *dp;
2286#else
2287  extern Elf32_Dyn _DYNAMIC[];
2288  Elf32_Dyn *dp;
2289#endif
2290  int tag;
2291
2292  for (dp = _DYNAMIC; (tag = dp->d_tag) != 0; dp++) {
2293    if (tag == DT_DEBUG) {
2294      return (void *)(dp->d_un.d_ptr);
2295    }
2296  }
2297#endif
2298  return NULL;
2299}
2300
2301
2302#ifdef DARWIN
2303void
2304sample_paging_info(paging_info *stats)
2305{
2306  mach_msg_type_number_t count = TASK_EVENTS_INFO_COUNT;
2307
2308  task_info(mach_task_self(),
2309            TASK_EVENTS_INFO,
2310            (task_info_t)stats,
2311            &count);
2312}
2313
2314void
2315report_paging_info_delta(FILE *out, paging_info *start, paging_info *stop)
2316{
2317  fprintf(out,";;; %d soft faults, %d faults, %d pageins\n\n",
2318          stop->cow_faults-start->cow_faults,
2319          stop->faults-start->faults,
2320          stop->pageins-start->pageins);
2321}
2322
2323#else
2324#ifdef WINDOWS
2325void
2326sample_paging_info(paging_info *stats)
2327{
2328}
2329
2330void
2331report_paging_info_delta(FILE *out, paging_info *start, paging_info *stop)
2332{
2333}
2334#else
2335void
2336sample_paging_info(paging_info *stats)
2337{
2338  getrusage(RUSAGE_SELF, stats);
2339}
2340
2341void
2342report_paging_info_delta(FILE *out, paging_info *start, paging_info *stop)
2343{
2344  fprintf(out,";;; %ld soft faults, %ld faults, %ld pageins\n\n",
2345          stop->ru_minflt-start->ru_minflt,
2346          stop->ru_majflt-start->ru_majflt,
2347          stop->ru_nswap-start->ru_nswap);
2348}
2349
2350#endif
2351#endif
Note: See TracBrowser for help on using the repository browser.