/* VMS mapping of data and alloc arena for GNU Emacs.
   Copyright (C) 1986, 1987 Free Software Foundation, Inc.
   
   This file is part of GNU Emacs.

GNU Emacs 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 1, or (at your option)
any later version.

GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

/* Written by Mukesh Prasad.  */

#ifdef VMS

/* #define VMS_DEBUG */

#include <stdio.h>
#include <errno.h>
#include <config.h>
#include "lisp.h"
#include "getpagesize.h"
#include <rab.h>
#include <fab.h>
#include <rmsdef.h>
#include <secdef.h>

/* RMS block size */
#define	BLOCKSIZE	512

/* Maximum number of bytes to be written in one RMS write.
 * Must be a multiple of BLOCKSIZE.
 */
#define	MAXWRITE	(BLOCKSIZE * 30)

/* This funniness is to ensure that sdata occurs alphabetically BEFORE the
   $DATA psect and that edata occurs after ALL Emacs psects.  This is
   because the VMS linker sorts all psects in a cluster alphabetically
   during the linking, unless you use the cluster_psect command.  Emacs
   uses the cluster command to group all Emacs psects into one cluster;
   this keeps the dumped data separate from any loaded libraries. */

#ifdef __GNUC__
/* We need a large sdata array because otherwise the impure storage will end up
   in low memory, and this will screw up garbage collection (Emacs will not
   be able to tell the difference between a string length and an address).
   This array guarantees that the impure storage is at a sufficiently high
   address so that this problem will not occur. */
char sdata[1] asm("_$$PsectAttributes_NOOVR$$$$$$DATA") = { 'x' };
char edata[1] asm("_$$PsectAttributes_NOOVR$$____DATA") = { 'x' };
#else
globaldef {"$$$$DATA"} char sdata[1] = { 'x' }; /* Start of saved data area */
globaldef {"____DATA"} char edata[1] = { 'x' }; /* End of saved data area */
#endif

/* It looks like the AXP/OpenVMS linker puts the psects like this:
	$DATA$	containing all initialized data.
	$CODE$	containing the code
	$BSS$	containing uninitialized data.
   This means we have to put two sections in the dump file. The sdata and
   edata up there find their way into the initialized part of the data.
   We thus need to add a second section to the dump file. Boy, will this
   look hairy! */

#ifndef __GNUC__
#ifdef __DECC
globaldef {"$$$$BSS"} char BSS_sdata[1]; /* Start of saved data area */
globaldef {"____BSS"} char BSS_edata[1]; /* End of saved data area */
#endif
#endif

/* Structure to write into first block of map file.
 */

struct map_data
{
  char * sdata;			/* Start of data area */
  char * edata;			/* End of data area */
#if 0
  int  datablk;			/* Block in file to map data area from/to.
				   This is relative to the start of section */
#endif
  int  nblocks;			/* # of blocks in this section (incl. head) */
  int  nremain;			/* Number of sections after this one */
};

static void fill_fab (), fill_rab ();
static int write_data ();

extern char *start_of_data ();
extern char *end_of_data ();
extern char *start_of_BSS ();
extern char *end_of_BSS ();
extern char *start_of_heap ();
extern char *end_of_heap ();
extern char *start_of_initial_brk_area ();
extern char *end_of_initial_brk_area ();

typedef char * (*prgptr)();
static const prgptr data_routines [] =
{
  start_of_data, end_of_data,
#ifndef __GNUC__
#ifdef __DECC
  start_of_BSS, end_of_BSS,
#endif
#endif
#if 0
  start_of_heap, end_of_heap,
#else
  start_of_initial_brk_area, end_of_initial_brk_area,
#endif
  0, 0,
  0, 0
};

