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

   This file is part of GNU Pascal Library.

   Routines to output various things.

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.  */

/*
 * Authors: Jukka Virtanen <jtv@hut.fi>
 *          Peter Gerwinski <peter@gerwinski.de>
 *          Frank Heckenbach <frank@pascal.gnu.de>
 */

#include "rts.h"
#include "fdr.h"
#include "varargs.h"

void
_p_internal_fwrite (ptr, size, presult, File)
    const void *ptr; size_t size; size_t *presult; FDR File;
{
  size_t result;
  if (File->hack_OutFunc)
    {
      int iresult, errcode;
      errcode = File->hack_OutFunc (File->PrivateData, ptr, size, &iresult);
      result = iresult;
      if (errcode) IOERROR_FILE (errcode, File,);
    }
  else if (File->WriteFunc)
    {
      result = File->WriteFunc (File->PrivateData, ptr, size);
      if (_p_inoutres) IOERROR_FILE (_p_inoutres, File,);
    }
  else
    {
      result = 0;
      IOERROR_FILE (466, File,); /* error when writing to `%s' */
    }
  if (presult)
    *presult = result;
  else
    if (!_p_inoutres && result != size)
      IOERROR_FILE (467, File,); /* could not write all the data to `%s' */
}

static void
_p_write_to_buf (File, ptr, size)
FDR File; const char *ptr; size_t size;
{
  int a;
  if (_p_inoutres) return;
  a = File->BufSize - File->BufPos;
  if (size < a) a = size;
  if (a > 0)
    {
      memcpy (File->BufPtr + File->BufPos, ptr, a);
      File->BufPos += a;
      ptr += a;
      size -= a;
    }
  if (size == 0) return;
  if (File->Flags & READ_WRITE_STRING_MASK)
    {
      if (File->Flags & TRUNCATE_STRING_MASK)
        return;
      else
        IOERROR (582,); /* Attempt to write past end of string in `WriteStr' */
    }
  _p_internal_fwrite (File->BufPtr, File->BufPos, NULL, File);
  if (size <= File->BufSize)
    {
      memcpy (File->BufPtr, ptr, size);
      File->BufPos = size;
    }
  else
    {
      _p_internal_fwrite (ptr, size, NULL, File);
      File->BufPos = 0;
    }
}

static void
_p_write_flush (File)
FDR File;
{
  if (_p_inoutres) return;
  if (File->BufPos != 0)
    _p_internal_fwrite (File->BufPtr, File->BufPos, NULL, File);
  _p_clearbuffer (File);
  if (tst_FLUSH(File))
    _p_flush(File);
}

