view src/sheap.c @ 5652:cc6f0266bc36

Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary lisp/ChangeLog addition: 2012-05-01 Aidan Kehoe <kehoea@parhasard.net> Avoid #'delq in core code, for the sake of style and a (very slightly) smaller binary. * behavior.el (disable-behavior): * behavior.el (compute-behavior-group-children): * buff-menu.el (buffers-tab-items): * byte-optimize.el (byte-optimize-delay-constants-math): * byte-optimize.el (byte-optimize-logmumble): * byte-optimize.el (byte-decompile-bytecode-1): * byte-optimize.el (byte-optimize-lapcode): * bytecomp.el: * bytecomp.el (byte-compile-arglist-warn): * bytecomp.el (byte-compile-warn-about-unresolved-functions): * bytecomp.el (byte-compile-lambda): * bytecomp.el (byte-compile-out-toplevel): * bytecomp.el (byte-compile-insert): * bytecomp.el (byte-compile-defalias-warn): * cl-macs.el (cl-upcase-arg): * cl-macs.el (cl-transform-lambda): * cl-macs.el (cl-do-proclaim): * cl-macs.el (defstruct): * cl-macs.el (cl-make-type-test): * cl-macs.el (define-compiler-macro): * cl-macs.el (delete-duplicates): * cus-edit.el (widget-face-value-delete): * cus-edit.el (face-history): * easymenu.el (easy-menu-remove): * files.el (files-fetch-hook-value): * files.el (file-expand-wildcards): * font-lock.el (font-lock-update-removed-keyword-alist): * font-lock.el (font-lock-remove-keywords): * frame.el (frame-initialize): * frame.el (frame-notice-user-settings): * frame.el (set-frame-font): * frame.el (delete-other-frames): * frame.el (get-frame-for-buffer-noselect): * gnuserv.el (gnuserv-kill-buffer-function): * gnuserv.el (gnuserv-check-device): * gnuserv.el (gnuserv-kill-client): * gnuserv.el (gnuserv-buffer-done-1): * gtk-font-menu.el (gtk-reset-device-font-menus): * gutter-items.el (buffers-tab-items): * gutter.el (set-gutter-element-visible-p): * info.el (Info-find-file-node): * info.el (Info-history-add): * info.el (Info-build-annotation-completions): * info.el (Info-index): * info.el (Info-reannotate-node): * itimer.el (delete-itimer): * itimer.el (start-itimer): * lib-complete.el (lib-complete:cache-completions): * loadhist.el (unload-feature): * menubar-items.el (build-buffers-menu-internal): * menubar.el (delete-menu-item): * menubar.el (relabel-menu-item): * msw-font-menu.el (mswindows-reset-device-font-menus): * mule/make-coding-system.el (fixed-width-generate-helper): * next-error.el (next-error-find-buffer): * obsolete.el: * obsolete.el (find-non-ascii-charset-string): * obsolete.el (find-non-ascii-charset-region): * occur.el (multi-occur-by-filename-regexp): * occur.el (occur-1): * packages.el (packages-package-hierarchy-directory-names): * packages.el (package-get-key-1): * process.el (setenv): * simple.el (undo): * simple.el (handle-pre-motion-command-current-command-is-motion): * sound.el (load-sound-file): * wid-edit.el (widget-field-value-delete): * wid-edit.el (widget-checklist-match-inline): * wid-edit.el (widget-checklist-match-find): * wid-edit.el (widget-editable-list-delete-at): * wid-edit.el (widget-editable-list-entry-create): * window.el (quit-window): * x-font-menu.el (x-reset-device-font-menus-core): 1. Replace (delq nil (mapcar ....)) with analogous (mapcan ...) forms; this is in non-dumped files, it was done previously in dumped files. 2. Replace (delq FOO (copy-sequence BAR)) with (remove* FOO BAR), where #'eq and #'eql are equivalent 3. Replace (delq FOO BAR) with (delete* FOO BAR), where FOO is not a non-fixnum number. Saves a little space in the dumped file (since the compiler macro adds :test #'eq to the delete* call if it's not clear that FOO is not a non-fixnum number).
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 01 May 2012 16:17:42 +0100
parents 308d34e9f07d
children
line wrap: on
line source

/* Static Heap management routines for XEmacs.
   Copyright (C) 1994, 1998 Free Software Foundation, Inc.

This file is part of XEmacs.

XEmacs is free software: you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation, either version 3 of the License, or (at your
option) any later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs.  If not, see <http://www.gnu.org/licenses/>. */

#include <config.h>
#include "lisp.h"

#include "sysfile.h"

#include <unistd.h>
#include <sheap-adjust.h>

