home *** CD-ROM | disk | FTP | other *** search
- Subject: v21i048: Pascal to C translator, Part03/32
- Newsgroups: comp.sources.unix
- Approved: rsalz@uunet.UU.NET
- X-Checksum-Snefru: 015b3e95 44ab8f6b fa8e469b dbeb8707
-
- 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
-