/* pad with spaces */
#define PADSIZE 32
static char const blanks[PADSIZE] =
{' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
 ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '};

static void
_p_write_pad (File,count)
FDR File; int count;
{
  register int i;
  for (i = count; i > 0 ; i -= PADSIZE)
    _p_write_to_buf (File, blanks, (i >= PADSIZE) ? PADSIZE : i);
}

static void
_p_write_padded (File, buf, length, width, clip)
FDR File; char *buf; int length, width, clip;
{
  int pad_left = 0, pad_right = 0;
  if (width != NO_WIDTH)
    {
      int abs_width, pad;
      abs_width = (width >= 0) ? width : - width;
      if (length > abs_width)
        {
          pad = 0;
          if (clip) length = abs_width;
        }
      else
        pad = abs_width - length;
      if (width >= 0)
        pad_left = pad;
      else
        {
          switch (File->Flags & NEG_WIDTH_MASKS)
            {
              case NEG_WIDTH_ERROR_MASK:  IOERROR (580,); /* fixed field width cannot be negative */
              case NEG_WIDTH_LEFT_MASK:   pad_right = pad;
                                          break;
              case NEG_WIDTH_CENTER_MASK: pad_left = pad / 2;
                                          pad_right = pad - pad_left;
            }
        }
    }
  _p_write_pad (File, pad_left);
  _p_write_to_buf (File, buf, length);
  _p_write_pad (File, pad_right);
}

/* Sufficient width to hold a signed long long in decimal representation */
#define MAX_LONG_WIDTH (sizeof(long long) * BITS_PER_UNIT / 3 + 2)

#define DEFWRITEINT(fnname,type,conv_fn) \
extern void fnname PROTO ((FDR, type, int)); \
void                                                \
fnname (File, num, width)                           \
FDR File; type num; int width;                \
{                                                   \
  char buf[MAX_LONG_WIDTH], *buf_begin;             \
  int negative = num < 0;                           \
  if (negative) num = - num;                        \
  buf_begin = conv_fn (num, buf + MAX_LONG_WIDTH);  \
  if (negative) *(--buf_begin) = '-';               \
  _p_write_padded (File, buf_begin, buf + MAX_LONG_WIDTH - buf_begin, width, 0); \
}
DEFWRITEINT (_p_write_integer,  signed int,         _p_card_to_decimal)
DEFWRITEINT (_p_write_longint,  signed long long,   _p_longcard_to_decimal)
DEFWRITEINT (_p_write_cardinal, unsigned int,       _p_card_to_decimal)
DEFWRITEINT (_p_write_longcard, unsigned long long, _p_longcard_to_decimal)

extern void _p_write_real PROTO ((FDR, long double, int, int));
void
_p_write_real (File, num, width, prec)
FDR File; long double num; int width, prec;
{
  char *buf;
  int buf_size;
  if (prec < 0 && prec != NO_PRECISION)
    IOERROR (581,); /* fixed real fraction field width cannot be negative */
  buf = _p_longreal_to_decimal (num, width, prec,
        width != NO_WIDTH,
        (File->Flags & REAL_NOBLANK_MASK) == 0,
        (File->Flags & REAL_CAPITAL_EXP_MASK) != 0, &buf_size);
  _p_write_padded (File, buf, _p_strlen(buf), width, 0);
  if (buf_size)
    _p_dispose (buf);
}

extern void _p_write_char PROTO ((FDR, char, int));
void
_p_write_char (File, ch, width)
FDR File; char ch; int width;
{
  _p_write_padded (File, &ch, sizeof (ch), width, 0);
}

extern void _p_write_boolean PROTO ((FDR, int, int));
void
_p_write_boolean (File, b, width)
FDR File; int b; int width;
{
  char *str_val = b ? TRUE_str : FALSE_str;
  _p_write_padded (File, str_val, _p_strlen (str_val), width, 1);
}

extern void _p_write_string PROTO ((FDR, char *, int, int));
void
_p_write_string (File, s, length, width)
FDR File; char *s; int length; int width;
{
  if (s == NULL)
    length = 0;
  else if (length < 0)  /* CString */
    length = strlen (s);
  _p_write_padded (File, s, length, width, File->Flags & CLIP_STRING_MASK);
}

extern void _p_writeln PROTO ((FDR));
void
_p_writeln (File)
FDR File;
{
  char newline = NEWLINE;
  _p_write_to_buf (File, &newline, sizeof (newline));
}

/* common to _p_write() and _p_writestr() */
#define WRITE_VARIOUS_TYPES \
  case P_S_INT: \
    { \
      signed int num = va_arg (p, signed int); \
      _p_write_integer (File, num, ((File->Flags & FIX_WIDTH_MASK) ? va_arg (p, int) : NO_WIDTH)); \
      break; \
    } \
  case P_S_LONGLONG: \
    { \
      signed long long int num = va_arg (p, signed long long int); \
      _p_write_longint (File, num, ((File->Flags & FIX_WIDTH_MASK) ? va_arg (p, int) : NO_WIDTH)); \
      break; \
    } \
  case P_U_INT: \
    { \
      unsigned int num = va_arg (p, unsigned int); \
      _p_write_cardinal (File, num, ((File->Flags & FIX_WIDTH_MASK) ? va_arg (p, int) : NO_WIDTH)); \
      break; \
    } \
  case P_U_LONGLONG: \
    { \
      unsigned long long int num = va_arg (p, unsigned long long int); \
      _p_write_longcard (File, num, ((File->Flags & FIX_WIDTH_MASK) ? va_arg (p, int) : NO_WIDTH)); \
      break; \
    } \
  case P_LONG_REAL: \
    { \
      long double num = va_arg (p, long double); \
      int width = (File->Flags & FIX_WIDTH_MASK) ? va_arg (p, int) : NO_WIDTH; \
      int prec = (File->Flags & FIX2_REAL_MASK) ? va_arg (p, int) : NO_PRECISION; \
      _p_write_real (File, num, width, prec); \
      break; \
    } \
  case P_CHAR: \
    { \
      char ch = (char) va_arg (p, int); \
      _p_write_char (File, ch, ((File->Flags & FIX_WIDTH_MASK) ? va_arg (p, int) : NO_WIDTH)); \
      break; \
    } \
  case P_BOOL: \
    { \
      int b = va_arg (p, int); \
      _p_write_boolean (File, b, ((File->Flags & FIX_WIDTH_MASK) ? va_arg (p, int) : NO_WIDTH)); \
      break; \
    } \
  case P_ANY_STRING: \
    { \
      char *str = va_arg (p, char *); \
      int length = va_arg (p, int); \
      _p_write_string (File, str, length, ((File->Flags & FIX_WIDTH_MASK) ? va_arg (p, int) : NO_WIDTH)); \
      break; \
    }

extern void _p_write_init PROTO ((FDR, int));
void
_p_write_init (File, Flags)
FDR File;
int Flags;
{
  _p_ok_WRITE (File);
  File->BufSize = FILE_BUFSIZE;
  File->BufPos = 0;
  File->Flags = Flags;
}

extern void _p_writestr_init PROTO ((FDR, char *, int, int));
void
_p_writestr_init (File, s, Capacity, Flags)
FDR File;
char *s;
int Capacity, Flags;
{
  File->BufPtr = s;
  File->BufSize = Capacity;
  File->BufPos = 0;
  File->Flags = Flags;
}

extern int _p_writestr_getlength PROTO ((FDR));
int
_p_writestr_getlength (File)
FDR File;
{
  return File->BufPos;
}

void
_p_write (File, count, va_alist)
FDR File;
int count;
va_dcl
{
  va_list p;
  _p_write_init (File, 0);
  va_start (p);
  while (count--)
    {
      int Flags = va_arg (p, int); /* Type we are writing */
      /* The type code and FIX_WIDTH_MASK and FIX2_REAL_MASK are only
         needed for the following switch and can be removed when the
         switch is "built in".

         The subroutines only need the other modifier flags. They should
         be constant during one Write{,ln,Str} call, and can therefore
         be initialized once in the _p_write_init() call above, eliminating
         the following assignment. */
      File->Flags = Flags;

      switch (Flags & OUTPUT_TYPE_MASK)
      {
        WRITE_VARIOUS_TYPES
        case P_LINE:
          if (count != 0)
            _p_internal_error (901); /* Compiler calls `Writeln' incorrectly */
          _p_writeln (File);
          break;
        default:
          _p_internal_error (904); /* unknown code in `Write' */
      }
    }
  va_end (p);
  _p_write_flush (File);
}

/* string_type must be one of P_STRING, P_SHORT_STRING, P_FIXED_STRING,
   P_CSTRING, possibly ORed with TRUNCATE_STRING_MASK */
void
_p_writestr (string_type, s1, va_alist)
int string_type;
char *s1;
va_dcl
{
  va_list p;
  int count, Capacity, Flags1, Length;
  int *long_curlen = 0;
  char *short_curlen = 0;
  struct Fdr TempFile; /* This is no real file, be careful what you do with it. Don't call initfdr(). ;*/
  FDR File = &TempFile; /* needed by WRITE_VARIOUS_TYPES */

  va_start (p);

  /* Length pointer. Only needed at the end of the routine. */
  switch (string_type & OUTPUT_TYPE_MASK)
  {
    case P_STRING:
      long_curlen = va_arg (p, int *);
      break;
    case P_SHORT_STRING:
      short_curlen = va_arg (p, char *);
      break;
    case P_FIXED_STRING:
    case P_CSTRING:
      break;
    default:
      _p_internal_error (906); /* unknown string code in `WriteStr' */
  }

  Capacity = va_arg (p, int);
  /* If it's a CString, reserve space for the #0 terminator */
  if ((string_type & OUTPUT_TYPE_MASK) == P_CSTRING)
    if (--Capacity < 0)
      _p_internal_error (907); /* string length cannot be negative */

  Flags1 = READ_WRITE_STRING_MASK | (string_type & TRUNCATE_STRING_MASK);
  _p_writestr_init (File, s1, Capacity, Flags1);

  count = va_arg (p, int);
  while (count--)
    {
      int Flags = va_arg (p, int);
      /* cf. the comment in _p_write(), but note Flags1 */
      File->Flags = Flags1 | Flags;

      switch (Flags & OUTPUT_TYPE_MASK)
      {
        WRITE_VARIOUS_TYPES
        default:
          _p_internal_error (905); /* unknown code in `WriteStr' */
      }
    }
  va_end (p);

  Length = _p_writestr_getlength (File);

  /* Set the current string length */
  /* The following is roughly the code for an "AnyString SetLength" */
  switch (string_type & OUTPUT_TYPE_MASK)
  {
    case P_STRING:
      *long_curlen = Length;
      break;
    case P_SHORT_STRING:
      *short_curlen = Length;
      break;
    case P_FIXED_STRING:
      while (Length < Capacity)
        s1 [Length++] = ' ';
      break;
    case P_CSTRING:
      s1 [Length] = 0;
      break;
  }
}
