p2clib.c

把pascal程序转成C语言程序 把pascal程序转成C语言程序

/* Run-time library for use with "p2c", the Pascal to C translator */

/* "p2c"  Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation.
 * By Dave Gillespie, [e-mail].  Version --VERSION--.
 * This file may be copied, modified, etc. in any way.  It is not restricted
 * by the licence agreement accompanying p2c itself.
 */



#include "p2c.h"


#ifndef NO_TIME
# include <time.h>
#endif


#define Isspace(c)  isspace(c)      /* or "((c) == ' ')" if preferred */




int P_argc;
char **P_argv;

short P_escapecode;
int P_ioresult;

long EXCP_LINE;    /* Used by Pascal workstation system */

Anyptr __MallocTemp__;

__p2c_jmp_buf *__top_jb;




void PASCAL_MAIN(argc, argv)
int argc;
char **argv;
{
    P_argc = argc;
    P_argv = argv;
    __top_jb = NULL;

#ifdef LOCAL_INIT
    LOCAL_INIT();
#endif
}





/* In case your system lacks these... */

long my_labs(x)
long x;
{
    return((x > 0) ? x : -x);
}


#ifdef __STDC__
Anyptr my_memmove(Anyptr d, Const Anyptr s, size_t n)
#else
Anyptr my_memmove(d, s, n)
Anyptr d, s;
register int n;
#endif
{
    register char *dd = (char *)d, *ss = (char *)s;
    if (dd < ss || dd - ss >= n) {
#if defined(bcopy) && defined(memcpy)
        my_memcpy(dd, ss, n);
#else
	memcpy(dd, ss, n);
#endif
    } else if (n > 0) {
	dd += n;
	ss += n;
	while (n-- > 0)
	    *--dd = *--ss;
    }
    return d;
}


#ifdef __STDC__
Anyptr my_memcpy(Anyptr d, Const Anyptr s, size_t n)
#else
Anyptr my_memcpy(d, s, n)
Anyptr d, s;
register int n;
#endif
{
    register char *ss = (char *)s, *dd = (char *)d;
    while (n-- > 0)
	*dd++ = *ss++;
    return d;
}

#ifdef __STDC__
int my_memcmp(Const Anyptr s1, Const Anyptr s2, size_t n)
#else
int my_memcmp(s1, s2, n)
Anyptr s1, s2;
register int n;
#endif
{
    register char *a = (char *)s1, *b = (char *)s2;
    register int i;
    while (n-- > 0)
	if ((i = (*a++) - (*b++)) != 0)
	    return i;
    return 0;
}

#ifdef __STDC__
Anyptr my_memset(Anyptr d, int c, size_t n)
#else
Anyptr my_memset(d, c, n)
Anyptr d;
register int c;
register int n;
#endif
{
    register char *dd = (char *)d;
    while (n-- > 0)
	*dd++ = c;
    return d;
}


int my_toupper(c)
int c;
{
    if (islower(c))
	return _toupper(c);
    else
	return c;
}


int my_tolower(c)
int c;
{
    if (isupper(c))
	return _tolower(c);
    else
	return c;
}




long ipow(a, b)
long a, b;
{
    long v;

    if (a == 0 || a == 1)
	return a;
    if (a == -1)
	return (b & 1) ? -1 : 1;
    if (b < 0)
	return 0;
    if (a == 2)
	return 1L << b;
    v = (b & 1) ? a : 1;
    while ((b >>= 1) > 0) {
	a *= a;
	if (b & 1)
	    v *= a;
    }
    return v;
}


long P_imax(a, b)
long a, b;
{
    if (a > b)
	return a;
    else
	return b;
}

long P_imin(a, b)
long a, b;
{
    if (a < b)
	return a;
    else
	return b;
}


double P_rmax(a, b)
double a, b;
{
    if (a > b)
	return a;
    else
	return b;
}

double P_rmin(a, b)
double a, b;
{
    if (a < b)
	return a;
    else
	return b;
}




/* Common string functions: */

/* Store in "ret" the substring of length "len" starting from "pos" (1-based).
   Store a shorter or null string if out-of-range.  Return "ret". */

char *strsub(ret, s, pos, len)
register char *ret, *s;
register int pos, len;
{
    register char *s2;

    if (--pos < 0 || len <= 0) {
        *ret = 0;
        return ret;
    }
    while (pos > 0) {
        if (!*s++) {
            *ret = 0;
            return ret;
        }
        pos--;
    }
    s2 = ret;
    while (--len >= 0) {
        if (!(*s2++ = *s++))
            return ret;
    }
    *s2 = 0;
    return ret;
}


/* Return the index of the first occurrence of "pat" as a substring of "s",
   starting at index "pos" (1-based).  Result is 1-based, 0 if not found. */

int strpos2(s, pat, pos)
char *s;
register char *pat;
register int pos;
{
    register char *cp, ch;
    register int slen;

    if (--pos < 0)
        return 0;
    slen = strlen(s) - pos;
    cp = s + pos;
    if (!(ch = *pat++))
        return 0;
    pos = strlen(pat);
    slen -= pos;
    while (--slen >= 0) {
        if (*cp++ == ch && !strncmp(cp, pat, pos))
            return cp - s;
    }
    return 0;
}


/* Case-insensitive version of strcmp. */

