rsalz@uunet.uu.net (Rich Salz) (03/27/90)
Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
Posting-number: Volume 21, Issue 48
Archive-name: p2c/part03
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 3 (of 32)."
# Contents: HP/include/sysglobals.h src/comment.c src/p2c.h
# src/pexpr.c.3 src/turbo.imp
# Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:27 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'HP/include/sysglobals.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'HP/include/sysglobals.h'\"
else
echo shar: Extracting \"'HP/include/sysglobals.h'\" \(8748 characters\)
sed "s/^X//" >'HP/include/sysglobals.h' <<'END_OF_FILE'
X/* Header for module sysglobals, generated by p2c */
X#ifndef SYSGLOBALS_H
X#define SYSGLOBALS_H
X
X
X
X#ifdef SYSGLOBALS_G
X# define vextern
X#else
X# define vextern extern
X#endif
X
X
X
Xtypedef Char fsidctype[20];
X
X
X
X#define fsidc "Rev. 3.1 18-Jul-85"
X
X/*20 CHARS: VERSION,DATE,TIME OF FILE SYS*/
X#define mminint (-32768L)
X
X/*MINIMUM SHORT INTEGER VALUE*/
X#define mmaxint 32767
X
X/*MAXIMUM SHORT INTEGER VALUE*/
X#define maxunit 50
X
X/*MAXIMUM PHYSICAL UNIT NUMBER*/
X#define passleng 16
X
X/*NUMBER OF CHARS IN A PASSWORD*/
X#define vidleng 16
X
X/*NUMBER OF CHARS IN A VOLUME NAME*/
X#define tidleng 16
X
X/*NUMBER OF CHARS IN A FILE TITLE*/
X#define fidleng 120
X
X/*NUMBER OF CHARS IN FILE NAME*/
X#define fblksize 512
X
X/*STANDARD FILE BUFFER LENGTH*/
X#define maxsc 63
X
X/*LARGEST SELECT CODE */
X#define minlevel 1
X
X/*LOWEST INTERRUPT LEVEL*/
X#define maxlevel 6
X/* p2c: Note: Field width for FKIND assumes enum filekind has 16 elements (from sysglobals.imp, line 81) */
X
X
X
X/*LARGEST MASKABLE INTERRUPT LEVEL*/
X/*directory entry*/
X/*bad blocks*/
X/*executable or linkable*/
X/*UCSD format text with editor environment*/
X/*L.I.F. ASCII format text strings*/
X/*file of <data type, e.g. char, integer,etc.>*/
X/*system (BOOT) file*/
X/*reserved for future expansion*/
X/*FILE INFORMATION*/
X/*BUFFER VARIABLE...F^ */
X/* LIST OF OPEN FILES */
X/*declaration and type information*/
X/* SIZE OF ONE LOGICAL RECORD */
X/* EXTERNAL FILE TYPE */
X/* FILE KIND */
X/* FILE IS LINE FORMATTED */
X/* HAS 512 BYTE BLOCK BUFFER */
X/* FILE HAS NO NAME */
X/* WAS CREATED THIS ASSOCIATION */
X/* FILE ACCESS RIGHTS */
X/*state information*/
X/*F^ AND LOOKAHEAD STATES */
X/* F^ IS AN END OF LINE */
X/* TRIED TO READ PAST END OF FILE */
X/* FILE HAS CHANGED SIZE */
X/* BUFFER NEEDS TO BE WRITTEN */
X/*file size and position*/
X/* FILE POINTER, CURRENT FILE POSITION */
X/*LOGICAL END OF FILE, CURRENT FILE SIZE */
X/*PHYSICAL END OF FILE, MAXIMUM FILE SIZE */
X/*buffering and low level formatting information*/
X/* FILE POSITION OF BUFFER */
X/* SPACE COMPRESSION COUNT */
X/*BUFFER METHOD MODULE */
X/*file association info*/
X/*EXECUTION ADDRESS IN BOOT FILE */
X/* VOLUME NAME */
X/* FILE PASSWORD */
X/* FILE NAME */
X/* ADDITIONAL SYSTEM DEPENDENT INFORMATION */
X/* TEMP FILE IDENTIFIER */
X/* OPTIONAL STRING PARAM */
X/*byte block transfer information*/
X/* START BYTE OF FILE, OR OTHER IDENTIFICATION */
X/* FOR FUTURE EXPANSION */
X/*TRUE IF NO SRM TEMP FILE CREATED */
X/*TRUE IF SRM SHOULD WAIT FOR LOCK */
X/*TRUE IF OLD SRM LINK IS TO BE PURGED */
X/*TRUE IF OPENED WITH OVERWRITE */
X/*TRUE IF PATHID NOT UNIQUE TO FILEID */
X/*TRUE IF FILE OPENED AS LOCKABLE */
X/*TRUE IF FILE IS LOCKED */
X/*TRUE IF DRIVER IS ACTIVE */
X/*PHYSICAL UNIT NUMBER */
X/*CALLED WHEN TRANSFER COMPLETES */
X/* X POSITION FOR GOTOXY */
X/* Y POSITION FOR GOTOXY */
X/* FILEID FOR OLD SRM FILE ON REWRITE */
X/*for future expansion*/
X/*large miscellaneous fields sometimes present*/
X/*minimal FIB ends here*/
X/* FILE NAME, EXCEPT VOLUME AND SIZE */
X/*FIB*/
X/*unitable entry definition*/
X/*directory access method*/
X/*byte block transfer method*/
X/*select code*/
X/*bus address*/
X/*disc unit*/
X/*disc volume*/
X/*physical starting byte of volume*/
X/*identifier (Amigo identify sequence)*/
X/*volume id*/
X/*temp for driver use only; init to 0!*/
X/*temp for driver use only; init to 0!*/
X/*device specifier letter*/
X/*unit absent or down flag*/
X/*user can edit input*/
X/*medium not changed since last access*/
X/*volume name must be uppercased*/
X/*fixed/removeable media flag*/
X/*driver mode: report/ignore media change*/
X/* (bit not used yet) */
X/*blocked volume flag*/
X/*volume size in bytes */
X/*unitentry*/
X/*0 NOT USED*/
X/* *note* the ioresult enumerations have been partitioned into two */
X/* mutually-exclusive groups: those beginning with 'z' are reserved */
X/* for the low-level drivers , and those beginning */
X/* with 'i' are reserved for the higher-level routines.*/
X/*end marker*/
X/*isr information block*/
X/*interrupt register address*/
X/*interrupt register mask*/
X/*interrupt register target value after masking*/
X/*chaining flag*/
X/*isr*/
X/*pointer to next isrib in linked list*/
X/*100 IS TEMP DISK FLAG*/
X/*DAY OF MONTH*/
X/*0 ==> DATE NOT MEANINGFUL*/
X
Xtypedef enum {
X untypedfile, badfile, codefile, textfile, asciifile, datafile, sysfile,
X fkind7, fkind8, fkind9, fkind10, fkind11, fkind12, fkind13, fkind14,
X lastfkind
X} filekind;
X
Xtypedef Char window[];
X
Xtypedef enum {
X readbytes, writebytes, flush, writeeol, readtoeol, clearunit, setcursor,
X getcursor, startread, startwrite, unitstatus, seekeof
X} amrequesttype;
X
Xtypedef struct fib {
X Char *fwindow;
X struct fib *flistptr;
X long frecsize;
X short feft;
X unsigned fkind : 4, fistextvar : 1, fbuffered : 1, fanonymous : 1,
X fisnew : 1, freadable : 1, fwriteable : 1, freadmode : 1,
X fbufvalid : 1, feoln : 1, feof_ : 1, fmodified : 1,
X fbufchanged : 1;
X long fpos, fleof, fpeof, flastpos;
X short freptcnt;
X _PROCEDURE am;
X long fstartaddress;
X Char fvid[vidleng + 1];
X Char ffpw[passleng + 1];
X Char ftid[tidleng + 1];
X long pathid;
X short fanonctr;
X Char *foptstring;
X long fileid;
X unsigned fb0 : 1, fb1 : 1, fnosrmtemp : 1, fwaitonlock : 1,
X fpurgeoldlink : 1, foverwritten : 1, fsavepathid : 1,
X flockable : 1, flocked : 1, fbusy : 1, funit : 6;
X _PROCEDURE feot;
X long fxpos, fypos, foldfileid;
X long fextra[3];
X short fextra2;
X union {
X Char ftitle[fidleng + 1];
X Char fbuffer[fblksize];
X } UU;
X} fib;
X
Xtypedef enum {
X getvolumename, setvolumename, getvolumedate, setvolumedate, changename,
X purgename, openfile, createfile, overwritefile, closefile, purgefile,
X stretchit, makedirectory, crunch, opendirectory, closedirectory, catalog,
X stripname, setunitprefix, openvolume, duplicatelink, openparentdir,
X catpasswords, setpasswords, lockfile, unlockfile, openunit
X} damrequesttype;
X
Xtypedef struct unitentry {
X _PROCEDURE dam;
X _PROCEDURE tm;
X uchar sc, ba, du, dv;
X long byteoffset, devid;
X Char uvid[vidleng + 1];
X long dvrtemp;
X short dvrtemp2;
X Char letter;
X unsigned offline : 1, uisinteractive : 1, umediavalid : 1, uuppercase : 1,
X uisfixed : 1, ureportchange : 1, pad : 1, uisblkd : 1;
X union {
X long umaxbytes;
X } UU;
X} unitentry;
X
Xtypedef unitentry unitabletype[maxunit + 1];
X
Xtypedef _PROCEDURE amtabletype[16];
X
Xtypedef Char suftabletype[16][6];
X
Xtypedef short efttabletype[16];
X
Xtypedef enum {
X inoerror, zbadblock, ibadunit, zbadmode, ztimeout, ilostunit, ilostfile,
X ibadtitle, inoroom, inounit, inofile, idupfile, inotclosed, inotopen,
X ibadformat, znosuchblk, znodevice, zinitfail, zprotected, zstrangei,
X zbadhardware, zcatchall, zbaddma, inotvalidsize, inotreadable,
X inotwriteable, inotdirect, idirfull, istrovfl, ibadclose, ieof,
X zuninitialized, znoblock, znotready, znomedium, inodirectory,
X ibadfiletype, ibadvalue, icantstretch, ibadrequest, inotlockable,
X ifilelocked, ifileunlocked, idirnotempty, itoomanyopen, inoaccess,
X ibadpass, ifilenotdir, inotondir, ineedtempdir, isrmcatchall,
X zmediumchanged, endioerrs
X} iorsltwd;
X
Xtypedef struct isrib {
X Char *intregaddr;
X uchar intregmask, intregvalue;
X unsigned chainflag : 1;
X _PROCEDURE proc;
X struct isrib *link;
X} isrib;
X
Xtypedef isrib *inttabletype[7];
X
Xtypedef struct daterec {
X char year;
X unsigned day : 5, month : 4;
X} daterec;
X
Xtypedef struct timerec {
X unsigned hour : 5, minute : 6, centisecond : 13;
X} timerec;
X
Xtypedef struct datetimerec {
X daterec date;
X timerec time;
X} datetimerec;
X
X
X
Xvextern short sysescapecode;
Xvextern Anyptr *openfileptr, *recoverblock, *heapmax, *heapbase;
Xvextern long sysioresult, hardwarestatus, locklevel;
Xvextern unitentry *unitable;
Xvextern inttabletype interrupttable;
Xvextern long endisrhook, actionspending;
Xvextern FILE **gfiles[6];
Xvextern _PROCEDURE *amtable;
Xvextern Char (*suffixtable)[6];
Xvextern short *efttable;
Xvextern long sysunit;
Xvextern Char syvid[vidleng + 1], dkvid[vidleng + 1];
Xvextern Char syslibrary[fidleng + 1];
Xvextern _PROCEDURE debugger;
Xvextern _PROCEDURE cleariohook;
Xvextern inttabletype perminttable;
Xvextern _PROCEDURE deferredaction[10];
Xvextern _PROCEDURE serialtextamhook;
Xvextern Char sysname[10];
Xvextern struct {
X unsigned reserved1 : 1, reserved2 : 1, nointhpib : 1, crtconfigreg : 1,
X nokeyboard : 1, highlightsxorbiggraphics : 1, biggraphics : 1,
X alpha50 : 1;
X} sysflag;
Xvextern struct {
X char pad7to1;
X unsigned prompresent : 1;
X} sysflag2;
Xvextern short endsysvars;
X
X
X
X#undef vextern
X
X#endif /*SYSGLOBALS_H*/
X
X/* End. */
X
END_OF_FILE
if test 8748 -ne `wc -c <'HP/include/sysglobals.h'`; then
echo shar: \"'HP/include/sysglobals.h'\" unpacked with wrong size!
fi
# end of 'HP/include/sysglobals.h'
fi
if test -f 'src/comment.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/comment.c'\"
else
echo shar: Extracting \"'src/comment.c'\" \(9566 characters\)
sed "s/^X//" >'src/comment.c' <<'END_OF_FILE'
X/* "p2c", a Pascal to C translator.
X Copyright (C) 1989 David Gillespie.
X Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
X
XThis program is free software; you can redistribute it and/or modify
Xit under the terms of the GNU General Public License as published by
Xthe Free Software Foundation (any version).
X
XThis program is distributed in the hope that it will be useful,
Xbut WITHOUT ANY WARRANTY; without even the implied warranty of
XMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
XGNU General Public License for more details.
X
XYou should have received a copy of the GNU General Public License
Xalong with this program; see the file COPYING. If not, write to
Xthe Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
X
X
X
X#define PROTO_COMMENT_C
X#include "trans.h"
X
X
X
XStatic int cmttablesize;
XStatic uchar *cmttable;
X
XStatic int grabbed_comment;
X
X
X
X
X/* Special comment forms:
X
X \001\001\001... Blank line(s), one \001 char per blank line
X \002text... Additional line for previous comment
X \003text... Additional comment line, absolutely indented
X \004text... Note or warning line, unindented
X
X*/
X
X
X
X
Xvoid setup_comment()
X{
X curcomments = NULL;
X cmttablesize = 200;
X cmttable = ALLOC(cmttablesize, uchar, misc);
X grabbed_comment = 0;
X}
X
X
X
X
X
Xint commentlen(cmt)
XStrlist *cmt;
X{
X if (cmt)
X if (*(cmt->s))
X return strlen(cmt->s) + 4;
X else
X return 5;
X else
X return 0;
X}
X
X
Xint commentvisible(cmt)
XStrlist *cmt;
X{
X return (cmt &&
X getcommentkind(cmt) != CMT_DONE &&
X eatcomments != 1 && eatcomments != 2);
X}
X
X
X
X
X
X
X/* If preceding statement's POST comments include blank lines,
X steal all comments after longest stretch of blank lines as
X PRE comments for the next statement. */
X
Xvoid steal_comments(olds, news, always)
Xlong olds, news;
Xint always;
X{
X Strlist *cmt, *cmtfirst = NULL, *cmtblank = NULL;
X int len, longest;
X
X for (cmt = curcomments; cmt; cmt = cmt->next) {
X if ((cmt->value & CMT_MASK) == olds &&
X getcommentkind(cmt) == CMT_POST) {
X if (!cmtfirst)
X cmtfirst = cmt;
X } else {
X cmtfirst = NULL;
X }
X }
X if (cmtfirst) {
X if (!always) {
X longest = 0;
X for (cmt = cmtfirst; cmt; cmt = cmt->next) {
X if (cmt->s[0] == '\001') { /* blank line(s) */
X len = strlen(cmt->s);
X if (len > longest) {
X longest = len;
X cmtblank = cmt;
X }
X }
X }
X if (longest > 0) {
X if (blankafter)
X cmtfirst = cmtblank->next;
X else
X cmtfirst = cmtblank;
X } else if (commentafter == 1)
X cmtfirst = NULL;
X }
X changecomments(cmtfirst, CMT_POST, olds, CMT_PRE, news);
X }
X}
X
X
X
XStrlist *fixbeginendcomment(cmt)
XStrlist *cmt;
X{
X char *cp, *cp2;
X
X if (!cmt)
X return NULL;
X cp = cmt->s;
X while (isspace(*cp))
X cp++;
X if (!strcincmp(cp, "procedure ", 10)) { /* remove "PROCEDURE" keyword */
X strcpy(cp, cp+10);
X } else if (!strcincmp(cp, "function ", 9)) {
X strcpy(cp, cp+9);
X }
X while (isspace(*cp))
X cp++;
X if (!*cp)
X return NULL;
X if (getcommentkind(cmt) == CMT_ONBEGIN) {
X cp2 = curctx->sym->name;
X while (*cp2) {
X if (toupper(*cp2++) != toupper(*cp++))
X break;
X }
X while (isspace(*cp))
X cp++;
X if (!*cp2 && !*cp)
X return NULL; /* eliminate function-begin comment */
X }
X return cmt;
X}
X
X
X
X
XStatic void attach_mark(sp)
XStmt *sp;
X{
X long serial;
X
X while (sp) {
X serial = sp->serial;
X if (serial >= 0 && serial < cmttablesize) {
X cmttable[serial]++;
X if (sp->kind == SK_IF && serial+1 < cmttablesize)
X cmttable[serial+1]++; /* the "else" branch */
X }
X attach_mark(sp->stm1);
X attach_mark(sp->stm2);
X sp = sp->next;
X }
X}
X
X
X
Xvoid attach_comments(sbase)
XStmt *sbase;
X{
X Strlist *cmt;
X long serial, i, j;
X int kind;
X
X if (spitorphancomments)
X return;
X if (serialcount >= cmttablesize) {
X cmttablesize = serialcount + 100;
X cmttable = REALLOC(cmttable, cmttablesize, uchar);
X }
X for (i = 0; i < cmttablesize; i++)
X cmttable[i] = 0;
X attach_mark(sbase);
X for (cmt = curcomments; cmt; cmt = cmt->next) {
X serial = cmt->value & CMT_MASK;
X kind = getcommentkind(cmt);
X if (serial < 0 || serial >= cmttablesize || cmttable[serial])
X continue;
X i = 0;
X j = 0;
X do {
X if (commentafter == 1) {
X j++;
X if (j % 3 == 0)
X i++;
X } else if (commentafter == 0) {
X i++;
X if (i % 3 == 0)
X j++;
X } else {
X i++;
X j++;
X }
X if (serial+i < cmttablesize && cmttable[serial+i]) {
X setcommentkind(cmt, CMT_PRE);
X cmt->value += i;
X break;
X }
X if (serial-j > 0 && cmttable[serial-j]) {
X setcommentkind(cmt, CMT_POST);
X cmt->value -= j;
X break;
X }
X } while (serial+i < cmttablesize || serial-j > 0);
X }
X}
X
X
X
X
Xvoid setcommentkind(cmt, kind)
XStrlist *cmt;
Xint kind;
X{
X cmt->value = (cmt->value & CMT_MASK) | (kind << CMT_SHIFT);
X}
X
X
X
Xvoid commentline(kind)
Xint kind;
X{
X char *cp;
X Strlist *sl;
X
X if (grabbed_comment) {
X grabbed_comment = 0;
X return;
X }
X if (blockkind == TOK_IMPORT || skipping_module)
X return;
X if (eatcomments == 1)
X return;
X for (cp = curtokbuf; (cp = my_strchr(cp, '*')) != NULL; ) {
X if (*++cp == '/') {
X cp[-1] = '%';
X note("Changed \"* /\" to \"% /\" in comment [140]");
X }
X }
X sl = strlist_append(&curcomments, curtokbuf);
X sl->value = curserial;
X setcommentkind(sl, kind);
X}
X
X
X
Xvoid addnote(msg, serial)
Xchar *msg;
Xlong serial;
X{
X int len1, len2, xextra, extra;
X int defer = (notephase > 0 && spitcomments == 0);
X Strlist *sl, *base = NULL, **pbase = (defer) ? &curcomments : &base;
X char *prefix;
X
X if (defer && (outf != stdout || !quietmode))
X printf("%s, line %d: %s\n", infname, inf_lnum, msg);
X else if (outf != stdout)
X printf("%s, line %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
X if (verbose)
X fprintf(logf, "%s, %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
X if (notephase == 2 || regression)
X prefix = format_s("\004 p2c: %s:", infname);
X else
X prefix = format_sd("\004 p2c: %s, line %d:", infname, inf_lnum);
X len1 = strlen(prefix);
X len2 = strlen(msg) + 2;
X if (len1 + len2 < linewidth-4) {
X msg = format_ss("%s %s ", prefix, msg);
X } else {
X extra = xextra = 0;
X while (len2 - extra > linewidth-6) {
X while (extra < len2 && !isspace(msg[extra]))
X extra++;
X xextra = extra;
X while (extra < len2 && isspace(msg[extra]))
X extra++;
X }
X prefix = format_sds("%s %.*s", prefix, xextra, msg);
X msg += extra;
X sl = strlist_append(pbase, prefix);
X sl->value = serial;
X setcommentkind(sl, CMT_POST);
X msg = format_s("\003 * %s ", msg);
X }
X sl = strlist_append(pbase, msg);
X sl->value = serial;
X setcommentkind(sl, CMT_POST);
X outputmode++;
X outcomments(base);
X outputmode--;
X}
X
X
X
X
X
X/* Grab a comment off the end of the current line */
XStrlist *grabcomment(kind)
Xint kind;
X{
X char *cp, *cp2;
X Strlist *cmt, *savecmt;
X
X if (grabbed_comment || spitcomments == 1)
X return NULL;
X cp = inbufptr;
X while (isspace(*cp))
X cp++;
X if (*cp == ';' || *cp == ',' || *cp == '.')
X cp++;
X while (isspace(*cp))
X cp++;
X cp2 = curtokbuf;
X if (*cp == '{') {
X cp++;
X while (*cp && *cp != '}')
X *cp2++ = *cp++;
X if (!*cp)
X return NULL;
X cp++;
X } else if (*cp == '(' && cp[1] == '*') {
X cp += 2;
X while (*cp && (*cp != '*' || cp[1] != ')'))
X *cp2++ = *cp++;
X if (!*cp)
X return NULL;
X cp += 2;
X } else
X return NULL;
X while (isspace(*cp))
X cp++;
X if (*cp)
X return NULL;
X *cp2 = 0;
X savecmt = curcomments;
X curcomments = NULL;
X commentline(kind);
X cmt = curcomments;
X curcomments = savecmt;
X grabbed_comment = 1;
X if (cmtdebug > 1)
X fprintf(outf, "Grabbed comment [%d] \"%s\"\n", cmt->value & CMT_MASK, cmt->s);
X return cmt;
X}
X
X
X
Xint matchcomment(cmt, kind, stamp)
XStrlist *cmt;
Xint kind, stamp;
X{
X if (spitcomments == 1 && (cmt->value & CMT_MASK) != 10000 &&
X *cmt->s != '\001' && (kind >= 0 || stamp >= 0))
X return 0;
X if (!cmt || getcommentkind(cmt) == CMT_DONE)
X return 0;
X if (stamp >= 0 && (cmt->value & CMT_MASK) != stamp)
X return 0;
X if (kind >= 0) {
X if (kind & CMT_NOT) {
X if (getcommentkind(cmt) == kind - CMT_NOT)
X return 0;
X } else {
X if (getcommentkind(cmt) != kind)
X return 0;
X }
X }
X return 1;
X}
X
X
X
XStrlist *findcomment(cmt, kind, stamp)
XStrlist *cmt;
Xint kind, stamp;
X{
X while (cmt && !matchcomment(cmt, kind, stamp))
X cmt = cmt->next;
X if (cmt && cmtdebug > 1)
X fprintf(outf, "Found comment [%d] \"%s\"\n", cmt->value & CMT_MASK, cmt->s);
X return cmt;
X}
X
X
X
XStrlist *extractcomment(cmt, kind, stamp)
XStrlist **cmt;
Xint kind, stamp;
X{
X Strlist *base, **last, *sl;
X
X last = &base;
X while ((sl = *cmt)) {
X if (matchcomment(sl, kind, stamp)) {
X if (cmtdebug > 1)
X fprintf(outf, "Extracted comment [%d] \"%s\"\n",
X sl->value & CMT_MASK, sl->s);
X *cmt = sl->next;
X *last = sl;
X last = &sl->next;
X } else
X cmt = &sl->next;
X }
X *last = NULL;
X return base;
X}
X
X
Xvoid changecomments(cmt, okind, ostamp, kind, stamp)
XStrlist *cmt;
Xint okind, ostamp, kind, stamp;
X{
X while (cmt) {
X if (matchcomment(cmt, okind, ostamp)) {
X if (cmtdebug > 1)
X fprintf(outf, "Changed comment [%s:%d] \"%s\" ",
X CMT_NAMES[getcommentkind(cmt)],
X cmt->value & CMT_MASK, cmt->s);
X if (kind >= 0)
X setcommentkind(cmt, kind);
X if (stamp >= 0)
X cmt->value = (cmt->value & ~CMT_MASK) | stamp;
X if (cmtdebug > 1)
X fprintf(outf, " to [%s:%d]\n",
X CMT_NAMES[getcommentkind(cmt)], cmt->value & CMT_MASK);
X }
X cmt = cmt->next;
X }
X}
X
X
X
X
X
X
X/* End. */
X
END_OF_FILE
if test 9566 -ne `wc -c <'src/comment.c'`; then
echo shar: \"'src/comment.c'\" unpacked with wrong size!
fi
# end of 'src/comment.c'
fi
if test -f 'src/p2c.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/p2c.h'\"
else
echo shar: Extracting \"'src/p2c.h'\" \(11081 characters\)
sed "s/^X//" >'src/p2c.h' <<'END_OF_FILE'
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.14.
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# define BSD 0
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# define strchr(s,c) index(s,c)
X# define strrchr(s,c) rindex(s,c)
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 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/* 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) << (32 - (((~(i))+1) << (n))) >> (32-(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
END_OF_FILE
if test 11081 -ne `wc -c <'src/p2c.h'`; then
echo shar: \"'src/p2c.h'\" unpacked with wrong size!
fi
# end of 'src/p2c.h'
fi
if test -f 'src/pexpr.c.3' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/pexpr.c.3'\"
else
echo shar: Extracting \"'src/pexpr.c.3'\" \(8365 characters\)
sed "s/^X//" >'src/pexpr.c.3' <<'END_OF_FILE'
X setprec2(10);
X checkbreak(breakbeforerel);
X wrexpr(ex->args[0], incompat(ex, 0, subprec));
X outop(">");
X wrexpr(ex->args[1], incompat(ex, 0, subprec));
X break;
X
X case EK_LE:
X setprec2(10);
X checkbreak(breakbeforerel);
X wrexpr(ex->args[0], incompat(ex, 0, subprec));
X outop("<=");
X wrexpr(ex->args[1], incompat(ex, 0, subprec));
X break;
X
X case EK_GE:
X setprec2(10);
X checkbreak(breakbeforerel);
X wrexpr(ex->args[0], incompat(ex, 0, subprec));
X outop(">=");
X wrexpr(ex->args[1], incompat(ex, 0, subprec));
X break;
X
X case EK_EQ:
X setprec2(9);
X checkbreak(breakbeforerel);
X wrexpr(ex->args[0], incompat(ex, 0, subprec));
X outop("==");
X wrexpr(ex->args[1], incompat(ex, 0, subprec));
X break;
X
X case EK_NE:
X setprec2(9);
X checkbreak(breakbeforerel);
X wrexpr(ex->args[0], incompat(ex, 0, subprec));
X outop("!=");
X wrexpr(ex->args[1], incompat(ex, 0, subprec));
X break;
X
X case EK_BAND:
X setprec3(8);
X if (ex->val.type == tp_boolean)
X checkbreak(breakbeforelog);
X else
X checkbreak(breakbeforearith);
X wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
X outop("&");
X wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
X break;
X
X case EK_BXOR:
X setprec3(7);
X checkbreak(breakbeforearith);
X wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
X outop("^");
X wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
X break;
X
X case EK_BOR:
X setprec3(6);
X if (ex->val.type == tp_boolean)
X checkbreak(breakbeforelog);
X else
X checkbreak(breakbeforearith);
X wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
X outop("|");
X wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
X break;
X
X case EK_AND:
X setprec3(5);
X checkbreak(breakbeforelog);
X wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
X outop("&&");
X wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
X break;
X
X case EK_OR:
X setprec3(4);
X checkbreak(breakbeforelog);
X wrexpr(ex->args[0], incompat(ex, 0, subprec-1));
X outop("||");
X wrexpr(ex->args[1], incompat(ex, 1, subprec-1));
X break;
X
X case EK_COND:
X setprec3(3);
X i = 0;
X for (;;) {
X i++;
X if (extraparens != 0)
X wrexpr(ex->args[0], 15);
X else
X wrexpr(ex->args[0], subprec);
X NICESPACE();
X output("\002?");
X NICESPACE();
X out_expr(ex->args[1]);
X if (ex->args[2]->kind == EK_COND) {
X NICESPACE();
X output("\002:");
X NICESPACE();
X ex = ex->args[2];
X } else {
X NICESPACE();
X output((i == 1) ? "\017:" : "\002:");
X NICESPACE();
X wrexpr(ex->args[2], subprec-1);
X break;
X }
X }
X break;
X
X case EK_ASSIGN:
X if (ex->args[1]->kind == EK_PLUS &&
X exprsame(ex->args[1]->args[0], ex->args[0], 2) &&
X ex->args[1]->args[1]->kind == EK_CONST &&
X ex->args[1]->args[1]->val.type->kind == TK_INTEGER &&
X abs(ex->args[1]->args[1]->val.i) == 1) {
X if (prec == 0 && postincrement) {
X setprec(15);
X wrexpr(ex->args[0], subprec);
X EXTRASPACE();
X if (ex->args[1]->args[1]->val.i == 1)
X output("++");
X else
X output("--");
X } else {
X setprec(14);
X if (ex->args[1]->args[1]->val.i == 1)
X output("++");
X else
X output("--");
X EXTRASPACE();
X wrexpr(ex->args[0], subprec-1);
X }
X } else {
X setprec2(2);
X checkbreak(breakbeforeassign);
X wrexpr(ex->args[0], subprec);
X ex2 = copyexpr(ex->args[1]);
X j = -1;
X switch (ex2->kind) {
X
X case EK_PLUS:
X case EK_TIMES:
X case EK_BAND:
X case EK_BOR:
X case EK_BXOR:
X for (i = 0; i < ex2->nargs; i++) {
X if (exprsame(ex->args[0], ex2->args[i], 2)) {
X j = i;
X break;
X }
X if (ex2->val.type->kind == TK_REAL)
X break; /* non-commutative */
X }
X break;
X
X case EK_DIVIDE:
X case EK_DIV:
X case EK_MOD:
X case EK_LSH:
X case EK_RSH:
X if (exprsame(ex->args[0], ex2->args[0], 2))
X j = 0;
X break;
X
X default:
X break;
X }
X if (j >= 0) {
X if (ex2->nargs == 2)
X ex2 = grabarg(ex2, 1-j);
X else
X delfreearg(&ex2, j);
X switch (ex->args[1]->kind) {
X
X case EK_PLUS:
X if (expr_looks_neg(ex2)) {
X outop("-=");
X ex2 = makeexpr_neg(ex2);
X } else
X outop("+=");
X break;
X
X case EK_TIMES:
X outop("*=");
X break;
X
X case EK_DIVIDE:
X case EK_DIV:
X outop("/=");
X break;
X
X case EK_MOD:
X outop("%=");
X break;
X
X case EK_LSH:
X outop("<<=");
X break;
X
X case EK_RSH:
X outop(">>=");
X break;
X
X case EK_BAND:
X outop("&=");
X break;
X
X case EK_BOR:
X outop("|=");
X break;
X
X case EK_BXOR:
X outop("^=");
X break;
X
X default:
X break;
X }
X } else {
X output(" ");
X outop3(breakbeforeassign, "=");
X output(" ");
X }
X if (extraparens != 0 &&
X (ex2->kind == EK_EQ || ex2->kind == EK_NE ||
X ex2->kind == EK_GT || ex2->kind == EK_LT ||
X ex2->kind == EK_GE || ex2->kind == EK_LE ||
X ex2->kind == EK_AND || ex2->kind == EK_OR))
X wrexpr(ex2, 16);
X else
X wrexpr(ex2, subprec-1);
X freeexpr(ex2);
X }
X break;
X
X case EK_COMMA:
X setprec3(1);
X for (i = 0; i < ex->nargs-1; i++) {
X wrexpr(ex->args[i], subprec);
X output(",\002");
X NICESPACE();
X }
X wrexpr(ex->args[ex->nargs-1], subprec);
X break;
X
X default:
X intwarning("wrexpr", "bad ex->kind [311]");
X }
X switch (parens) {
X case 1:
X output(")");
X break;
X case 2:
X output("\004");
X break;
X }
X}
X
X
X
X/* will parenthesize assignments and "," operators */
X
Xvoid out_expr(ex)
XExpr *ex;
X{
X wrexpr(ex, 2);
X}
X
X
X
X/* will not parenthesize anything at top level */
X
Xvoid out_expr_top(ex)
XExpr *ex;
X{
X wrexpr(ex, 0);
X}
X
X
X
X/* will parenthesize unless only writing a factor */
X
Xvoid out_expr_factor(ex)
XExpr *ex;
X{
X wrexpr(ex, 15);
X}
X
X
X
X/* will parenthesize always */
X
Xvoid out_expr_parens(ex)
XExpr *ex;
X{
X output("(");
X wrexpr(ex, 1);
X output(")");
X}
X
X
X
X/* evaluate expression for side effects only */
X/* no top-level parentheses */
X
Xvoid out_expr_stmt(ex)
XExpr *ex;
X{
X wrexpr(ex, 0);
X}
X
X
X
X/* evaluate expression for boolean (zero/non-zero) result only */
X/* parenthesizes like out_expr() */
X
Xvoid out_expr_bool(ex)
XExpr *ex;
X{
X wrexpr(ex, 2);
X}
X
X
X
X
X/* End. */
X
X
X
END_OF_FILE
if test 8365 -ne `wc -c <'src/pexpr.c.3'`; then
echo shar: \"'src/pexpr.c.3'\" unpacked with wrong size!
fi
# end of 'src/pexpr.c.3'
fi
if test -f 'src/turbo.imp' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/turbo.imp'\"
else
echo shar: Extracting \"'src/turbo.imp'\" \(9333 characters\)
sed "s/^X//" >'src/turbo.imp' <<'END_OF_FILE'
X
X{ Turbo Pascal standard units. For use with p2c. }
X
X{ Only partially complete! }
X
X
X
X
X{-------------------------------------------------------------------------}
X
Xunit printer;
X
Xinterface
X
Xvar
X lst : text;
X
Xend;
X
X
X
X
X{-------------------------------------------------------------------------}
X
Xunit dos;
X
Xinterface
X
Xconst
X FCarry = $0001; { 8086 flags }
X FParity = $0004;
X FAuxiliary = $0010;
X FZero = $0040;
X FSign = $0080;
X FOverflow = $0100;
X
X fmClosed = $D7B0; { File modes }
X fmInput = $D7B1;
X fmOutput = $D7B2;
X fmInOut = $D7B3;
X
X ReadOnly = $01; { File attributes }
X Hidden = $02;
X SysFile = $04;
X VolumeID = $08;
X Directory = $10;
X Archive = $20;
X AnyFile = $3F;
X
X
Xtype
X PathStr = string[79];
X DirStr = PathStr;
X NameStr = string[8];
X ExtStr = string[3];
X
X FileRec =
X record
X Handle: Word;
X Mode: Word;
X RecSize: Word;
X Private: array [1..26] of Byte;
X UserData: array [1..16] of Byte;
X Name: array [0..79] of char;
X end;
X
X TextBuf = array [0..127] of char;
X TextRec =
X record
X Handle: Word;
X Mode: Word;
X BufSize: Word;
X Private: Word;
X BufPos: Word;
X BufEnd: Word;
X BufPtr: ^TextBuf;
X OpenProc: Pointer;
X InOutProc: Pointer;
X FlushProc: Pointer;
X CloseProc: Pointer;
X UserData: array [1..16] of Byte;
X Name: array [0..79] of char;
X Buffer: TextBuf;
X end;
X
X Registers =
X record
X case integer of
X 0: (AX,BX,CX,DX,BP,SI,DI,ES,Flags: word);
X 1: (AL,AH,BL,BH,CL,CH,DL,DH: byte);
X end;
X
X DateTime =
X record
X Year, Month, Day, Hour, Min, Sec: word;
X end;
X
X SearchRec =
X record
X Fill: array [1..21] of byte;
X Attr: byte;
X Time: longint;
X Size: longint;
X Name: string[12];
X end;
X
X
Xvar
X DosError: integer;
X
Xprocedure GetTime(var hour, minute, second, csec : word);
Xprocedure GetDate(var year, month, day, dow : word);
Xprocedure FSplit(fn : PathStr; var dir, name, ext : string);
X
X{WarnNames=1}
Xprocedure Exec(path, cmdLine : PathStr);
X{WarnNames}
X
Xend;
X
X
X
X
X
X{-------------------------------------------------------------------------}
X
Xunit crt;
X
Xinterface
X
X
Xfunction KeyPressed : boolean;
Xfunction ReadKey : char;
X
Xprocedure ClrScr;
Xprocedure TextBackground(i : integer);
Xprocedure Window(a, b, c, d : integer);
X
Xvar wherex, wherey : integer;
X
Xend;
X
X
X
X
X
X{-------------------------------------------------------------------------}
X
Xunit graph;
X
Xinterface
X
Xconst
X gr0k = 0;
X grNoInitGraph = -1;
X grNotDetected = -2;
X grFileNotFound = -3;
X grInvalidDriver = -4;
X grNoLoadMem = -5;
X grNoScanMem = -6;
X grNoFloodMem = -7;
X grFontNotFound = -8;
X grNoFontMem = -9;
X grInvalidMode = -10;
X grError = -11;
X grIOerror = -13;
X grInvalidFontNum = -14;
X
X Detect = 0;
X CGA = 1;
X MCGA = 2;
X EGA = 3;
X EGA64 = 4;
X EGAMono = 5;
X IBM8514 = 6;
X HercMono = 7;
X ATT400 = 8;
X VGA = 9;
X PC3270 = 10;
X CurrentDriver = -128;
X
X CGAC0 = 0;
X CGAC1 = 1;
X CGAC2 = 2;
X CGAC3 = 3;
X CGAHi = 4;
X MCGAC0 = 0;
X MCGAC1 = 1;
X MCGAC2 = 2;
X MCGAC3 = 3;
X MCGAMed = 4;
X MCGAHi = 5;
X EGALo = 0;
X EGAHi = 1;
X EGA64Lo = 0;
X EGA64Hi = 1;
X EGAMonoHi = 3;
X HercMonoHi = 0;
X ATT400C0 = 0;
X ATT400C1 = 1;
X ATT400C2 = 2;
X ATT400C3 = 3;
X ATT400Med = 4;
X ATT400Hi = 5;
X VGALo = 0;
X VGAMed = 1;
X VGAHi = 2;
X PC3270Hi = 0;
X IBM8514LO = 0;
X IBM8514HI = 1;
X
X Black = 0;
X Blue = 1;
X Green = 2;
X Cyan = 3;
X Red = 4;
X Magenta = 5;
X Brown = 6;
X LightGray = 7;
X DarkGray = 8;
X LightBlue = 9;
X LightGreen = 10;
X LightCyan = 11;
X LightRed = 12;
X LightMagenta = 13;
X Yellow = 14;
X White = 15;
X
X SolidLn = 0;
X DottedLn = 1;
X CenterLn = 2;
X DashedLn = 3;
X UserBitLn = 4;
X
X NormWidth = 1;
X ThickWidth = 3;
X
X
Xtype
X ArcCoordsType = record
X X, Y: integer;
X Xstart, Ystart: integer;
X Xend, Yend: integer;
X end;
X
Xconst
X MaxColors = 15;
Xtype
X PaletteType = record
X Size: byte;
X Colors: array[0..MaxColors] of shortint;
X end;
X FillPatternType = array[1..8] of byte;
X FillSettingsType = record
X Pattern: word;
X Color: word;
X end;
X LineSettingsType = record
X LineStyle: word;
X Pattern: word;
X Thickness: word;
X end;
X TextSettingsType = record
X Font: word;
X Direction: word;
X CharSize: word;
X Horiz: word;
X Vert: word;
X end;
X ViewPortType = record
X x1, y1, x2, y2: integer;
X Clip: boolean;
X end;
X
Xconst
X LeftText = 0;
X CenterText = 1;
X RightText = 2;
X BottomText = 0;
X TopText = 2;
X
Xconst
X ClipOn = true;
X ClipOff = false;
X
Xconst
X EmptyFill = 0;
X SolidFill = 1;
X LineFill = 2;
X LtSlashFill = 3;
X SlashFill = 4;
X BkSlashFill = 5;
X LtBkSlashFill = 6;
X HatchFill = 7;
X XHatchFill = 8;
X InterleaveFill = 9;
X WideDotFill = 10;
X CloseDotFill = 11;
X UserFill = 17;
X
Xconst
X NormalPut = 0;
X CopyPut = 0;
X XORPut = 1;
X OrPut = 2;
X AndPut = 3;
X NotPut = 4;
X
X
Xprocedure Arc(X, Y: integer; StAngle, EndAngle, Radius: word);
Xprocedure Bar(x1, y1, x2, y2: integer);
Xprocedure Bar3D(x1, y1, x2, y2: integer; Depth: word; Top: boolean);
Xprocedure Circle(X, Y: integer; Radius: word);
Xprocedure ClearDevice;
Xprocedure ClearViewPort;
Xprocedure CloseGraph;
Xprocedure DetectGraph(var GraphDriver, GraphMode: integer);
Xprocedure DrawPoly(NumPoints: word; var PolyPoints);
Xprocedure Ellipse(X, Y: integer; StAngle, EndAngle: word;
X XRadius, YRadius: word);
Xprocedure FillEllipse(X, Y: integer; XRadius, YRadius: word);
Xprocedure FillPoly(NumPoints: word; var PolyPoints);
Xprocedure FloodFill(x, y: integer; Border: word);
Xprocedure GetArcCoords(var ArcCoords: ArcCoordsType);
Xprocedure GetAspectRatio(var Xasp, Yasp: word);
Xfunction GetBkColor: word;
Xfunction GetColor: word;
Xfunction GetDefaultPalette(var Palette: PaletteType): PaletteType;
Xfunction GetDriverName: string;
Xprocedure GetFillPattern(var FillPattern: FillPatternType);
Xprocedure GetFillSettings(var FillInfo: FillSettingsType);
Xfunction GetGraphMode: integer;
Xprocedure GetImage(x1, y1, x2, y2: integer; var BitMap);
Xprocedure GetLineSettings(var LineInfo: LineSettingsType);
Xfunction GetMaxColor: word;
Xfunction GetMaxMode: word;
Xfunction GetMaxX: integer;
Xfunction GetMaxY: integer;
Xfunction GetModeName(ModeNumber: integer): string;
Xprocedure GetModeRange(GraphDriver: integer; var LoMode, HiMode: integer);
Xprocedure GetPalette(var Palette: PaletteType);
Xfunction GetPaletteSize: integer;
Xfunction GetPixel(X,Y: integer): word;
Xprocedure GetTextSettings(var TextInfo: TextSettingsType);
Xprocedure GetViewSettings(var ViewPort: ViewPortType);
Xfunction GetX: integer;
Xfunction GetY: integer;
Xprocedure GraphDefaults;
Xfunction GraphErrorMsg(ErrorCode: integer): string;
Xfunction GraphResult: integer;
Xfunction ImageSize(x1, y1, x2, y2: integer): word;
Xprocedure InitGraph(var GraphDriver: integer; var GraphMode: integer;
X PathToDriver: string);
Xfunction InstallUserDriver(Name: string; AutoDetectPtr: pointer): integer;
Xfunction InstallUserFont(FontFileName: string): integer;
Xprocedure Line(x1, y1, x2, y2: integer);
Xprocedure LineRel(Dx, Dy: integer);
Xprocedure LineTo(x, y: integer);
Xprocedure MoveRel(Dx, Dy: integer);
Xprocedure MoveTo(x, y: integer);
Xprocedure OutText(TextString: string);
Xprocedure OutTextXY(X,Y: integer; TextString: string);
Xprocedure PieSlice(x, y: integer; StAngle, EndAngle, Radius: word);
Xprocedure PutImage(x, y: integer; var BitMap; BitBlt: word);
Xprocedure PutPixel(x, y: integer; Pixel: word);
Xprocedure Rectangle(x1, y1, x2, y2: integer);
Xfunction RegisterBGIdriver(driver: pointer): integer;
Xfunction RegisterBGIfont(font: pointer): integer;
Xprocedure RestoreCrtMode;
Xprocedure Sector(x, y: integer; StAngle, EndAngle, XRadius, YRadius: word);
Xprocedure SetActivePage(Page: word);
Xprocedure SetAllPalette(var Palette);
Xprocedure SetAspectRatio(Xasp, Yasp: word);
Xprocedure SetBkColor(ColorNum: word);
Xprocedure SetColor(Color: word);
Xprocedure SetFillPattern(Pattern: FillPatternType; Color: word);
Xprocedure SetFillStyle(Pattern: word; Color: word);
Xprocedure SetGraphBufSize(BufSize: word);
Xprocedure SetGraphMode(Mode: integer);
Xprocedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word);
Xprocedure SetPalette(ColorNum: word; Color: shortint);
Xprocedure SetRGBPalette(ColorNum, RedValue, GreenValue, BlueValue: integer);
Xprocedure SetTextJustify(Horiz, Vert: word);
Xprocedure SetTextStyle(Font: word; Direction: word; CharSize: word);
Xprocedure SetUserCharSize(MultX, DivX, MultY, DivY: word);
Xprocedure SetViewPort(x1, y1, x2, y2: integer; Clip: boolean);
Xprocedure SetVisualPage(Page: word);
Xprocedure SetWriteMode(WriteMode: integer);
Xfunction TextHeight(TextString: string): word;
Xfunction TextWidth(TextString: string): word;
X
X
Xend;
END_OF_FILE
if test 9333 -ne `wc -c <'src/turbo.imp'`; then
echo shar: \"'src/turbo.imp'\" unpacked with wrong size!
fi
# end of 'src/turbo.imp'
fi
echo shar: End of archive 3 \(of 32\).
cp /dev/null ark3isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 32 archives.
echo "Now see PACKNOTES and the README"
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.