/* Finds the data according to the current session */
int
get_map_data (map_data, datasize, sum_blocks, cnt, data_routines)
     struct map_data *map_data;
     int *datasize, *sum_blocks;
     prgptr *data_routines;
{
  int n_mappings, i;

  for (i = 0, n_mappings = 1,
	 *sum_blocks = ((sizeof (struct map_data)*cnt + BLOCKSIZE - 1)
		       / BLOCKSIZE);
       i < cnt; i++)
    {
      if (data_routines[i*2] != 0)
	{
	  map_data[n_mappings].sdata = (*data_routines[i*2])();
	  map_data[n_mappings].edata = (*data_routines[i*2+1])();
#ifdef VMS_DEBUG
	  {
	    printf ("checking out this map_data (# %d):\n", n_mappings);
	    printf ("  sdata: %p\n", map_data[n_mappings].sdata);
	    printf ("  edata: %p\n", map_data[n_mappings].edata);
	  }
#endif
	  if (n_mappings > 1)
	    {
	      int j;

	      for (j = n_mappings; j-- > 1;)
		{
		  /* data and j are disjunct */
		  if (map_data[n_mappings].sdata >= map_data[j].edata
		      || map_data[n_mappings].edata <= map_data[j].sdata)
		    {
#ifdef VMS_DEBUG
		      printf (" Not sharing space with map_data # %d!\n", j);
#endif
		      continue;
		    }

		  /* data contains j */
		  if (map_data[n_mappings].sdata <= map_data[j].sdata
		      && map_data[n_mappings].edata >= map_data[j].edata)
		    {
#ifdef VMS_DEBUG
		      printf (" moved to map_data # %d, which it contained\n",
			      j);
#endif
		      map_data[j].sdata = map_data[n_mappings].sdata;
		      map_data[j].edata = map_data[n_mappings].edata;
		    }
		  else
#ifdef VMS_DEBUG
		    printf (" part of map_data # %d, or equal to it\n", j);
#endif

		  /* For all other cases, just do nothing */
		  goto skip_this;
		}
	    }
	  datasize[n_mappings] =
	    map_data[n_mappings].edata - map_data[n_mappings].sdata + 1;
	  map_data[n_mappings].nblocks =
	    ((datasize[n_mappings] + BLOCKSIZE - 1) / BLOCKSIZE);
	  *sum_blocks += map_data[n_mappings].nblocks;
	  n_mappings++;

	}
  skip_this: ;
    }
  map_data[0].nblocks = --n_mappings;
#ifdef VMS_DEBUG
  printf ("Results:\n");
#endif
  for (i = 1; i <= n_mappings; i++)
    {
      map_data[i].nremain = n_mappings - i;
#ifdef VMS_DEBUG
      {
	printf ("map_data # %d (out of %d):\n", i, n_mappings);
	printf ("  sdata: %p\n", map_data[i].sdata);
	printf ("  edata: %p\n", map_data[i].edata);
#if 0
	printf ("  datablk: %d\n", map_data[i].datablk);
#endif
	printf ("  nblocks: %d\n", map_data[i].nblocks);
	printf ("  nremain: %d\n", map_data[i].nremain);
      }
#endif
    }
#ifdef VMS_DEBUG
  printf ("----------\n");
#endif
  return 0;
}

/* Maps in the data and alloc area from the map file.
 */

