wp2latex (3 of 4)
Glenn Geers
glenn at extro.ucc.su.oz.au
Wed Aug 8 21:51:30 AEST 1990
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
# MANIFEST
# Makefile
# README.C
# nl.sty
# p2c.h
# p2clib.c
# This archive created: Wed Aug 8 21:47:12 1990
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'MANIFEST'" '(513 characters)'
if test -f 'MANIFEST'
then
echo shar: "will not over-write existing file 'MANIFEST'"
else
sed 's/^ X//' << \SHAR_EOF > 'MANIFEST'
XThis shar archive contains:
XMANIFEST - this file
XMakefile - makefile for wp2latex
XREADME.C - C specific stuff
Xnl.sty - Dutch style file
Xp2c.h - header file (part of p2c)
Xp2clib.c - C source of Pascal support library (part of p2c)
Xwp2latex.c - C source code
Xwp2latex.doc - English language doc
Xwp2latex.msg - original cover note
Xwp2latex.pas - original Pascal source code
Xwp2latex.sty - needed style file
Xwp2latex.tex - documentation in Dutch
Xwp2leng.tex - documentation in English
SHAR_EOF
if test 513 -ne "`wc -c < 'MANIFEST'`"
then
echo shar: "error transmitting 'MANIFEST'" '(should have been 513 characters)'
fi
fi
echo shar: "extracting 'Makefile'" '(671 characters)'
if test -f 'Makefile'
then
echo shar: "will not over-write existing file 'Makefile'"
else
sed 's/^ X//' << \SHAR_EOF > 'Makefile'
X# Makefile for wp2latex
X
XCC = cc
X
XPROG = wp2latex
XPROGSRC = wp2latex.c
XPROGOBJ = wp2latex.o
X
X# Select the one appropriate to your setup
X# remember to remove the -DHAVE_P2C if p2c is not installed
X#CFLAGS = -O -fstrength-reduce -DHAVE_P2C
X# generic UNIX cc
XCFLAGS = -O
X# Xenix cross-compiling to DOS
X#CFLAGS = -dos -M2le -Ox -CSON -F 3000 -DHAVE_P2C
X
X# library selection
X# select p2clib.o if you have deleted HAVE_P2C above
X#LIB1 = -lp2c
XLIB1 = p2clib.o
XLIBS = $(LIB1) -lm
X
X# ld flags
X# Xenix cross-compiling to DOS
X#LFLAGS = -dos
X# SUN's
XLFLAGS =
X
X$(PROG) : $(PROGOBJ) $(LIB1)
X $(CC) $(LFLAGS) -o $(PROG) $(PROGOBJ) $(LIBS)
X
Xclean:
X rm -f $(PROGOBJ) $(LIB1) $(PROG) core
SHAR_EOF
if test 671 -ne "`wc -c < 'Makefile'`"
then
echo shar: "error transmitting 'Makefile'" '(should have been 671 characters)'
fi
fi
echo shar: "extracting 'README.C'" '(771 characters)'
if test -f 'README.C'
then
echo shar: "will not over-write existing file 'README.C'"
else
sed 's/^ X//' << \SHAR_EOF > 'README.C'
XI have tested wp2latex (C version) using the following OS/compiler
Xcombinations:
X1. 386 Xenix 2.3.2/cc & gcc
X2. DOS/Xenix cc -dos & MSC 5.1
X3. SunOS 4.0.3 & 4.1(SPARC)/cc
X
XThe DOS versions require a large model compilation and a stack size of
X0x3000 in order to run.
X
XThe SUN version runs exceedingly slowly. I don't know why. (By slow I mean
Xa 4.77MHz XT is *faster*) I have profiled the code and seems to be spending
Xa lot of time in lseek. Any ideas would be welcome. I've sorted this out.
XSun machines are catered for automatically.
X
XDefine HAVE_P2C in the Makefile and correct the libraries required if you
Xhave p2c 1.14 or higher installed.
X
X
XPlease note: This version differs slightly from that on ymir.
X
X Share and enjoy,
X Glenn
X
Xglenn at qed.physics.su.oz.au
SHAR_EOF
if test 771 -ne "`wc -c < 'README.C'`"
then
echo shar: "error transmitting 'README.C'" '(should have been 771 characters)'
fi
fi
echo shar: "extracting 'nl.sty'" '(4508 characters)'
if test -f 'nl.sty'
then
echo shar: "will not over-write existing file 'nl.sty'"
else
sed 's/^ X//' << \SHAR_EOF > 'nl.sty'
X% Met ========== onderstreept nederlandse teksten
X\@ifundefined{chapter}
X{%%%%%%%%%%%%%%% dit is voor article style %%%%%%%%%%%%%%%%%%%%%
X\def\@part[#1]#2{\ifnum \c at secnumdepth >\m at ne \refstepcounter{part}
X\addcontentsline{toc}{part}{\thepart \hspace{1em}#1}\else
X\addcontentsline{toc}{part}{#1}\fi { \parindent 0pt \raggedright
X \ifnum \c at secnumdepth >\m at ne \Large \bf Deel \thepart \par \nobreak \fi \huge
X% ====
X\bf #2\markboth{}{}\par } \nobreak \vskip 3ex \@afterheading }
X\def\tableofcontents{\section*{Inhoud\markboth{INHOUD}{INHOUD}}
X% ====== ====== ======
X \@starttoc{toc}}
X\def\listoffigures{\section*{Lijst van figuren\markboth
X% ==================
X {LIJST VAN FIGUREN}{LIJST VAN FIGUREN}}\@starttoc{lof}}
X% ================= =================
X\def\listoftables{\section*{Lijst van tabellen\markboth
X% ==================
X {LIJST VAN TABELLEN}{LIJST VAN TABELLEN}}\@starttoc{lot}}
X% ================== ==================
X\def\thebibliography#1{\section*{Referenties\markboth
X% ===========
X {REFERENTIES}{REFERENTIES}}\list
X% =========== ===========
X {[\arabic{enumi}]}{\settowidth\labelwidth{[#1]}\leftmargin\labelwidth
X \advance\leftmargin\labelsep
X \usecounter{enumi}}
X \def\newblock{\hskip .11em plus .33em minus -.07em}
X \sloppy
X \sfcode`\.=1000\relax}
X\def\theindex{\@restonecoltrue\if at twocolumn\@restonecolfalse\fi
X\columnseprule \z@
X\columnsep 35pt\twocolumn[\section*{Index}]
X% =====
X \markboth{INDEX}{INDEX}\thispagestyle{plain}\parindent\z@
X% ===== =====
X \parskip\z@ plus .3pt\relax\let\item\@idxitem}
X\def\abstract{\if at twocolumn
X\section*{Samenvatting}
X% ============
X\else \small
X\begin{center}
X{\bf Samenvatting\vspace{-.5em}\vspace{0pt}}
X% ============
X\end{center}
X\quotation
X\fi}}
X{%%%%%%%%%%%%%% Dit is voor report en book style %%%%%%%%%%%%%%%
X\def\@part[#1]#2{\ifnum \c at secnumdepth >-2\relax \refstepcounter{part}
X\addcontentsline{toc}{part}{\thepart \hspace{1em}#1}\else
X\addcontentsline{toc}{part}{#1}\fi \markboth{}{}
X \ifnum \c at secnumdepth >-2\relax \huge\bf Deel \thepart \par \vskip 20pt \fi
X% ====
X\Huge \bf #1\@endpart}
X\def\@chapapp{Hoofdstuk}
X% =========
X\def\appendix{\par
X \setcounter{chapter}{0}
X \setcounter{section}{0}
X \def\@chapapp{Appendix}
X% ========
X \def\thechapter{\Alph{chapter}}}
X\def\tableofcontents{\@restonecolfalse\if at twocolumn\@restonecoltrue\onecolumn
X \fi\chapter*{Inhoud\@mkboth{INHOUD}{INHOUD}}
X% ====== ====== ======
X \@starttoc{toc}\if at restonecol\twocolumn\fi}
X\def\listoffigures{\@restonecolfalse\if at twocolumn\@restonecoltrue\onecolumn
X \fi\chapter*{Lijst van figuren\@mkboth
X% =================
X {LIJST VAN FIGUREN}{LIJST VAN FIGUREN}}\@starttoc{lof}\if at restonecol\twocolumn
X% ================= =================
X \fi}
X\def\listoftables{\@restonecolfalse\if at twocolumn\@restonecoltrue\onecolumn
X \fi\chapter*{Lijst van tabellen\@mkboth
X% ==================
X {LIJST VAN TABELLEN}{LIJST VAN TABELLEN}}\@starttoc{lot}\if at restonecol
X% ================== ==================
X \twocolumn\fi}
X\def\thebibliography#1{\chapter*{Referenties\@mkboth
X% ===========
X {REFERENTIES}{REFERENTIES}}\list
X% ============ ============
X {[\arabic{enumi}]}{\settowidth\labelwidth{[#1]}\leftmargin\labelwidth
X \advance\leftmargin\labelsep
X \usecounter{enumi}}
X \def\newblock{\hskip .11em plus .33em minus -.07em}
X \sloppy
X \sfcode`\.=1000\relax}
X\def\theindex{\@restonecoltrue\if at twocolumn\@restonecolfalse\fi
X\columnseprule \z@
X\columnsep 35pt\twocolumn[\@makeschapterhead{Index}]
X% =====
X \@mkboth{INDEX}{INDEX}\thispagestyle{plain}\parindent\z@
X% ===== =====
X \parskip\z@ plus .3pt\relax\let\item\@idxitem}
X\def\abstract{\titlepage
X\null\vfil
X\begin{center}
X{\bf Samenvatting}
X% ============
X\end{center}}
X}
X%%%%%%%%%%%%%%%%%%% dit is voor allebei %%%%%%%%%%%%%%%%%%%%%%%%%%
X\def\today{\number\day\space\ifcase\month%
X\or jan\or feb\or maart\or apr\or mei\or juni%
X% === === ===== === === ====
X\or juli\or aug\or sept\or okt\or nov\or dec\fi
X% ==== === ==== === === ===
X\space\number\year}
X\def\fnum at figure{Figuur \thefigure}
X% ======
X\def\fnum at table{Tabel \thetable}
X% =====
SHAR_EOF
if test 4508 -ne "`wc -c < 'nl.sty'`"
then
echo shar: "error transmitting 'nl.sty'" '(should have been 4508 characters)'
fi
fi
echo shar: "extracting 'p2c.h'" '(11337 characters)'
if test -f 'p2c.h'
then
echo shar: "will not over-write existing file 'p2c.h'"
else
sed 's/^ X//' << \SHAR_EOF > 'p2c.h'
X#ifndef P2C_H
X#define P2C_H
X
X
X/* Header file for code generated by "p2c", the Pascal-to-C translator */
X
X/* "p2c" Copyright (C) 1989 Dave Gillespie, version 1.18.
X * This file may be copied, modified, etc. in any way. It is not restricted
X * by the licence agreement accompanying p2c itself.
X */
X
X
X#include <stdio.h>
X
X
X
X/* If the following heuristic fails, compile -DBSD=0 for non-BSD systems,
X or -DBSD=1 for BSD systems. */
X
X#ifdef M_XENIX
X# undef BSD
X#endif
X
X#ifdef FILE /* a #define in BSD, a typedef in SYSV (hp-ux, at least) */
X# ifndef BSD /* (a convenient, but horrible kludge!) */
X# define BSD 1
X# endif
X#endif
X
X#ifdef BSD
X# if !BSD
X# undef BSD
X# endif
X#endif
X
X
X#ifdef __STDC__
X# include <stddef.h>
X# include <stdlib.h>
X# define HAS_STDLIB
X# define __CAT__(a,b)a##b
X#else
X# ifndef BSD
X# include <memory.h>
X# endif
X# include <sys/types.h>
X# define __ID__(a)a
X# define __CAT__(a,b)__ID__(a)b
X#endif
X
X
X#ifdef BSD
X# include <strings.h>
X# define memcpy(a,b,n) (bcopy(b,a,n),a)
X# define memcmp(a,b,n) bcmp(a,b,n)
X/*
X# define strchr(s,c) index(s,c)
X# define strrchr(s,c) rindex(s,c)
X*/
X#else
X# include <string.h>
X#endif
X
X#include <ctype.h>
X#include <math.h>
X#include <setjmp.h>
X#include <assert.h>
X
X
Xtypedef struct __p2c_jmp_buf {
X struct __p2c_jmp_buf *next;
X jmp_buf jbuf;
X} __p2c_jmp_buf;
X
X
X/* Warning: The following will not work if setjmp is used simultaneously.
X This also violates the ANSI restriction about using vars after longjmp,
X but a typical implementation of longjmp will get it right anyway. */
X
X#ifndef FAKE_TRY
X# define TRY(x) do { __p2c_jmp_buf __try_jb; \
X __try_jb.next = __top_jb; \
X if (!setjmp((__top_jb = &__try_jb)->jbuf)) {
X# define RECOVER(x) __top_jb = __try_jb.next; } else {
X# define RECOVER2(x,L) __top_jb = __try_jb.next; } else { \
X if (0) { L: __top_jb = __try_jb.next; }
X# define ENDTRY(x) } } while (0)
X#else
X# define TRY(x) if (1) {
X# define RECOVER(x) } else do {
X# define RECOVER2(x,L) } else do { L: ;
X# define ENDTRY(x) } while (0)
X#endif
X
X
X
X#ifdef M_XENIX /* avoid compiler bug */
X# define SHORT_MAX (32767)
X# define SHORT_MIN (-32768)
X#endif
X
X
X/* The following definitions work only on twos-complement machines */
X#ifndef SHORT_MAX
X# define SHORT_MAX (((unsigned short) -1) >> 1)
X# define SHORT_MIN (~SHORT_MAX)
X#endif
X
X#ifndef INT_MAX
X# define INT_MAX (((unsigned int) -1) >> 1)
X# define INT_MIN (~INT_MAX)
X#endif
X
X#ifndef LONG_MAX
X# define LONG_MAX (((unsigned long) -1) >> 1)
X# define LONG_MIN (~LONG_MAX)
X#endif
X
X#ifndef SEEK_SET
X# define SEEK_SET 0
X# define SEEK_CUR 1
X# define SEEK_END 2
X#endif
X
X#ifndef EXIT_SUCCESS
X# define EXIT_SUCCESS 0
X# define EXIT_FAILURE 1
X#endif
X
X
X#define SETBITS 32
X
X
X#ifdef __STDC__
X# define Signed signed
X# define Void void /* Void f() = procedure */
X# ifndef Const
X# define Const const
X# endif
X# ifndef Volatile
X# define Volatile volatile
X# endif
X# define PP(x) x /* function prototype */
X# define PV() (void) /* null function prototype */
Xtypedef void *Anyptr;
X#else
X# define Signed
X# define Void void
X# ifndef Const
X# define Const
X# endif
X# ifndef Volatile
X# define Volatile
X# endif
X# define PP(x) ()
X# define PV() ()
Xtypedef char *Anyptr;
X#endif
X
X#ifdef __GNUC__
X# define Inline inline
X#else
X# define Inline
X#endif
X
X#define Register register /* Register variables */
X#define Char char /* Characters (not bytes) */
X
X#ifndef Static
X# define Static static /* Private global funcs and vars */
X#endif
X
X#ifndef Local
X# define Local static /* Nested functions */
X#endif
X
Xtypedef Signed char schar;
Xtypedef unsigned char uchar;
Xtypedef unsigned char boolean;
X
X#ifndef true
X# define true 1
X# define false 0
X#endif
X
X
Xtypedef struct {
X Anyptr proc, link;
X} _PROCEDURE;
X
X#ifndef _FNSIZE
X# define _FNSIZE 120
X#endif
X
X
Xextern Void PASCAL_MAIN PP( (int, Char **) );
Xextern Char **P_argv;
Xextern int P_argc;
Xextern short P_escapecode;
Xextern int P_ioresult;
Xextern __p2c_jmp_buf *__top_jb;
X
X
X#ifdef P2C_H_PROTO /* if you have Ansi C but non-prototyped header files */
Xextern Char *strcat PP( (Char *, Const Char *) );
Xextern Char *strchr PP( (Const Char *, int) );
Xextern int strcmp PP( (Const Char *, Const Char *) );
Xextern Char *strcpy PP( (Char *, Const Char *) );
Xextern size_t strlen PP( (Const Char *) );
Xextern Char *strncat PP( (Char *, Const Char *, size_t) );
Xextern int strncmp PP( (Const Char *, Const Char *, size_t) );
Xextern Char *strncpy PP( (Char *, Const Char *, size_t) );
Xextern Char *strrchr PP( (Const Char *, int) );
X
Xextern Anyptr memchr PP( (Const Anyptr, int, size_t) );
Xextern Anyptr memmove PP( (Anyptr, Const Anyptr, size_t) );
Xextern Anyptr memset PP( (Anyptr, int, size_t) );
X#ifndef memcpy
Xextern Anyptr memcpy PP( (Anyptr, Const Anyptr, size_t) );
Xextern int memcmp PP( (Const Anyptr, Const Anyptr, size_t) );
X#endif
X
Xextern int atoi PP( (Const Char *) );
Xextern double atof PP( (Const Char *) );
Xextern long atol PP( (Const Char *) );
Xextern double strtod PP( (Const Char *, Char **) );
Xextern long strtol PP( (Const Char *, Char **, int) );
X#endif /*P2C_H_PROTO*/
X
X#ifndef HAS_STDLIB
Xextern Anyptr malloc PP( (size_t) );
Xextern Void free PP( (Anyptr) );
X#endif
X
Xextern int _OutMem PV();
Xextern int _CaseCheck PV();
Xextern int _NilCheck PV();
Xextern int _Escape PP( (int) );
Xextern int _EscIO PP( (int) );
X
Xextern long ipow PP( (long, long) );
Xextern Char *strsub PP( (Char *, Char *, int, int) );
Xextern Char *strltrim PP( (Char *) );
Xextern Char *strrtrim PP( (Char *) );
Xextern Char *strrpt PP( (Char *, Char *, int) );
Xextern Char *strpad PP( (Char *, Char *, int, int) );
Xextern int strpos2 PP( (Char *, Char *, int) );
Xextern long memavail PV();
Xextern int P_peek PP( (FILE *) );
Xextern int P_eof PP( (FILE *) );
Xextern int P_eoln PP( (FILE *) );
Xextern Void P_readpaoc PP( (FILE *, Char *, int) );
Xextern Void P_readlnpaoc PP( (FILE *, Char *, int) );
Xextern long P_maxpos PP( (FILE *) );
Xextern Char *P_trimname PP( (Char *, int) );
Xextern long *P_setunion PP( (long *, long *, long *) );
Xextern long *P_setint PP( (long *, long *, long *) );
Xextern long *P_setdiff PP( (long *, long *, long *) );
Xextern long *P_setxor PP( (long *, long *, long *) );
Xextern int P_inset PP( (unsigned, long *) );
Xextern int P_setequal PP( (long *, long *) );
Xextern int P_subset PP( (long *, long *) );
Xextern long *P_addset PP( (long *, unsigned) );
Xextern long *P_addsetr PP( (long *, unsigned, unsigned) );
Xextern long *P_remset PP( (long *, unsigned) );
Xextern long *P_setcpy PP( (long *, long *) );
Xextern long *P_expset PP( (long *, long) );
Xextern long P_packset PP( (long *) );
Xextern int P_getcmdline PP( (int l, int h, Char *line) );
Xextern Void TimeStamp PP( (int *Day, int *Month, int *Year,
X int *Hour, int *Min, int *Sec) );
Xextern Void P_sun_argv PP( (char *, int, int) );
X
X
X/* I/O error handling */
X#define _CHKIO(cond,ior,val,def) ((cond) ? P_ioresult=0,(val) \
X : P_ioresult=(ior),(def))
X#define _SETIO(cond,ior) (P_ioresult = (cond) ? 0 : (ior))
X
X/* Following defines are suitable for the HP Pascal operating system */
X#define FileNotFound 10
X#define FileNotOpen 13
X#define FileWriteError 38
X#define BadInputFormat 14
X#define EndOfFile 30
X
X/* Creating temporary files */
X#if (defined(BSD) || defined(NO_TMPFILE)) && !defined(HAVE_TMPFILE)
X# define tmpfile() (fopen(tmpnam(NULL), "w+"))
X#endif
X
X/* File buffers */
X#define FILEBUF(f,sc,type) sc int __CAT__(f,_BFLAGS); \
X sc type __CAT__(f,_BUFFER)
X
X#define RESETBUF(f,type) (__CAT__(f,_BFLAGS) = 1)
X#define SETUPBUF(f,type) (__CAT__(f,_BFLAGS) = 0)
X
X#define GETFBUF(f,type) (*((__CAT__(f,_BFLAGS) == 1 && \
X ((__CAT__(f,_BFLAGS) = 2), \
X fread(&__CAT__(f,_BUFFER), \
X sizeof(type),1,(f)))),\
X &__CAT__(f,_BUFFER)))
X#define AGETFBUF(f,type) ((__CAT__(f,_BFLAGS) == 1 && \
X ((__CAT__(f,_BFLAGS) = 2), \
X fread(&__CAT__(f,_BUFFER), \
X sizeof(type),1,(f)))),\
X __CAT__(f,_BUFFER))
X
X#define PUTFBUF(f,type,v) (GETFBUF(f,type) = (v))
X#define CPUTFBUF(f,v) (PUTFBUF(f,char,v))
X#define APUTFBUF(f,type,v) (memcpy(GETFBUF(f,type), (v), \
X sizeof(__CAT__(f,_BUFFER))))
X
X#define GET(f,type) (__CAT__(f,_BFLAGS) == 1 ? \
X fread(&__CAT__(f,_BUFFER),sizeof(type),1,(f)) : \
X (__CAT__(f,_BFLAGS) = 1))
X
X#define PUT(f,type) (fwrite(&__CAT__(f,_BUFFER),sizeof(type),1,(f)), \
X (__CAT__(f,_BFLAGS) = 0))
X#define CPUT(f) (PUT(f,char))
X
X#define BUFEOF(f) (__CAT__(f,_BFLAGS) != 2 && P_eof(f))
X#define BUFFPOS(f) (ftell(f) - (__CAT__(f,_BFLAGS) == 2))
X
Xtypedef struct {
X FILE *f;
X FILEBUF(f,,Char);
X Char name[_FNSIZE];
X} _TEXT;
X
X/* Memory allocation */
X#ifdef __GCC__
X# define Malloc(n) (malloc(n) ?: (Anyptr)_OutMem())
X#else
Xextern Anyptr __MallocTemp__;
X# define Malloc(n) ((__MallocTemp__ = malloc(n)) ? __MallocTemp__ : (Anyptr)_OutMem())
X#endif
X#define FreeR(p) (free((Anyptr)(p))) /* used if arg is an rvalue */
X#define Free(p) (free((Anyptr)(p)), (p)=NULL)
X
X/* sign extension */
X#define SEXT(x,n) ((x) | -(((x) & (1L<<((n)-1))) << 1))
X
X/* packed arrays */ /* BEWARE: these are untested! */
X#define P_getbits_UB(a,i,n,L) ((int)((a)[(i)>>(L)-(n)] >> \
X (((~(i))&((1<<(L)-(n))-1)) << (n)) & \
X (1<<(1<<(n)))-1))
X
X#define P_getbits_SB(a,i,n,L) ((int)((a)[(i)>>(L)-(n)] << \
X (16 - ((((~(i))&((1<<(L)-(n))-1))+1) <<\
X (n)) >> (16-(1<<(n))))))
X
X#define P_putbits_UB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |= \
X (x) << (((~(i))&((1<<(L)-(n))-1)) << (n)))
X
X#define P_putbits_SB(a,i,x,n,L) ((a)[(i)>>(L)-(n)] |= \
X ((x) & (1<<(1<<(n)))-1) << \
X (((~(i))&((1<<(L)-(n))-1)) << (n)))
X
X#define P_clrbits_B(a,i,n,L) ((a)[(i)>>(L)-(n)] &= \
X ~( ((1<<(1<<(n)))-1) << \
X (((~(i))&((1<<(L)-(n))-1)) << (n))) )
X
X/* small packed arrays */
X#define P_getbits_US(v,i,n) ((int)((v) >> ((i)<<(n)) & (1<<(1<<(n)))-1))
X#define P_getbits_SS(v,i,n) ((int)((long)(v) << (SETBITS - (((i)+1) << (n))) >> (SETBITS-(1<<(n)))))
X#define P_putbits_US(v,i,x,n) ((v) |= (x) << ((i) << (n)))
X#define P_putbits_SS(v,i,x,n) ((v) |= ((x) & (1<<(1<<(n)))-1) << ((i)<<(n)))
X#define P_clrbits_S(v,i,n) ((v) &= ~( ((1<<(1<<(n)))-1) << ((i)<<(n)) ))
X
X#define P_max(a,b) ((a) > (b) ? (a) : (b))
X#define P_min(a,b) ((a) < (b) ? (a) : (b))
X
X
X/* Fix toupper/tolower on Suns and other stupid BSD systems */
X#ifdef toupper
X# undef toupper
X# undef tolower
X# define toupper(c) my_toupper(c)
X# define tolower(c) my_tolower(c)
X#endif
X
X#ifndef _toupper
X# if 'A' == 65 && 'a' == 97
X# define _toupper(c) ((c)-'a'+'A')
X# define _tolower(c) ((c)-'A'+'a')
X# else
X# define _toupper(c) toupper(c)
X# define _tolower(c) tolower(c)
X# endif
X#endif
X
X
X#endif /* P2C_H */
X
X
X
X/* End. */
X
X
SHAR_EOF
if test 11337 -ne "`wc -c < 'p2c.h'`"
then
echo shar: "error transmitting 'p2c.h'" '(should have been 11337 characters)'
fi
fi
echo shar: "extracting 'p2clib.c'" '(16729 characters)'
if test -f 'p2clib.c'
then
echo shar: "will not over-write existing file 'p2clib.c'"
else
sed 's/^ X//' << \SHAR_EOF > 'p2clib.c'
X
X/* Run-time library for use with "p2c", the Pascal to C translator */
X
X/* "p2c" Copyright (C) 1989 Dave Gillespie.
X * This file may be copied, modified, etc. in any way. It is not restricted
X * by the licence agreement accompanying p2c itself.
X */
X
X
X
X#include "p2c.h"
X
X
X/* #define LACK_LABS */ /* Define these if necessary */
X/* #define LACK_MEMMOVE */
X
X
X#ifndef NO_TIME
X# include <time.h>
X#endif
X
X
X#define Isspace(c) isspace(c) /* or "((c) == ' ')" if preferred */
X
X
X
X
Xint P_argc;
Xchar **P_argv;
X
Xshort P_escapecode;
Xint P_ioresult;
X
Xlong EXCP_LINE; /* Used by Pascal workstation system */
X
XAnyptr __MallocTemp__;
X
X__p2c_jmp_buf *__top_jb;
X
X
X
X
Xvoid PASCAL_MAIN(argc, argv)
Xint argc;
Xchar **argv;
X{
X P_argc = argc;
X P_argv = argv;
X __top_jb = NULL;
X
X#ifdef LOCAL_INIT
X LOCAL_INIT();
X#endif
X}
X
X
X
X
X
X/* In case your system lacks these... */
X
X#ifdef LACK_LABS
Xlong labs(x)
Xlong x;
X{
X return((x > 0) ? x : -x);
X}
X#endif
X
X
X#ifdef LACK_MEMMOVE
XAnyptr memmove(d, s, n)
XAnyptr d, s;
Xregister long n;
X{
X if (d < s || d - s >= n) {
X memcpy(d, s, n);
X return d;
X } else if (n > 0) {
X register char *dd = d + n, *ss = s + n;
X while (--n >= 0)
X *--dd = *--ss;
X }
X return d;
X}
X#endif
X
X
Xint my_toupper(c)
Xint c;
X{
X if (islower(c))
X return _toupper(c);
X else
X return c;
X}
X
X
Xint my_tolower(c)
Xint c;
X{
X if (isupper(c))
X return _tolower(c);
X else
X return c;
X}
X
X
X
X
Xlong ipow(a, b)
Xlong a, b;
X{
X long v;
X
X if (a == 0 || a == 1)
X return a;
X if (a == -1)
X return (b & 1) ? -1 : 1;
X if (b < 0)
X return 0;
X if (a == 2)
X return 1 << b;
X v = (b & 1) ? a : 1;
X while ((b >>= 1) > 0) {
X a *= a;
X if (b & 1)
X v *= a;
X }
X return v;
X}
X
X
X
X
X/* Common string functions: */
X
X/* Store in "ret" the substring of length "len" starting from "pos" (1-based).
X Store a shorter or null string if out-of-range. Return "ret". */
X
Xchar *strsub(ret, s, pos, len)
Xregister char *ret, *s;
Xregister int pos, len;
X{
X register char *s2;
X
X if (--pos < 0 || len <= 0) {
X *ret = 0;
X return ret;
X }
X while (pos > 0) {
X if (!*s++) {
X *ret = 0;
X return ret;
X }
X pos--;
X }
X s2 = ret;
X while (--len >= 0) {
X if (!(*s2++ = *s++))
X return ret;
X }
X *s2 = 0;
X return ret;
X}
X
X
X/* Return the index of the first occurrence of "pat" as a substring of "s",
X starting at index "pos" (1-based). Result is 1-based, 0 if not found. */
X
Xint strpos2(s, pat, pos)
Xchar *s;
Xregister char *pat;
Xregister int pos;
X{
X register char *cp, ch;
X register int slen;
X
X if (--pos < 0)
X return 0;
X slen = strlen(s) - pos;
X cp = s + pos;
X if (!(ch = *pat++))
X return 0;
X pos = strlen(pat);
X slen -= pos;
X while (--slen >= 0) {
X if (*cp++ == ch && !strncmp(cp, pat, pos))
X return cp - s;
X }
X return 0;
X}
X
X
X/* Case-insensitive version of strcmp. */
X
Xint strcicmp(s1, s2)
Xregister char *s1, *s2;
X{
X register unsigned char c1, c2;
X
X while (*s1) {
X if (*s1++ != *s2++) {
X if (!s2[-1])
X return 1;
X c1 = toupper(s1[-1]);
X c2 = toupper(s2[-1]);
X if (c1 != c2)
X return c1 - c2;
X }
X }
X if (*s2)
X return -1;
X return 0;
X}
X
X
X
X
X/* HP and Turbo Pascal string functions: */
X
X/* Trim blanks at left end of string. */
X
Xchar *strltrim(s)
Xregister char *s;
X{
X while (Isspace(*s++)) ;
X return s - 1;
X}
X
X
X/* Trim blanks at right end of string. */
X
Xchar *strrtrim(s)
Xregister char *s;
X{
X register char *s2 = s;
X
X while (*++s2) ;
X while (s2 > s && Isspace(*--s2))
X *s2 = 0;
X return s;
X}
X
X
X/* Store in "ret" "num" copies of string "s". Return "ret". */
X
Xchar *strrpt(ret, s, num)
Xchar *ret;
Xregister char *s;
Xregister int num;
X{
X register char *s2 = ret;
X register char *s1;
X
X while (--num >= 0) {
X s1 = s;
X while ((*s2++ = *s1++)) ;
X s2--;
X }
X return ret;
X}
X
X
X/* Store in "ret" string "s" with enough pad chars added to reach "size". */
X
Xchar *strpad(ret, s, padchar, num)
Xchar *ret;
Xregister char *s;
Xregister int padchar, num;
X{
X register char *d = ret;
X
X if (s == d) {
X while (*d++) ;
X } else {
X while ((*d++ = *s++)) ;
X }
X num -= (--d - ret);
X while (--num >= 0)
X *d++ = padchar;
X *d = 0;
X return ret;
X}
X
X
X/* Copy the substring of length "len" from index "spos" of "s" (1-based)
X to index "dpos" of "d", lengthening "d" if necessary. Length and
X indices must be in-range. */
X
Xvoid strmove(len, s, spos, d, dpos)
Xregister char *s, *d;
Xregister int len, spos, dpos;
X{
X s += spos - 1;
X d += dpos - 1;
X while (*d && --len >= 0)
X *d++ = *s++;
X if (len > 0) {
X while (--len >= 0)
X *d++ = *s++;
X *d = 0;
X }
X}
X
X
X/* Delete the substring of length "len" at index "pos" from "s".
X Delete less if out-of-range. */
X
Xvoid strdelete(s, pos, len)
Xregister char *s;
Xregister int pos, len;
X{
X register int slen;
X
X if (--pos < 0)
X return;
X slen = strlen(s) - pos;
X if (slen <= 0)
X return;
X s += pos;
X if (slen <= len) {
X *s = 0;
X return;
X }
X while ((*s = s[len])) s++;
X}
X
X
X/* Insert string "src" at index "pos" of "dst". */
X
Xvoid strinsert(src, dst, pos)
Xregister char *src, *dst;
Xregister int pos;
X{
X register int slen, dlen;
X
X if (--pos < 0)
X return;
X dlen = strlen(dst);
X dst += dlen;
X dlen -= pos;
X if (dlen <= 0) {
X strcpy(dst, src);
X return;
X }
X slen = strlen(src);
X do {
X dst[slen] = *dst;
X --dst;
X } while (--dlen >= 0);
X dst++;
X while (--slen >= 0)
X *dst++ = *src++;
X}
X
X
X
X
X/* File functions */
X
X/* Peek at next character of input stream; return EOF at end-of-file. */
X
Xint P_peek(f)
XFILE *f;
X{
X int ch;
X
X ch = getc(f);
X if (ch == EOF)
X return EOF;
X ungetc(ch, f);
X return (ch == '\n') ? ' ' : ch;
X}
X
X
X/* Check if at end of file, using Pascal "eof" semantics. End-of-file for
X stdin is broken; remove the special case for it to be broken in a
X different way. */
X
Xint P_eof(f)
XFILE *f;
X{
X register int ch;
X
X if (feof(f))
X return 1;
X if (f == stdin)
X return 0; /* not safe to look-ahead on the keyboard! */
X ch = getc(f);
X if (ch == EOF)
X return 1;
X ungetc(ch, f);
X return 0;
X}
X
X
X/* Check if at end of line (or end of entire file). */
X
Xint P_eoln(f)
XFILE *f;
X{
X register int ch;
X
X ch = getc(f);
X if (ch == EOF)
X return 1;
X ungetc(ch, f);
X return (ch == '\n');
X}
X
X
X/* Read a packed array of characters from a file. */
X
XVoid P_readpaoc(f, s, len)
XFILE *f;
Xchar *s;
Xint len;
X{
X int ch;
X
X for (;;) {
X if (len <= 0)
X return;
X ch = getc(f);
X if (ch == EOF || ch == '\n')
X break;
X *s++ = ch;
X --len;
X }
X while (--len >= 0)
X *s++ = ' ';
X if (ch != EOF)
X ungetc(ch, f);
X}
X
XVoid P_readlnpaoc(f, s, len)
XFILE *f;
Xchar *s;
Xint len;
X{
X int ch;
X
X for (;;) {
X ch = getc(f);
X if (ch == EOF || ch == '\n')
X break;
X if (len > 0) {
X *s++ = ch;
X --len;
X }
X }
X while (--len >= 0)
X *s++ = ' ';
X}
X
X
X/* Compute maximum legal "seek" index in file (0-based). */
X
Xlong P_maxpos(f)
XFILE *f;
X{
X long savepos = ftell(f);
X long val;
X
X if (fseek(f, 0L, SEEK_END))
X return -1;
X val = ftell(f);
X if (fseek(f, savepos, SEEK_SET))
X return -1;
X return val;
X}
X
X
X/* Use packed array of char for a file name. */
X
Xchar *P_trimname(fn, len)
Xregister char *fn;
Xregister int len;
X{
X static char fnbuf[256];
X register char *cp = fnbuf;
X
X while (--len >= 0 && *fn && !isspace(*fn))
X *cp++ = *fn++;
X return fnbuf;
X}
X
X
X
X
X/* Pascal's "memavail" doesn't make much sense in Unix with virtual memory.
X We fix memory size as 10Meg as a reasonable compromise. */
X
Xlong memavail()
X{
X return 10000000; /* worry about this later! */
X}
X
Xlong maxavail()
X{
X return memavail();
X}
X
X
X
X
X/* Sets are stored as an array of longs. S[0] is the size of the set;
X S[N] is the N'th 32-bit chunk of the set. S[0] equals the maximum
X I such that S[I] is nonzero. S[0] is zero for an empty set. Within
X each long, bits are packed from lsb to msb. The first bit of the
X set is the element with ordinal value 0. (Thus, for a "set of 5..99",
X the lowest five bits of the first long are unused and always zero.) */
X
X/* (Sets with 32 or fewer elements are normally stored as plain longs.) */
X
Xlong *P_setunion(d, s1, s2) /* d := s1 + s2 */
Xregister long *d, *s1, *s2;
X{
X long *dbase = d++;
X register int sz1 = *s1++, sz2 = *s2++;
X while (sz1 > 0 && sz2 > 0) {
X *d++ = *s1++ | *s2++;
X sz1--, sz2--;
X }
X while (--sz1 >= 0)
X *d++ = *s1++;
X while (--sz2 >= 0)
X *d++ = *s2++;
X *dbase = d - dbase - 1;
X return dbase;
X}
X
X
Xlong *P_setint(d, s1, s2) /* d := s1 * s2 */
Xregister long *d, *s1, *s2;
X{
X long *dbase = d++;
X register int sz1 = *s1++, sz2 = *s2++;
X while (--sz1 >= 0 && --sz2 >= 0)
X *d++ = *s1++ & *s2++;
X while (--d > dbase && !*d) ;
X *dbase = d - dbase;
X return dbase;
X}
X
X
Xlong *P_setdiff(d, s1, s2) /* d := s1 - s2 */
Xregister long *d, *s1, *s2;
X{
X long *dbase = d++;
X register int sz1 = *s1++, sz2 = *s2++;
X while (--sz1 >= 0 && --sz2 >= 0)
X *d++ = *s1++ & ~*s2++;
X if (sz1 >= 0) {
X while (sz1-- >= 0)
X *d++ = *s1++;
X }
X while (--d > dbase && !*d) ;
X *dbase = d - dbase;
X return dbase;
X}
X
X
Xlong *P_setxor(d, s1, s2) /* d := s1 / s2 */
Xregister long *d, *s1, *s2;
X{
X long *dbase = d++;
X register int sz1 = *s1++, sz2 = *s2++;
X while (sz1 > 0 && sz2 > 0) {
X *d++ = *s1++ ^ *s2++;
X sz1--, sz2--;
X }
X while (--sz1 >= 0)
X *d++ = *s1++;
X while (--sz2 >= 0)
X *d++ = *s2++;
X *dbase = d - dbase - 1;
X return dbase;
X}
X
X
Xint P_inset(val, s) /* val IN s */
Xregister unsigned val;
Xregister long *s;
X{
X register int bit;
X bit = val % SETBITS;
X val /= SETBITS;
X if (val < *s++ && ((1<<bit) & s[val]))
X return 1;
X return 0;
X}
X
X
Xlong *P_addset(s, val) /* s := s + [val] */
Xregister long *s;
Xregister unsigned val;
X{
X register long *sbase = s;
X register int bit, size;
X bit = val % SETBITS;
X val /= SETBITS;
X size = *s;
X if (++val > size) {
X s += size;
X while (val > size)
X *++s = 0, size++;
X *sbase = size;
X } else
X s += val;
X *s |= 1<<bit;
X return sbase;
X}
X
X
Xlong *P_addsetr(s, v1, v2) /* s := s + [v1..v2] */
Xregister long *s;
Xregister unsigned v1, v2;
X{
X register long *sbase = s;
X register int b1, b2, size;
X if (v1 > v2)
X return sbase;
X b1 = v1 % SETBITS;
X v1 /= SETBITS;
X b2 = v2 % SETBITS;
X v2 /= SETBITS;
X size = *s;
X v1++;
X if (++v2 > size) {
X while (v2 > size)
X s[++size] = 0;
X s[v2] = 0;
X *s = v2;
X }
X s += v1;
X if (v1 == v2) {
X *s |= (~((-2)<<(b2-b1))) << b1;
X } else {
X *s++ |= (-1) << b1;
X while (++v1 < v2)
X *s++ = -1;
X *s |= ~((-2) << b2);
X }
X return sbase;
X}
X
X
Xlong *P_remset(s, val) /* s := s - [val] */
Xregister long *s;
Xregister unsigned val;
X{
X register int bit;
X bit = val % SETBITS;
X val /= SETBITS;
X if (++val <= *s)
X s[val] &= ~(1<<bit);
X return s;
X}
X
X
Xint P_setequal(s1, s2) /* s1 = s2 */
Xregister long *s1, *s2;
X{
X register int size = *s1++;
X if (*s2++ != size)
X return 0;
X while (--size >= 0) {
X if (*s1++ != *s2++)
X return 0;
X }
X return 1;
X}
X
X
Xint P_subset(s1, s2) /* s1 <= s2 */
Xregister long *s1, *s2;
X{
X register int sz1 = *s1++, sz2 = *s2++;
X if (sz1 > sz2)
X return 0;
X while (--sz1 >= 0) {
X if (*s1++ & ~*s2++)
X return 0;
X }
X return 1;
X}
X
X
Xlong *P_setcpy(d, s) /* d := s */
Xregister long *d, *s;
X{
X register long *save_d = d;
X
X#ifdef SETCPY_MEMCPY
X memcpy(d, s, (*s + 1) * sizeof(long));
X#else
X register int i = *s + 1;
X while (--i >= 0)
X *d++ = *s++;
X#endif
X return save_d;
X}
X
X
X/* s is a "smallset", i.e., a 32-bit or less set stored
X directly in a long. */
X
Xlong *P_expset(d, s) /* d := s */
Xregister long *d;
Xlong s;
X{
X if ((d[1] = s))
X *d = 1;
X else
X *d = 0;
X return d;
X}
X
X
Xlong P_packset(s) /* convert s to a small-set */
Xregister long *s;
X{
X if (*s++)
X return *s;
X else
X return 0;
X}
X
X
X
X
X
X/* Oregon Software Pascal extensions, courtesy of William Bader */
X
Xint P_getcmdline(l, h, line)
Xint l, h;
XChar *line;
X{
X int i, len;
X char *s;
X
X h = h - l + 1;
X len = 0;
X for(i = 1; i < P_argc; i++) {
X s = P_argv[i];
X while (*s) {
X if (len >= h) return len;
X line[len++] = *s++;
X }
X if (len >= h) return len;
X line[len++] = ' ';
X }
X return len;
X}
X
XVoid TimeStamp(Day, Month, Year, Hour, Min, Sec)
Xint *Day, *Month, *Year, *Hour, *Min, *Sec;
X{
X#ifndef NO_TIME
X struct tm *tm;
X long clock;
X
X time(&clock);
X tm = localtime(&clock);
X *Day = tm->tm_mday;
X *Month = tm->tm_mon + 1; /* Jan = 0 */
X *Year = tm->tm_year;
X if (*Year < 1900)
X *Year += 1900; /* year since 1900 */
X *Hour = tm->tm_hour;
X *Min = tm->tm_min;
X *Sec = tm->tm_sec;
X#endif
X}
X
X
X
X
X/* SUN Berkeley Pascal extensions */
X
XVoid P_sun_argv(s, len, n)
Xregister char *s;
Xregister int len, n;
X{
X register char *cp;
X
X if ((unsigned)n < P_argc)
X cp = P_argv[n];
X else
X cp = "";
X while (*cp && --len >= 0)
X *s++ = *cp++;
X while (--len >= 0)
X *s++ = ' ';
X}
X
X
X
X
Xint _OutMem()
X{
X return _Escape(-2);
X}
X
Xint _CaseCheck()
X{
X return _Escape(-9);
X}
X
Xint _NilCheck()
X{
X return _Escape(-3);
X}
X
X
X
X
X
X/* The following is suitable for the HP Pascal operating system.
X It might want to be revised when emulating another system. */
X
Xchar *_ShowEscape(buf, code, ior, prefix)
Xchar *buf, *prefix;
Xint code, ior;
X{
X char *bufp;
X
X if (prefix && *prefix) {
X strcpy(buf, prefix);
X strcat(buf, ": ");
X bufp = buf + strlen(buf);
X } else {
X bufp = buf;
X }
X if (code == -10) {
X sprintf(bufp, "Pascal system I/O error %d", ior);
X switch (ior) {
X case 3:
X strcat(buf, " (illegal I/O request)");
X break;
X case 7:
X strcat(buf, " (bad file name)");
X break;
X case FileNotFound: /*10*/
X strcat(buf, " (file not found)");
X break;
X case FileNotOpen: /*13*/
X strcat(buf, " (file not open)");
X break;
X case BadInputFormat: /*14*/
X strcat(buf, " (bad input format)");
X break;
X case 24:
X strcat(buf, " (not open for reading)");
X break;
X case 25:
X strcat(buf, " (not open for writing)");
X break;
X case 26:
X strcat(buf, " (not open for direct access)");
X break;
X case 28:
X strcat(buf, " (string subscript out of range)");
X break;
X case EndOfFile: /*30*/
X strcat(buf, " (end-of-file)");
X break;
X case FileWriteError: /*38*/
X strcat(buf, " (file write error)");
X break;
X }
X } else {
X sprintf(bufp, "Pascal system error %d", code);
X switch (code) {
X case -2:
X strcat(buf, " (out of memory)");
X break;
X case -3:
X strcat(buf, " (reference to NIL pointer)");
X break;
X case -4:
X strcat(buf, " (integer overflow)");
X break;
X case -5:
X strcat(buf, " (divide by zero)");
X break;
X case -6:
X strcat(buf, " (real math overflow)");
X break;
X case -8:
X strcat(buf, " (value range error)");
X break;
X case -9:
X strcat(buf, " (CASE value range error)");
X break;
X case -12:
X strcat(buf, " (bus error)");
X break;
X case -20:
X strcat(buf, " (stopped by user)");
X break;
X }
X }
X return buf;
X}
X
X
Xint _Escape(code)
Xint code;
X{
X char buf[100];
X
X P_escapecode = code;
X if (__top_jb) {
X __p2c_jmp_buf *jb = __top_jb;
X __top_jb = jb->next;
X longjmp(jb->jbuf, 1);
X }
X if (code == 0)
X exit(0);
X if (code == -1)
X exit(1);
X fprintf(stderr, "%s\n", _ShowEscape(buf, P_escapecode, P_ioresult, ""));
X exit(1);
X}
X
Xint _EscIO(code)
Xint code;
X{
X P_ioresult = code;
X return _Escape(-10);
X}
X
X
X
X
X/* End. */
X
X
X
SHAR_EOF
if test 16729 -ne "`wc -c < 'p2clib.c'`"
then
echo shar: "error transmitting 'p2clib.c'" '(should have been 16729 characters)'
fi
fi
exit 0
# End of shell archive
--
Glenn Geers | "So when it's over, we're back to people.
Department of Theoretical Physics | Just to prove that human touch can have
The University of Sydney | no equal."
Sydney NSW 2006 Australia | - Basia Trzetrzelewska, 'Prime Time TV'
More information about the Alt.sources
mailing list