Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!samsung!munnari.oz.au!metro!news From: glenn@extro.ucc.su.oz.au (Glenn Geers) Newsgroups: alt.sources Subject: wp2latex (3 of 4) Message-ID: <1990Aug8.115130.17311@metro.ucc.su.OZ.AU> Date: 8 Aug 90 11:51:30 GMT Reply-To: glenn@extro.ucc.su.oz.au (Glenn Geers) Organization: University Computing Service, Uni. of Sydney, Australia. Lines: 1619 #! /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@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@secnumdepth >\m@ne \refstepcounter{part} X\addcontentsline{toc}{part}{\thepart \hspace{1em}#1}\else X\addcontentsline{toc}{part}{#1}\fi { \parindent 0pt \raggedright X \ifnum \c@secnumdepth >\m@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@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@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@secnumdepth >-2\relax \refstepcounter{part} X\addcontentsline{toc}{part}{\thepart \hspace{1em}#1}\else X\addcontentsline{toc}{part}{#1}\fi \markboth{}{} X \ifnum \c@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@twocolumn\@restonecoltrue\onecolumn X \fi\chapter*{Inhoud\@mkboth{INHOUD}{INHOUD}} X% ====== ====== ====== X \@starttoc{toc}\if@restonecol\twocolumn\fi} X\def\listoffigures{\@restonecolfalse\if@twocolumn\@restonecoltrue\onecolumn X \fi\chapter*{Lijst van figuren\@mkboth X% ================= X {LIJST VAN FIGUREN}{LIJST VAN FIGUREN}}\@starttoc{lof}\if@restonecol\twocolumn X% ================= ================= X \fi} X\def\listoftables{\@restonecolfalse\if@twocolumn\@restonecoltrue\onecolumn X \fi\chapter*{Lijst van tabellen\@mkboth X% ================== X {LIJST VAN TABELLEN}{LIJST VAN TABELLEN}}\@starttoc{lot}\if@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@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@figure{Figuur \thefigure} X% ====== X\def\fnum@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 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 X# include X# define HAS_STDLIB X# define __CAT__(a,b)a##b X#else X# ifndef BSD X# include X# endif X# include X# define __ID__(a)a X# define __CAT__(a,b)__ID__(a)b X#endif X X X#ifdef BSD X# include 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 X#endif X X#include X#include X#include X#include 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 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< size) { X s += size; X while (val > size) X *++s = 0, size++; X *sbase = size; X } else X s += val; X *s |= 1< 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<= 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'