source: branches/arm/lisp-kernel/pmcl-kernel.c @ 14066

Last change on this file since 14066 was 14066, checked in by gb, 10 years ago

Lots of changes to support stack-overflow detection on ARM Linux.
(Write protect the control stack, handle SIGSEGV on an alternate
signal stack ...) The sigaltstack mechanism doesn't work if the
specified signal stack is within the allocated control stack region
(we generally use the top few pages of the control stack on x86;
here, we map a few pages and need to remember to free them when the
thread dies.)
Also: need some recovery mechanism, so that after the thread unwinds
out of the "yellow zone" the yellow zone is re-protected.

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