int
mapin_data (name)
     char * name;
{
  struct FAB fab;
  struct RAB rab;
  int status, size;
  int inadr[2];
  struct map_data current_map_data[4];
  struct map_data map_data[4];
  int dummy1[4], dummy2;
  int starting_block, i;

  get_map_data (current_map_data, dummy1, &dummy2, 3, data_routines);

  /* Open map file. */
  fab = cc$rms_fab;
  fab.fab$b_fac = FAB$M_BIO|FAB$M_GET;
  fab.fab$l_fna = name;
  fab.fab$b_fns = strlen (name);
  status = sys$open (&fab);
  if (status != RMS$_NORMAL)
    {
      printf ("Map file not available, running bare Emacs....\n");
      return 0;			/* Map file not available */
    }
  /* Connect the RAB block */
  rab = cc$rms_rab;
  rab.rab$l_fab = &fab;
  rab.rab$b_rac = RAB$C_SEQ;
  rab.rab$l_rop = RAB$M_BIO;
  status = sys$connect (&rab);
  if (status != RMS$_NORMAL)
    lib$stop (status);
  /* Read the header data */
  rab.rab$l_ubf = (char *) &map_data;
  rab.rab$w_usz = sizeof (map_data);
  rab.rab$l_bkt = 0;
  status = sys$read (&rab);
  if (status != RMS$_NORMAL)
    lib$stop (status);
  status = sys$close (&fab);
  if (status != RMS$_NORMAL)
    lib$stop (status);

  for (i = 1,
	 starting_block = ((sizeof (map_data) + BLOCKSIZE - 1) / BLOCKSIZE) + 1;
       i <= map_data[0].nblocks; i++)
    {
#ifdef VMS_DEBUG
      {
	printf ("map_data # %d (out of %d):\n", i, map_data[0].nblocks);
	printf ("  sdata: %p\n", map_data[i].sdata);
	printf ("  edata: %p\n", map_data[i].edata);
#if 0
	printf ("  datablk: %d\n", map_data[i].datablk);
#endif
	printf ("  nblocks: %d\n", map_data[i].nblocks);
	printf ("  nremain: %d\n", map_data[i].nremain);
      }
#endif
      if (map_data[i].sdata != current_map_data[i].sdata)
	  {
	    fprintf (stderr,
		     "Start of data area has moved: cannot map in data.");
	    fprintf (stderr,
		     "  (expected start = 0x%p,  current start = 0x%p\n",
		     map_data[i].sdata, current_map_data[i].sdata);
	    abort ();
	  }	    
      if (map_data[i].edata != current_map_data[i].edata)
	  {
	    fprintf (stderr,
		     "End of data area has moved: cannot map in data.");
	    fprintf (stderr,
		     "  (expected end = 0x%p,  current end = 0x%p\n",
		     map_data[i].edata, current_map_data[i].edata);
	    abort ();
	  }	    
      if (map_data[i].nremain != map_data[0].nblocks - i)
	{
	  static buf[512];
	  sprintf (buf, "Unexpected amount of remaining sections (%d, expected %d): cannot map in data.",
		   map_data[i].nremain, map_data[0].nblocks - i);
	  fprintf (stderr, buf);
	  abort ();
	}
      fab.fab$l_fop |= FAB$M_UFO;
      status = sys$open (&fab);
      if (status != RMS$_NORMAL)
	lib$stop (status);
      /* Map data area. */
      inadr[0] = (int) map_data[i].sdata;
      inadr[1] = (int) map_data[i].edata;
#if 0 /* This is bogus, until the contrary is proven */
#ifdef __DECC
#define FLAGS SEC$M_CRF | SEC$M_WRT | SEC$M_EXPREG
#else /* not __DECC */
#define FLAGS SEC$M_CRF | SEC$M_WRT
#endif /* __DECC */
#else /* not 0 */
#define FLAGS SEC$M_CRF | SEC$M_WRT
#endif /* 0 */
      {
	volatile int retadr[2], i;
#ifdef VMS_DEBUG
	printf ("The input address was (2 items): \n");
	for (i = 0; i < 2; i++)
	  printf (" %u", inadr[i]);
	printf ("\n");
#endif

	status = sys$crmpsc (inadr, retadr, 0, FLAGS, 0, 0, 0,
			     fab.fab$l_stv, 0,
			     starting_block, 0, 0);

#ifdef VMS_DEBUG
	printf ("The return address was (2 items): \n");
	for (i = 0; i < 2; i++)
	  printf (" %u", retadr[i]);
	printf ("\n");
#endif
	if (inadr[0] != retadr[0])
	  {
	    fprintf (stderr,
		     "Start of data area has moved: cannot map in data.");
	    fprintf (stderr,
		     "  (expected start = 0x%p,  resulting start = 0x%p\n",
		     inadr[0], retadr[0]);
	    abort ();
	  }	    
      }
      if (! (status & 1))
	lib$stop (status);
      starting_block += map_data[i].nblocks;
    }

  /* cooperate with VMSGMALLOC.C */
  {
#ifdef GNU_MALLOC
    void malloc_clear_hooks ();
#if 0
    void vms_clear_data ();
    vms_clear_data (1);
#endif
    malloc_clear_hooks ();
#endif
  }
}

/* Writes the data and alloc area to the map file.
 */
