/* Copyright (C) 1991-99 Free Software Foundation, Inc.

   This file is part of GNU Pascal Library.

   Miscellaneous routines for extended pascal support

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

The GNU Pascal Library 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
Library General Public License for more details.

You should have received a copy of the GNU Library General Public
License along with the GNU Pascal Library; see the file COPYING.LIB.  If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA.  */

#include "rts.h"

/* A list of saved constructors to be run */
CONSTRUCTOR *_p_c_list = (CONSTRUCTOR *)NULL;

/* This is set nonzero when the constructors are collected */
int _p_collect_flag = 1;

int _p_no_constructors = 0;

/* This is called by the compiler generated code from pascal module
 * initializers, each pass their own ADDRESS and a RUN_ID as argument.
 *
 * The constructor with the smallest RUN_ID will be first in the list.
 * If two constructors have same run id, the one that called this first
 * is called before.
 *
 * Negative RUN_ID's are reserved for Pascal internal use.
 */
void
_p_collect (fun, run_id)
     void (* fun)();
     int run_id;
{
  CONSTRUCTOR *scan;
  CONSTRUCTOR *c = (CONSTRUCTOR *) malloc (sizeof (CONSTRUCTOR));

  /* _p_debug is not yet set, so no debugging info is printed... */
  D(1, fprintf (stderr, "Collecting constructor at $%lx with run id %d\n", (long)fun, run_id));

  if (! c)
    {
      fputs ("internal error: could not allocate storage for constructor\n", stderr);
      _exit (-1);
    }

  c->fun    = fun;
  c->run_id = run_id;
  c->next   = (CONSTRUCTOR *)NULL;

  if (! _p_c_list || run_id < _p_c_list->run_id)
    {
      /* Make this the first constructor */
      c->next = _p_c_list;
      _p_c_list = c;
    }
  else
    for (scan = _p_c_list; scan; scan = scan->next)
      {
        if (fun == scan->fun)
          {
            fputs ("internal error: duplicate constructor\n", stderr);
            _exit (-1);
          }

        if (scan->run_id > run_id || !scan->next)
          { /* Append to current node */
            c->next = scan->next;
            scan->next = c;
            break;
          }
      }
}

/* Run the constructors collected and sorted to _p_c_list
 */
void
_p_run_constructors ()
{
  CONSTRUCTOR *scan;
  int count = 0;

  _p_collect_flag = 0;
  if (_p_no_constructors) return;
  _p_no_constructors++;

  for (scan = _p_c_list; scan; scan = scan->next, count++)
    {
      D(1, fprintf (stderr, "Running constructor %d at $%lx with run id %d\n",
        count, (long)scan->fun, scan->run_id));
      (*(scan->fun))();
    }
}
