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

   This file is part of GNU Pascal Library.

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: Juki <jtv@hut.fi>
 *          Frank Heckenbach <frank@pascal.gnu.de>
 */

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

/* Generic string function */
int
_p_string (va_alist)
va_dcl
{
    register va_list p;

    char *s1, *s2 = (char *)NULL;
    int  len1, len2 = 0;
    char c1, c2;

    int code;
    int argument_mask;
    int retval = 0;

    va_start (p);
    code = va_arg (p, int); /* First arg is the opcode */

    argument_mask = va_arg (p, int); /* mask of argument types */
    /* First arg is always a string or char */
    if (argument_mask & P_STR_FIRST_IS_CHAR)
      {
        c1   = va_arg (p, int);
        s1   = &c1;
        len1 = 1;
      }
    else
      {
        /* It's a string */
        s1   = va_arg (p, char *);
        len1 = va_arg (p, int);
      }

    if (code == R_TRIM)
      {
        char *dest = va_arg (p, char *);
        int *dlen  = va_arg (p, int *);

        int inx = _p_trim (s1, len1, dest);
        if (dlen)
          *dlen = inx;

        /* return value not used */
        va_end (p);
        return 0;
      }

    if (code == R_COPY || code == R_SUBSTR)
      {
        char *dest = va_arg (p, char *);
        int *dlen  = va_arg (p, int *);
        int from   = va_arg (p, int);
        int length = va_arg (p, int);

        int curlen = _p_substr (s1, len1, from, length, dest, code == R_COPY);

        if (dlen)
          *dlen = curlen;

        /* return value not used */
        va_end (p);
        return 0;
      }

    /* two string args, either may be a string or char */
    if (argument_mask & P_STR_SECOND_IS_CHAR)
      {
        c2   = va_arg (p, int);
        s2   = &c2;
        len2 = 1;
      }
    else
      {
        /* It's a string */
        s2   = va_arg (p, char *);
        len2 = va_arg (p, int);
      }

    switch (code) {
      case R_EQ:
        retval =  _p_eq (s1, len1, s2, len2); break;
      case R_LT:
        retval =  _p_lt (s1, len1, s2, len2); break;
      case R_GT:
        retval = !_p_lt (s2, len2, s1, len1); break;
      case R_NE:
        retval = !_p_eq (s1, len1, s2, len2); break;
      case R_LE:
        retval =  _p_lt (s2, len2, s1, len1); break;
      case R_GE:
        retval = !_p_lt (s1, len1, s2, len2); break;
      case R_eq:
        retval =  _p_str_eq (s1, len1, s2, len2); break;
      case R_lt:
        retval =  _p_str_lt (s1, len1, s2, len2); break;
      case R_ge:
        retval = !_p_str_lt (s1, len1, s2, len2); break;
      case R_ne:
        retval = !_p_str_eq (s1, len1, s2, len2); break;
      case R_le:
        retval = !_p_str_lt (s2, len2, s1, len1); break;
      case R_gt:
        retval =  _p_str_lt (s2, len2, s1, len1); break;
      case R_INDEX:
        retval =  _p_index (s1, len1, s2, len2);  break;
      default:
        _p_internal_error (909); /* unknown string function called */
    };
    va_end (p);
    return retval;
}
