home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / plbin.zip / pl / src / pl-setup.c < prev    next >
C/C++ Source or Header  |  1993-02-23  |  25KB  |  871 lines
  1. /*  pl-setup.c,v 1.12 1993/02/23 13:16:46 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: Initialise the system
  8. */
  9.  
  10. #define GLOBAL                /* allocate global variables here */
  11. #include "pl-incl.h"
  12. #include <sys/stat.h>
  13.  
  14. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15. This module initialises the system and defines the global variables.  It
  16. also holds the code  for  dynamically  expanding  stacks  based  on  MMU
  17. access.   Finally  it holds the code to handle signals transparently for
  18. foreign language code or packages with which Prolog was linked together.
  19. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  20.  
  21. forwards void initStacks P((long, long, long, long, long));
  22.  
  23. void
  24. setupProlog()
  25. { DEBUG(1, printf("Starting Heap Initialisation\n"));
  26.  
  27.   critical = 0;
  28.   aborted = FALSE;
  29.  
  30.   startCritical;
  31. #if unix || EMX
  32.   DEBUG(1, printf("Prolog Signal Handling ...\n"));
  33.   initSignals();
  34. #endif
  35.   DEBUG(1, printf("OS ...\n"));
  36.   initOs();
  37.   DEBUG(1, printf("Stacks ...\n"));
  38.   initStacks( options.localSize, 
  39.           options.globalSize, 
  40.           options.trailSize, 
  41.           options.argumentSize,
  42.           options.lockSize);
  43.  
  44.   if ( status.dumped == FALSE )
  45.   { DEBUG(1, printf("Atoms ...\n"));
  46.     initAtoms();
  47.     DEBUG(1, printf("Functors ...\n"));
  48.     initFunctors();
  49.     DEBUG(1, printf("Modules ...\n"));
  50.     initModules();
  51.     DEBUG(1, printf("Records ...\n"));
  52.     initRecords();
  53.     DEBUG(1, printf("Flags ...\n"));
  54.     initFlags();
  55.     DEBUG(1, printf("Foreign Predicates ...\n"));
  56.     initBuildIns();
  57.     DEBUG(1, printf("Operators ...\n"));
  58.     initOperators();
  59.     DEBUG(1, printf("Arithmetic ...\n"));
  60.     initArith();
  61.     DEBUG(1, printf("Tracer ...\n"));
  62.     initTracer();
  63.     debugstatus.styleCheck = LONGATOM_CHECK |
  64.                  SINGLETON_CHECK |
  65.                  DOLLAR_STYLE |
  66.                  DISCONTIGUOUS_STYLE;
  67.     DEBUG(1, printf("wam_table ...\n"));
  68.     initWamTable();
  69.   } else
  70.   { resetReferences();
  71.     resetGC();            /* reset garbage collector */
  72.     stateList = (State) NULL;    /* all states are already in core */
  73.   }
  74.   DEBUG(1, printf("IO ...\n"));
  75.   initIO();
  76.   DEBUG(1, printf("Loader ...\n"));
  77.   resetLoader();
  78.   DEBUG(1, printf("Symbols ...\n"));
  79.   getSymbols();
  80.   DEBUG(1, printf("Term ...\n"));
  81.   resetTerm();
  82.   status.io_initialised = TRUE;
  83.  
  84.   endCritical;
  85.  
  86.   environment_frame = (LocalFrame) NULL;
  87.   statistics.inferences = 0;
  88. #if O_STORE_PROGRAM || O_SAVE
  89.   cannot_save_program = NULL;
  90. #else
  91.   cannot_save_program = "Not supported on this machine";
  92. #endif
  93.  
  94. #if O_XWINDOWS
  95.   DEBUG(1, printf("XWindows ...\n");
  96.   initXWindows();
  97. #endif
  98.  
  99.   DEBUG(1, printf("Heap Initialised\n"));
  100. }
  101.  
  102.  
  103. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  104.                SIGNAL HANDLING
  105.  
  106. SWI-Prolog catches a number of signals.  Interrupt is catched  to  allow
  107. the  user  to interrupt normal execution.  Floating point exceptions are
  108. trapped  to  generate  a  normal   error   or   arithmetic   exceptions.
  109. Segmentation  violations  are  trapped  on  machines  using  the  MMU to
  110. implement stack overflow  checks  and  stack  expansion.   These  signal
  111. handlers  needs  to be preserved over saved states and the system should
  112. allow foreign language code to handle signals without  interfering  with
  113. Prologs signal handlers.  For this reason a layer is wired around the OS
  114. signal handling.
  115.  
  116. Code in SWI-Prolog should  call  pl_signal()  rather  than  signal()  to
  117. install  signal  handlers.  SWI-Prolog assumes the handler function is a
  118. void function.  On some systems this gives  some  compiler  warnigns  as
  119. they  define  signal handlers to be int functions.  This should be fixed
  120. some day.
  121. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  122.  
  123. #if unix || EMX
  124.  
  125. static void
  126. fatal_signal_handler(sig, type, scp, addr)
  127. int sig, type;
  128. SIGNAL_CONTEXT_TYPE scp;
  129. char *addr;
  130. { DEBUG(1, printf("Fatal signal %d\n", sig));
  131.  
  132.   deliverSignal(sig, type, scp, addr);
  133. }
  134.  
  135.  
  136. void
  137. initSignals()
  138. { int n;
  139.  
  140.   if ( status.dumped == FALSE )
  141.   { for( n = 0; n < MAXSIGNAL; n++ )
  142.     { signalHandlers[n].os = signalHandlers[n].user = SIG_DFL;
  143.       signalHandlers[n].catched = FALSE;
  144.     }
  145.  
  146. #ifdef SIGTTOU
  147.     pl_signal(SIGTTOU, SIG_IGN);
  148. #endif
  149.     pl_signal(SIGSEGV, fatal_signal_handler);
  150.     pl_signal(SIGILL,  fatal_signal_handler);
  151. #ifdef SIGBUS
  152.     pl_signal(SIGBUS,  fatal_signal_handler);
  153. #endif
  154.   } else
  155.   { for( n = 0; n < MAXSIGNAL; n++ )
  156.       if ( signalHandlers[n].os != SIG_DFL )
  157.         signal(n, signalHandlers[n].os);
  158.   }
  159. }
  160.  
  161. handler_t
  162. pl_signal(sig, func)
  163. int sig;
  164. handler_t func;
  165. { handler_t old = signal(sig, func);
  166.  
  167.   signalHandlers[sig].os = func;
  168.   signalHandlers[sig].catched = (func == SIG_DFL ? FALSE : TRUE);
  169.  
  170.   return old;
  171. }
  172.  
  173. void
  174. deliverSignal(sig, type, scp, addr)
  175. int sig, type;
  176. SIGNAL_CONTEXT_TYPE scp;
  177. char *addr;
  178. { if ( signalHandlers[sig].user != SIG_DFL )
  179.   { (*signalHandlers[sig].user)(sig, type, scp, addr);
  180.     return;
  181.   }
  182.  
  183.   sysError("Unexpected signal: %d\n", sig);
  184. }
  185.  
  186. #endif /* unix */
  187.  
  188. #if O_DYNAMIC_STACKS
  189.  
  190. #define STACK_SEPARATION size_alignment
  191. #define STACK_MINIMUM    (32 * 1024)
  192.  
  193. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  194.             STACK MEMORY MANAGEMENT
  195.  
  196. In these days some operating systems allows the  user  to  map  physical
  197. memory  anywhere  in  the  virtual  address  space.  For multiple stacks
  198. machines such as Prolog, this is ideal.  The  stacks  can  be  allocated
  199. very  far  appart  with  large  gaps  between  them.   Stack overflow is
  200. detected by hardware and results (in  Unix)  in  a  segmentation  fault.
  201. This fault is trapped and the stack is automatically expanded by mapping
  202. more  memory.
  203.  
  204. In theory the stacks can be deallocated dynamically as  well,  returning
  205. the  resources to the system.  Currently this can be done explicitely by
  206. calling  trim_stacks/0  and  the  garbage  collector.    It   might   be
  207. interesting  to  do  this  automatically  at  certain points to minimise
  208. memory requirements.  How?
  209.  
  210. Currently this mechanism can use mmap() and munmap() of SunOs 4.0 or the
  211. system-V shared memory primitives (if they meet certain criteria.
  212. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  213.  
  214. #include <errno.h>
  215. extern int errno;
  216. extern int getpagesize();
  217. extern char *sbrk();
  218.  
  219. static int size_alignment;    /* Stack sizes must be aligned to this */
  220. static int base_alignment;    /* Stack bases must be aligned to this */
  221.  
  222. #define MB (1024L * 1024L)    /* megabytes */
  223.  
  224. static long
  225. align_size(x)
  226. long x;
  227. { return x % size_alignment ? (x / size_alignment + 1) * size_alignment : x;
  228. }
  229.  
  230. static long
  231. align_base(x)
  232. long x;
  233. { return x % base_alignment ? (x / base_alignment + 1) * base_alignment : x;
  234. }
  235.  
  236. #if O_CAN_MAP
  237. #include <sys/mman.h>
  238. #include <fcntl.h>
  239.  
  240. extern int munmap();
  241. static int mapfd = -1;            /* File descriptor used for mapping */
  242.  
  243. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  244. Return a file descriptor to a file, open  for  reading  and  holding  at
  245. least  one  page of 0's. On some systems /dev/zero is available for this
  246. trick.  If not, a file of one page is created under the name /tmp/pl-map
  247. if it does not already exists and this file is opened for  reading.   It
  248. can  be  shared  by  many  SWI-Prolog  processes  and (therefore) is not
  249. removed on exit.
  250. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  251.  
  252. static int
  253. swap_fd()
  254. { int fd;
  255.   static char *map = "/tmp/pl-map";
  256.  
  257.   if ( (fd = open("/dev/zero", O_RDONLY)) >= 0 )
  258.     return fd;
  259.  
  260.   if ( (fd = open(map, O_RDONLY)) < 0 )
  261.   { if ( errno == ENOENT )
  262.     { char buf[1024];
  263.       char *s;
  264.       int n;
  265.       int oldmask = umask(0);
  266.  
  267.       if ( (fd = open(map, O_RDWR|O_CREAT, 0666)) < 0 )
  268.       { fatalError("Can't create map file %s: %s", map, OsError());
  269.         return -1;
  270.       }
  271.       umask(oldmask);
  272.       for(n=1024, s = buf; n > 0; n--)
  273.         *s++ = EOS;
  274.       for(n=size_alignment/1024; n > 0; n--)
  275.         if ( write(fd, buf, 1024) != 1024 )
  276.           fatalError("Failed to create map file %s: %s\n", map, OsError());
  277.  
  278.       return fd;
  279.     }
  280.     fatalError("Can't open map file %s: %s", map, OsError());
  281.     return -1;
  282.   }
  283.  
  284.   return fd;
  285. }
  286.  
  287. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  288. Expand stack `s' by one page.  This might not be  enough,  but  in  this
  289. (very  rare) case another segmentation fault will follow to get the next
  290. page.  The memory is expanded by mapping the map-fd file onto  the  page
  291. using  a  private  map.  This way the contents of the map-file is copied
  292. into the page but all changes to the page are  kept  local.   Note  that
  293. SunOs  4.0.0  on SUN-3 has a bug that causes the various mapped pages to
  294. point to the same physical memory.
  295. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  296.  
  297. static void
  298. map(s)
  299. Stack s;
  300. { if ( mmap(s->max, size_alignment,
  301.         PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED,
  302.         mapfd, 0L) != s->max )
  303.     fatalError("Failed to map memory at 0x%x for %d bytes on fd=%d: %s\n",
  304.            s->max, size_alignment, mapfd, OsError());
  305.  
  306.   DEBUG(2, printf("mapped %d bytes from 0x%x\n",
  307.           size_alignment, (unsigned) s->max));
  308.   s->max += size_alignment;
  309. }
  310.  
  311. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  312. unmap() returns all memory resources of a stack that are  no  longer  in
  313. use to the OS.
  314. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  315.  
  316. static void
  317. unmap(s)
  318. Stack s;
  319. { caddress top  = (s->top > s->min ? s->top : s->min);
  320.   caddress addr = (caddress) align_size(top + 1);
  321.  
  322.   if ( addr < s->max )
  323.   { if ( munmap(addr, s->max - addr) != 0 )
  324.       fatalError("Failed to unmap memory: %s", OsError());
  325.     s->max = addr;
  326.   }
  327. }
  328.  
  329.  
  330. static void
  331. deallocateStack(s)
  332. Stack s;
  333. { long len = (ulong)s->max - (ulong)s->base;
  334.  
  335.   if ( len > 0 && munmap(s->base, len) != 0 )
  336.     fatalError("Failed to unmap memory: %s", OsError());
  337. }
  338.  
  339.  
  340. void
  341. deallocateStacks()
  342. { deallocateStack(&stacks.local);
  343.   deallocateStack(&stacks.global);
  344.   deallocateStack(&stacks.trail);
  345.   deallocateStack(&stacks.argument);
  346.   deallocateStack(&stacks.lock);
  347. }
  348.  
  349.  
  350. bool
  351. restoreStack(s)
  352. Stack s;
  353. { caddress max;
  354.   long len;
  355.   struct stat statbuf;
  356.  
  357.   if ( mapfd < 0 || fstat(mapfd, &statbuf) == -1 )
  358.   { mapfd = swap_fd();
  359.     base_alignment = size_alignment = getpagesize();
  360.   }
  361.  
  362.   max = (caddress) align_size(s->top + 1);
  363.   len = max - (caddress) s->base;
  364.  
  365.   if ( mmap(s->base, len,
  366.         PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED,
  367.         mapfd, 0L) != s->base )
  368.     fatalError("Failed to map memory at 0x%x for %d bytes on fd=%d: %s\n",
  369.            s->base, len, mapfd, OsError());
  370.  
  371.   s->max = max;
  372.   DEBUG(0, printf("mapped %d bytes from 0x%x\n", len, (unsigned) s->base));
  373.   succeed;
  374. }
  375.  
  376.  
  377. #endif /* O_CAN_MAP */
  378.  
  379. #if O_SHARED_MEMORY
  380. #include <sys/stat.h>
  381. #include <sys/ipc.h>
  382. #include <sys/shm.h>
  383. extern int shmget();
  384. extern char *shmat();
  385. extern int shmdt();
  386. extern int shmctl();
  387. #if gould
  388. #define S_IRUSR SHM_R
  389. #define S_IWUSR SHM_W
  390. #endif
  391. #if mips
  392. struct pte { long pad };        /* where is the real one? */
  393. #include <sys/param.h>
  394. #endif
  395.  
  396. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  397. Shared memory based MMU controlled stacks are a bit  more  tricky.   The
  398. main  problem is that shared memory segments are scares resources.  Upto
  399. a certain limit, each time the size of the stack is doubled.  Afterwards
  400. the stack grows in fixed segments  of  size  s->segment_initial  *  2  ^
  401. s->segment_double.   These  parameters  may  vary  from  stack to stack,
  402. suiting the caracteristics of the stack and of the OS limits on  virtual
  403. address space and number of shared memory segnments.  See pl-incl.h
  404.  
  405. The  shared  memory  segments  are  created,  mapped   and   immediately
  406. afterwards  freed.   According  to  the documentation they actually will
  407. live untill they are unmapped by the last process.  Immediately  freeing
  408. them  avoids the burden to do this on exit() and ensures these resources
  409. are freed, also if SWI-Prolog crashes.
  410. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  411.  
  412. #if O_SHM_ALIGN_FAR_APART
  413.  
  414. #define min(a, b) ((a) < (b) ? (a) : (b))
  415.  
  416. static long
  417. new_stack_size(s)
  418. Stack s;
  419. { long size = s->top - s->base;
  420.   long free = size / s->segment_initial;
  421.  
  422.   if ( free > s->segment_double ) free = s->segment_double;
  423.   else if ( free < 1 )            free = 1;
  424.   
  425.   size = align_size(size + free * s->segment_initial);  
  426.  
  427.   if ( size > s->limit )
  428.     size = s->limit;
  429.  
  430.   return size;
  431. }
  432.  
  433. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  434. resize_segment(s, n, size)
  435.   Resize segment n of stack s to get size size.  The base address of the
  436.   segement is assumed to be correct.
  437. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  438.  
  439. static void
  440. resize_segment(s, n, size)
  441. Stack s;
  442. int n;
  443. long size;
  444. { if ( s->segments[n].size != size )
  445.   { int id = -1;
  446.     char *addr;
  447.  
  448.     if ( size > 0 )
  449.     { if ( (id=shmget(IPC_PRIVATE, size, S_IRUSR|S_IWUSR)) < 0 )
  450.     fatalError("Failed to create shared memory object: %s", OsError());
  451.       if ( (addr = shmat(id, 0, 0)) < 0 )
  452.     fatalError("Failed to attach shared memory segment: %s", OsError());
  453.       bcopy(s->segments[n].base, addr, min(size, s->segments[n].size));
  454.       if ( shmdt(addr) < 0 )
  455.           fatalError("Failed to detach shared memory segment: %s", OsError());
  456.     }    
  457.  
  458.     if ( s->segments[n].size > 0 )
  459.       if ( shmdt(s->segments[n].base) < 0 )
  460.           fatalError("Failed to detach shared memory segment: %s", OsError());
  461.     
  462.     if ( id >= 0 )
  463.     { DEBUG(0, printf("Attach segment of size %ld at 0x%x\n",
  464.               size, s->segments[n].base));
  465.       if ( shmat(id, s->segments[n].base, 0) != s->segments[n].base )
  466.           fatalError("Failed to attach shared memory segment at 0x%x: %s",
  467.            s->segments[n].base, OsError());
  468.       
  469.       if ( shmctl(id, IPC_RMID, NULL) < 0 )
  470.     fatalError("Failed to release shared memory object: %s", OsError());
  471.     }
  472.  
  473.     s->segments[n].size = 0;
  474.   }
  475. }
  476.  
  477.  
  478. static void
  479. map(s)
  480. Stack s;
  481. { long new_size = new_stack_size(s);
  482.   int  top_segment = new_size / base_alignment;
  483.   int  n;
  484.  
  485.   DEBUG(1, printf("Expanding %s stack to %ld\n", s->name, new_size));
  486.  
  487.   for(n=0; n < top_segment; n++)
  488.     resize_segment(s, n, base_alignment);
  489.  
  490.   resize_segment(s, n, new_size % base_alignment);
  491.  
  492.   for(n++; s->segments[n].size > 0; n++ )
  493.     resize_segment(s, n, 0L);
  494.  
  495.   s->max = s->base + new_size;
  496. }
  497.  
  498.  
  499. static void
  500. unmap(s)
  501. Stack s;
  502. { if ( new_stack_size(s) < s->max - s->base )
  503.     map(s);
  504. }
  505.  
  506. #else /* O_SHM_ALIGN_FAR_APART */
  507.  
  508. static void
  509. map(s)
  510. Stack s;
  511. { int id;
  512.   char *rval;
  513.   long len;
  514.   caddress addr;
  515.  
  516.   len  = (s->segment_top <= s->segment_double
  517.               ? s->segment_initial << (s->segment_top)
  518.               : s->segment_initial << s->segment_double);
  519.   addr = s->segments[s->segment_top].base;
  520.  
  521.   if ( (id=shmget(IPC_PRIVATE, len, S_IRUSR|S_IWUSR)) < 0 )
  522.   { if ( errno == EINVAL )
  523.       fatalError("Kernel is not configured with option IPCSHMEM (contact a guru)");
  524.     fatalError("Failed to create shared memory object: %s", OsError());
  525.   }
  526.  
  527.   if ( (rval = shmat(id, addr, 0)) != (char *) addr )
  528.     fatalError("Failed to map memory at %ld: %s\n", addr, OsError());
  529.  
  530.   if ( shmctl(id, IPC_RMID, NULL) < 0 )
  531.     fatalError("Failed to release shared memory object: %s", OsError());
  532.  
  533.   s->segment_top++;
  534.   s->max = s->segments[s->segment_top].base = addr+len;
  535. }
  536.  
  537.  
  538. static void
  539. unmap(s)
  540. Stack s;
  541. { while( s->segment_top > 0 && s->segments[s->segment_top-1].base > s->top )
  542.   { s->segment_top--;
  543.     if ( shmdt(s->segments[s->segment_top].base) < 0 )
  544.       fatalError("Failed to unmap: %s\n", OsError());
  545.     s->max = s->segments[s->segment_top].base;
  546.   }
  547. }
  548.  
  549. #endif /* O_SHM_ALIGN_FAR_APART */
  550. #endif /* O_SHARED_MEMORY */
  551.  
  552. static bool
  553. expandStack(s, addr)
  554. Stack s;
  555. caddress addr;
  556. {
  557. #if O_NO_SEGV_ADDRESS
  558.   addr = s->top + STACK_SEPARATION;
  559. #endif
  560.   if ( addr < s->max || addr >= s->base + s->maxlimit + STACK_SEPARATION )
  561.     fail;                /* outside this area */
  562.  
  563.   if ( addr <= s->max + STACK_SEPARATION*2 )
  564.   { if ( addr < s->base + s->limit )
  565.     { DEBUG(1, printf("Expanding %s stack\n", s->name));
  566.       map(s);
  567.       considerGarbageCollect(s);
  568.  
  569.       succeed;
  570.     }
  571.  
  572.     outOf(s);   
  573.   }
  574.  
  575.   fail;
  576. }
  577.  
  578. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  579. This the the signal handler for segmentation faults if we are using  MMU
  580. controlled  stacks.   The  only  argument  we  are  interested in is the
  581. address of the segmentation fault.  SUN provides this via  an  argument.
  582. If   your   system   does   not   provide   this  information,  set  the
  583. O_NO_SEGV_ADDRESS flag.
  584. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  585.  
  586. static void
  587. segv_handler(sig, type, scp, addr)
  588. int sig, type;
  589. SIGNAL_CONTEXT_TYPE scp;
  590. char *addr;
  591. { DEBUG(1, printf("Page fault at %ld (0x%x)\n", (long) addr, (unsigned) addr));
  592.  
  593.   if ( expandStack(&stacks.global, addr) ||
  594.        expandStack(&stacks.local, addr) ||
  595.        expandStack(&stacks.trail, addr) ||
  596.        expandStack(&stacks.argument, addr) ||
  597.        expandStack(&stacks.lock, addr) )
  598.     return;
  599.  
  600.   deliverSignal(sig, type, scp, addr);
  601. }
  602.  
  603. static bool
  604. limit_stack(s, limit)
  605. Stack s;
  606. long limit;
  607. { if ( limit > s->maxlimit || limit <= 0 )
  608.     limit = s->maxlimit;
  609.   if ( limit <= s->top - s->base )
  610.     limit = s->top - s->base;
  611.  
  612.   limit = align_size(limit);
  613.   s->limit = limit;
  614.  
  615.   succeed;
  616. }
  617.  
  618. static void
  619. init_stack(s, name, base, limit, minsize)
  620. Stack s;
  621. char *name;
  622. caddress base;
  623. long limit, minsize;
  624. { s->maxlimit = limit;            /* deleted this notion */
  625.   s->name     = name;
  626.   s->base     = s->max = s->top = base;
  627.   s->min      = s->base + minsize;    /* No need to get below this value */
  628.   limit_stack(s, limit);
  629. #if O_SHARED_MEMORY
  630. #if O_SHM_ALIGN_FAR_APART
  631. { int n;
  632.  
  633.   s->segment_initial = 32 * 1024;
  634.   s->segment_double  = 20;
  635.   for(n=0; n < MAX_STACK_SEGMENTS; n++)
  636.   { s->segments[n].size = 0;
  637.     s->segments[n].base = s->base + base_alignment * n;
  638.   }
  639. }
  640. #else /* O_SHM_ALIGN_FAR_APART */
  641.   s->segment_top     = 0;
  642.   s->segment_initial = 32 * 1024;
  643.   s->segment_double  = 5;
  644.   s->segments[0].base = base;
  645. #endif /* O_SHM_ALIGN_FAR_APART */
  646. #endif /* O_SHARED_MEMORY */
  647.  
  648.   while(s->max < s->min)
  649.     map(s);
  650. }
  651.  
  652. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  653. initStacks() initialises the stacks structure,  thus  assigning  a  base
  654. address,  a limit and a name to each of the stacks.  Finally it installs
  655. a signal handler for handling  segmentation  faults.   The  segmentation
  656. fault handler will actually create and expand the stacks on segmentation
  657. faults.   Currently,  it is assumed memory can be mapped from sbrk(0) to
  658. MAX_VIRTUAL_ADDRESS and the stack is outside this area.  This is true on
  659. SUN  and  GOULD.   On  other  machines  the  C-stack  might   start   at
  660. MAX_VIRTUAL_ADDRESS   and   grow   downwards.    In   this   case  lower
  661. MAX_VIRTUAL_ADDRESS a bit (if you have 100 MB virtual address  space  or
  662. more,  I  would  suggest  16 MB), so space is allocated for the C-stack.
  663. The stacks are allocated right below MAX_VIRTUAL_ADDRESS, at a  distance
  664. STACK_SEPARATION  from  each other.  STACK_SEPARATION must be a multiple
  665. of the page size and must be at least  MAXVARIABLES  *  sizeof(word)  as
  666. this  is the maximum discontinuity in writing the stacks.  On almost any
  667. machine size_alignment will do.
  668. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  669.  
  670. static void
  671. initStacks(local, global, trail, argument, lock)
  672. long local, global, trail, argument, lock;
  673. { long heap = 0;            /* malloc() heap */
  674.   int large = 1;
  675.   ulong base, top, space, large_size;
  676.  
  677.   if ( status.dumped == FALSE )
  678.   { hBase = (char *)0x20000000L;
  679.     hTop  = (char *)NULL;
  680.   }
  681.  
  682.   size_alignment = getpagesize();
  683. #if O_CAN_MAP
  684.   base_alignment = size_alignment;
  685.   mapfd  = swap_fd();
  686. #endif
  687. #if O_SHARED_MEMORY
  688.   base_alignment = SHMLBA;
  689.   DEBUG(0, printf("Shared memory must be aligned to %d (0x%x) bytes\n",
  690.           base_alignment, base_alignment));
  691. #endif
  692.  
  693.   assert(MAXVARIABLES*sizeof(word) < STACK_SEPARATION);
  694.  
  695.   local    = (long) align_size(local);    /* Round up to page boundary */
  696.   global   = (long) align_size(global);
  697.   trail    = (long) align_size(trail);
  698.   argument = (long) align_size(argument);
  699.   lock     = (long) align_size(lock);
  700.  
  701.   if ( local    == 0 ) large++;        /* find dynamic ones */
  702.   if ( global   == 0 ) large++;
  703.   if ( trail    == 0 ) large++;
  704.   if ( argument == 0 ) large++;
  705.   if ( lock     == 0 ) large++;
  706.  
  707.   base  = (long) align_base(sbrk(0));
  708.   top   = (long) MAX_VIRTUAL_ADDRESS;
  709.   DEBUG(1, printf("top = 0x%x, stack at 0x%x\n", top, (unsigned) &top));
  710.   space = top - base;
  711.   space -= align_base(heap) +
  712.            align_base(local + STACK_SEPARATION) +
  713.        align_base(global + STACK_SEPARATION) +
  714.        align_base(trail + STACK_SEPARATION) +
  715.        align_base(lock + STACK_SEPARATION) +
  716.        align_base(argument);
  717.   
  718.   large_size = ((space / large) / base_alignment) * base_alignment;
  719.   if ( large_size < STACK_MINIMUM )
  720.     fatalError("Can't fit requested stack sizes in address space");
  721.   DEBUG(1, printf("Large stacks are %ld\n", large_size));
  722.  
  723.   heap                          = large_size;
  724.   if ( local    == 0 ) local    = large_size;
  725.   if ( global   == 0 ) global   = large_size;
  726.   if ( trail    == 0 ) trail    = large_size;
  727.   if ( argument == 0 ) argument = large_size;
  728.   if ( lock     == 0 ) lock     = large_size;
  729.  
  730.   base += heap;
  731.  
  732. #define INIT_STACK(name, print, minsize) \
  733.   DEBUG(1, printf("%s stack at 0x%x; size = %ld\n", print, base, name)); \
  734.   init_stack(&stacks.name, print, base, name, minsize); \
  735.   base += name + STACK_SEPARATION; \
  736.   base = align_base(base);
  737. #define K * 1024
  738.  
  739.   INIT_STACK(global,   "global",   16 K);
  740.   INIT_STACK(local,    "local",    8 K);
  741.   INIT_STACK(trail,    "trail",    8 K);
  742.   INIT_STACK(lock,     "lock",     0 K);
  743.   INIT_STACK(argument, "argument", 1 K);
  744.  
  745.   pl_signal(SIGSEGV, segv_handler);
  746. }
  747.  
  748.         /********************************
  749.         *     STACK TRIMMING & LIMITS   *
  750.         *********************************/
  751.  
  752. word
  753. pl_trim_stacks()
  754. { unmap(&stacks.local);
  755.   unmap(&stacks.global);
  756.   unmap(&stacks.trail);
  757.   unmap(&stacks.argument);
  758.   unmap(&stacks.lock);
  759.  
  760.   succeed;
  761. }
  762.  
  763. word
  764. pl_limit_stack(s, l)
  765. Word s, l;
  766. { Atom k;
  767.   long limit;
  768.  
  769.   if ( !isAtom(*s) || !(isInteger(*l) || *l == (word) ATOM_unlimited) )
  770.     return warning("limit_stack/2: instantiation fault");
  771.   k = (Atom)*s;
  772.   limit = (*l == (word) ATOM_unlimited ? 0L : valNum(*l) * 1024L);
  773.  
  774.   if ( k == ATOM_local )
  775.     return limit_stack(&stacks.local, limit);
  776.   else if ( k == ATOM_global )
  777.     return limit_stack(&stacks.global, limit);
  778.   else if ( k == ATOM_trail )
  779.     return limit_stack(&stacks.trail, limit);
  780.   else if ( k == ATOM_argument )
  781.     return limit_stack(&stacks.argument, limit);
  782.   else
  783.     return warning("limit_stack/2: unknown stack: %s", stringAtom(k));
  784. }
  785.  
  786. #else /* O_DYNAMIC_STACKS */
  787.  
  788.         /********************************
  789.         *    SIMPLE STACK ALLOCATION    *
  790.         *********************************/
  791.  
  792. forwards void init_stack P((Stack, char *, long));
  793.  
  794. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  795. On systems that do not allow us to get access to the MMU (or that do not
  796. have an MMU)  the  stacks  have  fixed  size  and  overflow  checks  are
  797. implemented  in  software.   The stacks are allocated using malloc(). If
  798. you malloc() does not allow you to get more than 64K bytes in one go you
  799. better start looking for another Prolog system (IBM-PC  is  an  example:
  800. why does IBM bring computers on the marked that are 10 years out-of-date
  801. at the moment of announcement?).
  802. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  803.  
  804. word
  805. pl_limit_stack(s, l)        /* does not work on these systems */
  806. Word s, l;
  807. { succeed;
  808. }
  809.  
  810. word
  811. pl_trim_stacks()
  812. { succeed;
  813. }
  814.  
  815. static void
  816. init_stack(s, name, size)
  817. Stack s;
  818. char *name;
  819. long size;
  820. { if ( s->base == NULL )
  821.   { fatalError("Not enough core to allocate stacks");
  822.     return;
  823.   }
  824.  
  825.   s->name     = name;
  826.   s->top    = s->base;
  827.   s->limit    = size;
  828.   s->max    = s->base + size;
  829. }
  830.  
  831. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  832. On tos, malloc() returns a 2 byte  aligned  pointer.   We  need  4  byte
  833. aligned  pointers.   Allocate() is patched for that and dumped states do
  834. not exist.
  835. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  836.  
  837. #if tos
  838. #define MALLOC(p, n)    Allocate(n)
  839. #else
  840. #define MALLOC(p, n)    (status.dumped == FALSE ? Malloc(n) : Realloc(p, n))
  841. #endif
  842.  
  843. static void
  844. initStacks(local, global, trail, argument, lock)
  845. long local, global, trail, argument, lock;
  846. { long old_heap = statistics.heap;
  847.  
  848.   if ( status.dumped == FALSE )
  849.   { hBase = (char *)0x20000000L;
  850.     hTop  = (char *)NULL;
  851.   }
  852.  
  853.   gBase = (Word) MALLOC(gBase, global + sizeof(word) +
  854.                    local + sizeof(struct localFrame) +
  855.                    MAXARITY * sizeof(word));
  856.   lBase = (LocalFrame)    addPointer(gBase, global+sizeof(word));
  857.   tBase = (TrailEntry)    MALLOC(tBase, trail);
  858.   aBase = (Word *)    MALLOC(aBase, argument);
  859.   pBase = (Lock)    MALLOC(pBase, lock);
  860.  
  861.   init_stack((Stack)&stacks.global,    "global",    global);
  862.   init_stack((Stack)&stacks.local,    "local",    local);
  863.   init_stack((Stack)&stacks.trail,    "trail",    trail);
  864.   init_stack((Stack)&stacks.argument,    "argumet",    argument);
  865.   init_stack((Stack)&stacks.lock,    "lock",        lock);
  866.  
  867.   statistics.heap = old_heap;
  868. }
  869.  
  870. #endif /* O_DYNAMIC_STACKS */
  871.