mapout_data (into)
     char * into;
{
  struct FAB fab;
  struct RAB rab;
  int status, i;
  unsigned long n_mappings;
  struct map_data map_data[4];
  int datasize[4], msize, sum_blocks, starting_block;
  extern int vms_malloc_overflow ();

  if (vms_malloc_overflow ())
    {
      static char buf[512];
      extern char * start_of_initial_brk_area ();
      extern char * end_of_initial_brk_area ();
      extern char * start_of_brk_area ();
      extern char * current_end_of_brk_area ();
      sprintf (buf, "Out of initial allocation.  Must rebuild Emacs with more memory (VMS_ALLOCATION_SIZE).\n(VMS_ALLOCATION_SIZE is currently %u, but should be %u)",
	       end_of_initial_brk_area () - start_of_initial_brk_area () + 1,
	       current_end_of_brk_area () - start_of_brk_area () + 1);
      error (buf);
      return 0;
    }

  get_map_data (map_data, datasize, &sum_blocks, 3, data_routines);
  n_mappings = map_data[0].nblocks;

  /* Create map file. */
  fab = cc$rms_fab;
  fab.fab$b_fac = FAB$M_BIO|FAB$M_PUT;
  fab.fab$l_fna = into;
  fab.fab$b_fns = strlen (into);
  fab.fab$l_fop = FAB$M_CBT;
  fab.fab$b_org = FAB$C_SEQ;
  fab.fab$b_rat = 0;
  fab.fab$b_rfm = FAB$C_VAR;
  fab.fab$l_alq = sum_blocks;
  status = sys$create (&fab);
  if (status != RMS$_NORMAL)
    {
      error ("Could not create map file: %s", strerror (EVMSERR, status));
      return 0;
    }
  /* Connect the RAB block */
  rab = cc$rms_rab;
  rab.rab$l_fab = &fab;
  rab.rab$b_rac = RAB$C_SEQ;
  rab.rab$l_rop = RAB$M_BIO;
  status = sys$connect (&rab);
  if (status != RMS$_NORMAL)
    {
      error ("RMS connect to map file failed: %s", strerror (EVMSERR, status));
      return 0;
    }
  /* Write the header */
  rab.rab$l_rbf = (char *) map_data;
  rab.rab$w_rsz = sizeof (map_data);
  rab.rab$l_bkt = 0;
  status = sys$write (&rab);
  if (status != RMS$_NORMAL)
    {
      error ("RMS write (header) to map file failed: %s", strerror (EVMSERR, status));
      status = sys$close (&fab);
      if (status != RMS$_NORMAL)
	error ("RMS close on map file failed: %s", strerror (EVMSERR, status));
      return 0;
    }
  for (i = 1,
	 starting_block = ((sizeof (map_data) + BLOCKSIZE - 1) / BLOCKSIZE) + 1;
       i <= n_mappings; i++)
    {
      if (! write_data (&rab, starting_block, map_data[i].sdata, datasize[i]))
	{
	  status = sys$close (&fab);
	  if (status != RMS$_NORMAL)
	    error ("RMS close on map file failed: %s", strerror (EVMSERR, status));
	  return 0;
	}
      starting_block += map_data[i].nblocks;
    }
  status = sys$close (&fab);
  if (status != RMS$_NORMAL)
    {
      error ("RMS close on map file failed: %s", strerror (EVMSERR, status));
      return 0;
    }
  return 1;
}

static int
write_data (rab, firstblock, data, length)
     struct RAB * rab;
     char * data;
{
  int status;
  int cnt = 0;
  int total = length;
  
  rab->rab$l_bkt = firstblock;
  while (length > 0)
    {
      rab->rab$l_rbf = data;
      rab->rab$w_rsz = length > MAXWRITE ? MAXWRITE : length;
      status = sys$write (rab, 0, 0);
      if (status != RMS$_NORMAL)
	{
	  char buf[512];

	  /* We double the %% part, because error () does it's own
	     processing of % */
	  fprintf (stderr,
		   "RMS write to map file failed with status %%X0%X (below) (data = %%X0%X, %d bytes chunk #%d, %d bytes out of %d left to write)",
		   status, data,
		   MAXWRITE, cnt, length, total);
	  lib$signal (status);
	  return 0;
	}
      data = &data[MAXWRITE];
      cnt++;
      length -= MAXWRITE;
      rab->rab$l_bkt = 0;
    }
  return 1;
}				/* write_data */