int strcicmp(s1, s2)
register char *s1, *s2;
{
    register unsigned char c1, c2;

    while (*s1) {
	if (*s1++ != *s2++) {
	    if (!s2[-1])
		return 1;
	    c1 = toupper(s1[-1]);
	    c2 = toupper(s2[-1]);
	    if (c1 != c2)
		return c1 - c2;
	}
    }
    if (*s2)
	return -1;
    return 0;
}




/* HP and Turbo Pascal string functions: */

/* Trim blanks at left end of string. */

char *strltrim(s)
register char *s;
{
    while (Isspace(*s++)) ;
    return s - 1;
}


/* Trim blanks at right end of string. */

char *strrtrim(s)
register char *s;
{
    register char *s2 = s;

    if (!*s)
	return s;
    while (*++s2) ;
    while (s2 > s && Isspace(*--s2))
        *s2 = 0;
    return s;
}


/* Store in "ret" "num" copies of string "s".  Return "ret". */

char *strrpt(ret, s, num)
char *ret;
register char *s;
register int num;
{
    register char *s2 = ret;
    register char *s1;

    while (--num >= 0) {
        s1 = s;
        while ((*s2++ = *s1++)) ;
        s2--;
    }
    return ret;
}


/* Store in "ret" string "s" with enough pad chars added to reach "size". */

char *strpad(ret, s, padchar, num)
char *ret;
register char *s;
register int padchar, num;
{
    register char *d = ret;

    if (s == d) {
	while (*d++) ;
    } else {
	while ((*d++ = *s++)) ;
    }
    num -= (--d - ret);
    while (--num >= 0)
	*d++ = padchar;
    *d = 0;
    return ret;
}


/* Copy the substring of length "len" from index "spos" of "s" (1-based)
   to index "dpos" of "d", lengthening "d" if necessary.  Length and
   indices must be in-range. */

void strmove(len, s, spos, d, dpos)
register char *s, *d;
register int len, spos, dpos;
{
    s += spos - 1;
    d += dpos - 1;
    while (*d && --len >= 0)
	*d++ = *s++;
    if (len > 0) {
	while (--len >= 0)
	    *d++ = *s++;
	*d = 0;
    }
}


/* Delete the substring of length "len" at index "pos" from "s".
   Delete less if out-of-range. */

void strdelete(s, pos, len)
register char *s;
register int pos, len;
{
    register int slen;

    if (--pos < 0)
        return;
    slen = strlen(s) - pos;
    if (slen <= 0)
        return;
    s += pos;
    if (slen <= len) {
        *s = 0;
        return;
    }
    while ((*s = s[len])) s++;
}


/* Insert string "src" at index "pos" of "dst". */

void strinsert(src, dst, pos)
register char *src, *dst;
register int pos;
{
    register int slen, dlen;

    if (--pos < 0)
        return;
    dlen = strlen(dst);
    dst += dlen;
    dlen -= pos;
    if (dlen <= 0) {
        strcpy(dst, src);
        return;
    }
    slen = strlen(src);
    do {
        dst[slen] = *dst;
        --dst;
    } while (--dlen >= 0);
    dst++;
    while (--slen >= 0)
        *dst++ = *src++;
}




/* File functions */

/* Peek at next character of input stream; return EOF at end-of-file. */

int P_peek(f)
FILE *f;
{
    int ch;

    ch = getc(f);
    if (ch == EOF)
	return EOF;
    ungetc(ch, f);
    return (ch == '\n') ? ' ' : ch;
}


/* Check if at end of file, using Pascal "eof" semantics.  End-of-file for
   stdin is broken; remove the special case for it to be broken in a
   different way. */

int P_eof(f)
FILE *f;
{
    register int ch;

    if (feof(f))
	return 1;
#ifdef HAVE_ISATTY
    if (isatty(fileno(f)))
#else
    if (f == stdin)
#endif
	return 0;    /* not safe to look-ahead on the keyboard! */
    ch = getc(f);
    if (ch == EOF)
	return 1;
    ungetc(ch, f);
    return 0;
}


/* Check if at end of line (or end of entire file). */

int P_eoln(f)
FILE *f;
{
    register int ch;

    ch = getc(f);
    if (ch == EOF)
        return 1;
    ungetc(ch, f);
    return (ch == '\n');
}


/* Skip whitespace (including newlines) in a file. */

FILE *_skipnlspaces(f)
FILE *f;
{
  register int ch;

  do {
    ch = getc(f);
  } while (ch == ' ' || ch == '\t' || ch == '\n');
  if (ch != EOF)
    ungetc(ch, f);
  return f;
}


/* Skip whitespace (not including newlines) in a file. */

FILE *_skipspaces(f)
FILE *f;
{
  register int ch;

  do {
    ch = getc(f);
  } while (ch == ' ' || ch == '\t');
  if (ch != EOF)
    ungetc(ch, f);
  return f;
}


/* Read a packed array of characters from a file. */

Void P_readpaoc(f, s, len)
FILE *f;
char *s;
int len;
{
    int ch;

    for (;;) {
	if (len <= 0)
	    return;
	ch = getc(f);
	if (ch == EOF || ch == '\n')
	    break;
	*s++ = ch;
	--len;
    }
    while (--len >= 0)
	*s++ = ' ';
    if (ch != EOF)
	ungetc(ch, f);
}