#define STATIC_HEAP_BASE	0x800000
#define STATIC_HEAP_SLOP	0x80000
#define STATIC_HEAP_SIZE \
(STATIC_HEAP_BASE + SHEAP_ADJUSTMENT + STATIC_HEAP_SLOP)
#define BLOCKSIZE	(1<<12)
#define ALLOC_UNIT (BLOCKSIZE-1)
#define ALLOC_MASK ~((unsigned long)(ALLOC_UNIT))
#define ALIGN_ALLOC(addr) ((((unsigned long)addr) + ALLOC_UNIT) & ALLOC_MASK)

char	static_heap_buffer[STATIC_HEAP_SIZE]={0};
char*	static_heap_base=static_heap_buffer;
char*	static_heap_ptr=static_heap_buffer;
unsigned long	static_heap_size=STATIC_HEAP_SIZE;
int 	static_heap_initialized=0;
int 	static_heap_dumped=0;

void *more_static_core ( ptrdiff_t increment );
void *more_static_core ( ptrdiff_t increment )
{
  int size = (int) increment;
  void *result;

  if (!static_heap_initialized)
    {
#ifdef VALMASK
      if (((unsigned long) static_heap_base & ~VALMASK) != 0)
	{
	  printf ("error: The heap was allocated in upper memory.\n");
	  exit (-1);
	}
#endif
      static_heap_base=(char*)ALIGN_ALLOC(static_heap_buffer);
      static_heap_ptr=static_heap_base;
      static_heap_size=STATIC_HEAP_SIZE -
	(static_heap_base-static_heap_buffer);
#ifdef CYGWIN
      sbrk(BLOCKSIZE);		/* force space for fork to work */
#endif
      static_heap_initialized=1;
    }

  result = static_heap_ptr;

  /* we don't need to align - handled by gmalloc.  */

  if (size < 0)
    {
      if (static_heap_ptr + size < static_heap_base)
	{
	  return 0;
	}
    }
  else
    {
      if (static_heap_ptr + size >= static_heap_base + static_heap_size)
	{
	  printf (
"\nRequested %d bytes, static heap exhausted!  base is %p, current ptr\n"
"is %p, static heap size is %ld. You have exhausted the static heap. \n"
"\n"
"If you are simply trying to compile, remove sheap-adjust.h\n"
"and recompile from the top level. If this doesn't\n"
"work then STATIC_HEAP_SLOP (defined in this file) is too small.\n"
"\n"
"If you want to run temacs, change SHEAP_ADJUSTMENT in sheap-adjust.h\n"
"to 0 or a +ve number. Generally you should *not* try to run temacs\n"
"with a static heap, you should dump first.\n",
          size, static_heap_base, static_heap_ptr, static_heap_size);

	  exit(-1);
	  return 0;
	}
    }
  static_heap_ptr += size;

  return result;
}

static void
sheap_adjust_h (long adjust)
{
  FILE *stream = retry_fopen ("sheap-adjust.h", "w");

  if (stream == NULL)
    report_file_error ("Opening sheap adjustment file",
		       build_ascstring ("sheap-adjust.h"));

  fprintf (stream,
	   "/*\tDo not edit this file!\n"
	   "\tAutomatically generated by XEmacs */\n"
	   "# define SHEAP_ADJUSTMENT (%ld)\n", adjust);
  retry_fclose (stream);
}

void report_sheap_usage (int die_if_pure_storage_exceeded);
void
report_sheap_usage (int die_if_pure_storage_exceeded)
{
  int rc = 0;

  Bytecount lost = STATIC_HEAP_SIZE
    - (static_heap_ptr - static_heap_buffer);
  char buf[200];
  sprintf (buf, "Static heap usage: %ldk of %ldk, slop is %ldk",
               (long) ((static_heap_ptr - static_heap_buffer) /1024),
	   (long) (STATIC_HEAP_SIZE / 1024),
	   (long) STATIC_HEAP_SLOP / 1024);

  if (lost > STATIC_HEAP_SLOP)
    {
      sprintf (buf + strlen (buf), " -- %ldk wasted", (long)(lost/1024));
      if (die_if_pure_storage_exceeded)
	{
	  sheap_adjust_h(STATIC_HEAP_SLOP - lost);
	  sprintf (buf + strlen (buf), " -- reset to %ldk", 
		   (long) ((STATIC_HEAP_SIZE + STATIC_HEAP_SLOP - lost) /
			   1024));
	  rc = -1;
	}
      message ("%s\n", buf);
    }

  if (rc < 0)
    {
      unlink ("SATISFIED");
      stderr_out ("Static heap size adjusted, don't panic!  I will restart the `make'\n");
      exit (0);
    }
}