/* The following code should probably really reside in sysdep.c, but there's a
   bug in the DEC C v1.3 compiler, concerning globaldef and globalref */

#define FIRST_PAGE_BYTE(p,ps) \
  (((unsigned long) (p)) & ~((ps) - 1))

#define LAST_PAGE_BYTE(p,ps) \
  ((((unsigned long) (p)) & ~((ps) - 1)) + ((ps) - 1))

/*
 *	Return the address of the start of the data segment prior to
 *	doing a memory dump.
 */
 
char *
start_of_data ()
{
#ifdef VMS_DEBUG
  printf ("Start of data : %%X0%X (page size = %d)\n",
	  FIRST_PAGE_BYTE ((char *) &sdata, getpagesize ()), getpagesize ());
  printf ("%p & %x (~(getpagesize () - 1)) = %p\n",
	  (char *) &edata, ~(getpagesize () - 1),
	  ((unsigned long)((char *) &sdata)) & ~(getpagesize () - 1));
#endif

  /* We arrange for this to always start on a CPU-specific page boundary.  */
  return FIRST_PAGE_BYTE ((char *) &sdata, getpagesize ());
}

/*
 *	Return the address of the end of the data segment prior to
 *	doing a memory dump.
 */

char *
end_of_data ()
{
#ifdef VMS_DEBUG
  printf ("End of data : %%X0%X (page size = %d)\n",
	  LAST_PAGE_BYTE ((char *) &edata, getpagesize ()), getpagesize ());
  printf ("%p & %x (~(getpagesize () - 1)) = %p\n",
	  (char *) &edata, ~(getpagesize () - 1),
	  ((unsigned long)((char *) &edata)) & ~(getpagesize () - 1));
#endif

  /* We return the last byte of the last page. This works on VAX/VMS,
     and is required on Alpha/VMS.  */
  return LAST_PAGE_BYTE ((char *) &edata, getpagesize ());
}

#ifndef __GNUC__
#ifdef __DECC
/* The two following are the same as the two above, but for the uninitialized
   variables */

char *
start_of_BSS ()
{
#ifdef VMS_DEBUG
  printf ("Start of BSS : %%X0%X (page size = %d)\n",
	  FIRST_PAGE_BYTE ((char *) &BSS_sdata, getpagesize ()),
	  getpagesize ());
  printf ("%p & %x (~(getpagesize () - 1)) = %p\n",
	  (char *) &BSS_sdata, ~(getpagesize () - 1),
	  ((unsigned long)((char *) &BSS_sdata)) & ~(getpagesize () - 1));
#endif

  /* We arrange for this to always start on a CPU-specific page boundary.  */
  return FIRST_PAGE_BYTE ((char *) &BSS_sdata, getpagesize ());
}

char *
end_of_BSS ()
{
#ifdef VMS_DEBUG
  printf ("End of BSS : %%X0%X (page size = %d)\n",
	  LAST_PAGE_BYTE ((char *) &BSS_edata, getpagesize ()), getpagesize ());
  printf ("%p & %x (~(getpagesize () - 1)) = %p\n",
	  (char *) &BSS_edata, ~(getpagesize () - 1),
	  ((unsigned long)((char *) &BSS_edata)) & ~(getpagesize () - 1));
#endif

  /* We return the last byte of the last page. This works on VAX/VMS,
     and is required on Alpha/VMS.  */
  return LAST_PAGE_BYTE ((char *) &BSS_edata, getpagesize ());
}

#endif /* __DECC */
#endif /* ! __GNUC__ */

char *
start_of_heap ()
{
  extern char *start_of_brk_area ();
  return start_of_brk_area ();
}

char *
end_of_heap ()
{
  extern char *end_of_brk_area ();
  return LAST_PAGE_BYTE((char *) end_of_brk_area (), getpagesize ());
}

char *
start_of_initial_heap ()
{
  extern char *start_of_brk_area ();
  return start_of_brk_area ();
}

char *
end_of_initial_heap ()
{
  extern char *end_of_brk_area ();
  return LAST_PAGE_BYTE((char *) end_of_brk_area (), getpagesize ());
}

#endif /* VMS */