source: branches/working-0711/ccl/lisp-kernel/pmcl-kernel.c @ 12989

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

mac changes (r12671, r12672)

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