v22i035: Update kit for p2c Pascal to C translator, Part02/02
Rich Salz
rsalz at uunet.uu.net
Tue May 8 23:11:22 AEST 1990
Submitted-by: David Gillespie <daveg at csvax.caltech.edu>
Posting-number: Volume 22, Issue 35
Archive-name: p2cpatches/part02
The following patches convert p2c version 1.15 into p2c version 1.16. To
apply them automatically with Patch v2.0, first cd into your p2c
distribution directory (with subdirectories src, examples, etc.), then
execute "patch -p0 <p2c.patch", where "p2c.patch" is name of this file,
then "cd src" and execute "make install".
These patches do not cover the example files, nor reproducible files
such as "p2c.hdrs" and "p2c.cat". Those files will be rebuilt by
"make install".
Enjoy!
-- Dave
Dave Gillespie
256-80 Caltech, Pasadena CA 91125
daveg at csvax.caltech.edu, ...!cit-vax!daveg
*** README Fri Apr 13 21:05:13 1990
--- ../dist/README Tue May 1 00:10:04 1990
***************
*** 1,5 ****
! This directory contains "p2c" version 1.15, a Pascal to C translator.
"p2c" Copyright 1989 Dave Gillespie
256-80 Caltech
--- 1,5 ----
! This directory contains "p2c" version 1.16, a Pascal to C translator.
"p2c" Copyright 1989 Dave Gillespie
256-80 Caltech
Files Makefile and ../dist/Makefile are identical
Files src/COPYING and ../dist/src/COPYING are identical
diff -c -N -r -s src/HISTORY ../dist/src/HISTORY
*** src/HISTORY Fri Apr 13 21:04:41 1990
--- ../dist/src/HISTORY Tue May 1 00:09:28 1990
***************
*** 4,9 ****
--- 4,28 ----
------- -- ------- -- ---
+ Version 1.16:
+
+ * Reduced wasteful proliferation of identical-looking temporary variables.
+
+ * Improved heuristic for determining allocation size for set constructors.
+
+ * Corrected handling for EOF applied to buffered binary files.
+
+ * Bug fix in decl.c: Handled a rare case involving forward-declared pointers.
+
+ * Bug fix in p2clib.c:P_remset: Forgot to fix s[0] if highest bit was cleared.
+
+ * Bug fix in p2clib.c:P_setxor: Forgot to fix s[0] if highest bits cancelled.
+
+ * Added to sys.p2crc/trans.h the following configuration parameters:
+
+ EofBufName Macro to use for EOF of a bufffered file.
+ FilePosBufName Macro to use for FILEPOS or POSITION of a buffered file.
+
Version 1.15:
* Taught the line breaker to handle logical/relational operators specially.
Files src/Makefile and ../dist/src/Makefile are identical
Files src/NOTES and ../dist/src/NOTES are identical
Files src/README and ../dist/src/README are identical
Files src/citmods.c and ../dist/src/citmods.c are identical
Files src/comment.c and ../dist/src/comment.c are identical
diff -c -N -r -s src/decl.c ../dist/src/decl.c
*** src/decl.c Fri Apr 13 21:04:49 1990
--- ../dist/src/decl.c Tue May 1 00:09:41 1990
***************
*** 1250,1255 ****
--- 1250,1257 ----
switch (type->kind) {
case TK_POINTER:
+ if (type->smin) /* unresolved forward */
+ return type;
if (type->basetype == tp_void) { /* ANYPTR */
if (tp_special_anyptr)
return tp_special_anyptr; /* write "Anyptr" */
***************
*** 1774,1782 ****
if (type == tp_char)
return tp_ubyte;
if (type->kind == TK_POINTER) {
! if (type->basetype->kind == TK_ARRAY ||
! type->basetype->kind == TK_STRING ||
! type->basetype->kind == TK_SET)
return makepointertype(canonicaltype(type->basetype->basetype));
else if (type->basetype == tp_void)
return (voidstar) ? tp_anyptr : makepointertype(tp_abyte);
--- 1776,1786 ----
if (type == tp_char)
return tp_ubyte;
if (type->kind == TK_POINTER) {
! if (type->smin)
! return type;
! else if (type->basetype->kind == TK_ARRAY ||
! type->basetype->kind == TK_STRING ||
! type->basetype->kind == TK_SET)
return makepointertype(canonicaltype(type->basetype->basetype));
else if (type->basetype == tp_void)
return (voidstar) ? tp_anyptr : makepointertype(tp_abyte);
***************
*** 1789,1797 ****
--- 1793,1837 ----
}
+ int identicaltypes(t1, t2)
+ Type *t1, *t2;
+ {
+ if (t1 == t2)
+ return 1;
+ if (t1->kind == t2->kind) {
+ if (t1->kind == TK_SUBR)
+ return (identicaltypes(t1->basetype, t2->basetype) &&
+ exprsame(t1->smin, t2->smin, 2) &&
+ exprsame(t1->smax, t2->smax, 2));
+ if (t1->kind == TK_SET ||
+ t1->kind == TK_SMALLSET)
+ return (exprsame(t1->indextype->smax,
+ t2->indextype->smax, 2));
+ if (t1->kind == TK_ARRAY ||
+ t1->kind == TK_STRING ||
+ t1->kind == TK_SMALLARRAY)
+ return (identicaltypes(t1->basetype, t2->basetype) &&
+ identicaltypes(t1->indextype, t2->indextype) &&
+ t1->structdefd == t2->structdefd &&
+ ((!t1->smin && !t2->smin) ||
+ (t1->smin && t2->smin &&
+ exprsame(t1->smin, t2->smin, 2))) &&
+ ((!t1->smax && !t2->smax) ||
+ (t1->smax && t2->smax &&
+ exprsame(t1->smax, t2->smax, 2) &&
+ t1->escale == t2->escale &&
+ t1->issigned == t2->issigned)));
+ }
+ return 0;
+ }
+
+
int similartypes(t1, t2)
Type *t1, *t2;
{
+ if (debug > 3) { fprintf(outf, "identicaltypes("); dumptypename(t1,1); fprintf(outf, ","); dumptypename(t2,1); fprintf(outf, ") = %d\n", identicaltypes(t1, t2)); }
+ if (identicaltypes(t1, t2))
+ return 1;
t1 = canonicaltype(t1);
t2 = canonicaltype(t2);
return (t1 == t2);
***************
*** 1857,1865 ****
default:
if (findbasetype(tp1, flags) != findbasetype(tp2, flags))
return 0;
! while (tp1->kind == TK_POINTER && tp1->basetype)
tp1 = tp1->basetype;
! while (tp2->kind == TK_POINTER && tp2->basetype)
tp2 = tp2->basetype;
return (tp1 == tp2);
}
--- 1897,1905 ----
default:
if (findbasetype(tp1, flags) != findbasetype(tp2, flags))
return 0;
! while (tp1->kind == TK_POINTER && !tp1->smin && tp1->basetype)
tp1 = tp1->basetype;
! while (tp2->kind == TK_POINTER && !tp2->smin && tp2->basetype)
tp2 = tp2->basetype;
return (tp1 == tp2);
}
***************
*** 2103,2109 ****
break;
default:
! if (type->meaning && type->meaning->kind == MK_TYPE &&
type->meaning->wasdeclared) {
output(type->meaning->name);
} else {
--- 2143,2153 ----
break;
default:
! if (type->kind == TK_POINTER && type->smin) {
! note("Forward pointer reference assumes struct type [323]");
! output("struct ");
! output(format_s(name_STRUCT, type->smin->val.s));
! } else if (type->meaning && type->meaning->kind == MK_TYPE &&
type->meaning->wasdeclared) {
output(type->meaning->name);
} else {
***************
*** 3582,3587 ****
--- 3626,3632 ----
pd->next = ptrbase;
ptrbase = pd;
tp->basetype = tp_abyte;
+ tp->smin = makeexpr_name(curtokcase, tp_integer);
anydeferredptrs = 1;
gettok();
} else {
***************
*** 4331,4337 ****
case TK_SMALLSET:
case TK_SET:
if (curtok == TOK_LBR)
! return p_setfactor(type);
break;
default:
--- 4376,4382 ----
case TK_SMALLSET:
case TK_SET:
if (curtok == TOK_LBR)
! return p_setfactor(type, 1);
break;
default:
***************
*** 4548,4554 ****
tp->meaning->ctx && tp->meaning->ctx != nullctx) {
pd = ptrbase; /* Do this now, just in case */
while (pd) {
! if (pd->tp->basetype == tp_abyte) {
mp2 = pd->sym->mbase;
while (mp2 && !mp2->isactive)
mp2 = mp2->snext;
--- 4593,4600 ----
tp->meaning->ctx && tp->meaning->ctx != nullctx) {
pd = ptrbase; /* Do this now, just in case */
while (pd) {
! if (pd->tp->smin && pd->tp->basetype == tp_abyte) {
! pd->tp->smin = NULL;
mp2 = pd->sym->mbase;
while (mp2 && !mp2->isactive)
mp2 = mp2->snext;
***************
*** 4701,4707 ****
deferallptrs = 0;
while (ptrbase) {
pd = ptrbase;
! if (pd->tp->basetype == tp_abyte) {
mp = pd->sym->mbase;
while (mp && !mp->isactive)
mp = mp->snext;
--- 4747,4754 ----
deferallptrs = 0;
while (ptrbase) {
pd = ptrbase;
! if (pd->tp->smin && pd->tp->basetype == tp_abyte) {
! pd->tp->smin = NULL;
mp = pd->sym->mbase;
while (mp && !mp->isactive)
mp = mp->snext;
Files src/dir.c and ../dist/src/dir.c are identical
Files src/expr.c and ../dist/src/expr.c are identical
diff -c -N -r -s src/funcs.c ../dist/src/funcs.c
*** src/funcs.c Fri Apr 13 21:04:53 1990
--- ../dist/src/funcs.c Tue May 1 00:09:45 1990
***************
*** 1635,1641 ****
int code;
{
Expr *ex2 = NULL, *ex3 = NULL;
! Meaning *tvar = NULL;
if (FCheck(checkfileisopen) && !is_std_file(ex)) {
if (exprspeed(ex) < 5 && nosideeffects(ex, 0)) {
--- 1635,1641 ----
int code;
{
Expr *ex2 = NULL, *ex3 = NULL;
! Meaning *tvar = NULL, *mp;
if (FCheck(checkfileisopen) && !is_std_file(ex)) {
if (exprspeed(ex) < 5 && nosideeffects(ex, 0)) {
***************
*** 1650,1656 ****
switch (code) {
case 0: /* eof */
! if (*eofname)
ex = makeexpr_bicall_1(eofname, tp_boolean, ex);
else
ex = makeexpr_rel(EK_NE, makeexpr_bicall_1("feof", tp_int, ex),
--- 1650,1660 ----
switch (code) {
case 0: /* eof */
! if ((mp = isfilevar(ex)) != NULL &&
! mp->bufferedfile &&
! *eofbufname)
! ex = makeexpr_bicall_1(eofbufname, tp_boolean, ex);
! else if (*eofname)
ex = makeexpr_bicall_1(eofname, tp_boolean, ex);
else
ex = makeexpr_rel(EK_NE, makeexpr_bicall_1("feof", tp_int, ex),
***************
*** 1662,1668 ****
break;
case 2: /* position or filepos */
! ex = makeexpr_bicall_1(fileposname, tp_integer, ex);
break;
case 3: /* maxpos or filesize */
--- 1666,1677 ----
break;
case 2: /* position or filepos */
! if ((mp = isfilevar(ex)) != NULL &&
! mp->bufferedfile &&
! *fileposbufname)
! ex = makeexpr_bicall_1(fileposbufname, tp_boolean, ex);
! else
! ex = makeexpr_bicall_1(fileposname, tp_integer, ex);
break;
case 3: /* maxpos or filesize */
Files src/hpmods.c and ../dist/src/hpmods.c are identical
Files src/lex.c and ../dist/src/lex.c are identical
Files src/loc.p2clib.c and ../dist/src/loc.p2clib.c are identical
Files src/loc.p2crc and ../dist/src/loc.p2crc are identical
Files src/makeproto.c and ../dist/src/makeproto.c are identical
Files src/out.c and ../dist/src/out.c are identical
diff -c -N -r -s src/p2c.h ../dist/src/p2c.h
*** src/p2c.h Fri Apr 13 21:04:56 1990
--- ../dist/src/p2c.h Tue May 1 00:09:51 1990
***************
*** 4,10 ****
/* Header file for code generated by "p2c", the Pascal-to-C translator */
! /* "p2c" Copyright (C) 1989 Dave Gillespie, version 1.15.
* This file may be copied, modified, etc. in any way. It is not restricted
* by the licence agreement accompanying p2c itself.
*/
--- 4,10 ----
/* Header file for code generated by "p2c", the Pascal-to-C translator */
! /* "p2c" Copyright (C) 1989 Dave Gillespie, version 1.16.
* This file may be copied, modified, etc. in any way. It is not restricted
* by the licence agreement accompanying p2c itself.
*/
***************
*** 317,322 ****
--- 317,325 ----
#define PUT(f,type) (fwrite(&__CAT__(f,_BUFFER),sizeof(type),1,(f)), \
(__CAT__(f,_BFLAGS) = 0))
#define CPUT(f) (PUT(f,char))
+
+ #define BUFEOF(f) (__CAT__(f,_BFLAGS) != 2 && P_eof(f))
+ #define BUFFPOS(f) (ftell(f) - (__CAT__(f,_BFLAGS) == 2))
/* Memory allocation */
#ifdef __GCC__
diff -c -N -r -s src/p2c.man ../dist/src/p2c.man
*** src/p2c.man Fri Apr 13 21:04:42 1990
--- ../dist/src/p2c.man Tue May 1 00:09:31 1990
***************
*** 1,7 ****
.\" p2c Copyright 1989 Dave Gillespie
.TH P2C 1 "local"
.SH NAME
! p2c \- Pascal to C translator, version 1.15
.SH SYNOPSIS
.B p2c
[ options ] [ file [ module ] ]
--- 1,7 ----
.\" p2c Copyright 1989 Dave Gillespie
.TH P2C 1 "local"
.SH NAME
! p2c \- Pascal to C translator, version 1.16
.SH SYNOPSIS
.B p2c
[ options ] [ file [ module ] ]
***************
*** 1493,1500 ****
.SH AUTHOR
Dave Gillespie, daveg at csvax.caltech.edu.
.PP
! Many thanks to William Bader, Rick Koshi, Eric Raymond, Magne Haveraaen,
! Dirk Grunwald, David Barto, Paul Fisher, and others whose suggestions and
! bug reports have helped improve
.I p2c
in countless ways.
--- 1493,1500 ----
.SH AUTHOR
Dave Gillespie, daveg at csvax.caltech.edu.
.PP
! Many thanks to William Bader, Steven Levi, Rick Koshi, Eric Raymond,
! Magne Haveraaen, Dirk Grunwald, David Barto, Paul Fisher, and others whose
! suggestions and bug reports have helped improve
.I p2c
in countless ways.
diff -c -N -r -s src/p2clib.c ../dist/src/p2clib.c
*** src/p2clib.c Fri Apr 13 21:04:55 1990
--- ../dist/src/p2clib.c Tue May 1 00:09:47 1990
***************
*** 577,583 ****
*d++ = *s1++;
while (--sz2 >= 0)
*d++ = *s2++;
! *dbase = d - dbase - 1;
return dbase;
}
--- 577,584 ----
*d++ = *s1++;
while (--sz2 >= 0)
*d++ = *s2++;
! while (--d > dbase && !*d) ;
! *dbase = d - dbase;
return dbase;
}
***************
*** 656,663 ****
register int bit;
bit = val % SETBITS;
val /= SETBITS;
! if (++val <= *s)
! s[val] &= ~(1<<bit);
return s;
}
--- 657,667 ----
register int bit;
bit = val % SETBITS;
val /= SETBITS;
! if (++val <= *s) {
! if (!(s[val] &= ~(1<<bit)))
! while (*s && !s[*s])
! (*s)--;
! }
return s;
}
Files src/parse.c and ../dist/src/parse.c are identical
diff -c -N -r -s src/pexpr.c ../dist/src/pexpr.c
*** src/pexpr.c Fri Apr 13 21:04:52 1990
--- ../dist/src/pexpr.c Tue May 1 00:09:44 1990
***************
*** 469,485 ****
#define MAXSETLIT 400
! Expr *p_setfactor(type)
! Type *type;
{
Expr *ex, *exmax = NULL, *ex2;
Expr *first[MAXSETLIT], *last[MAXSETLIT];
char doneflag[MAXSETLIT];
int i, j, num, donecount;
! int isconst, guesstype = 0;
long maxv, max2;
Value val;
! Type *tp;
Meaning *tvar;
if (curtok == TOK_LBRACE)
--- 469,486 ----
#define MAXSETLIT 400
! Expr *p_setfactor(target, sure)
! Type *target;
! int sure;
{
Expr *ex, *exmax = NULL, *ex2;
Expr *first[MAXSETLIT], *last[MAXSETLIT];
char doneflag[MAXSETLIT];
int i, j, num, donecount;
! int isconst, guesstype;
long maxv, max2;
Value val;
! Type *tp, *type;
Meaning *tvar;
if (curtok == TOK_LBRACE)
***************
*** 493,500 ****
val.s = NULL;
return makeexpr_val(val);
}
! if (!type)
! guesstype = 1;
maxv = -1;
isconst = 1;
num = 0;
--- 494,501 ----
val.s = NULL;
return makeexpr_val(val);
}
! type = target;
! guesstype = !sure;
maxv = -1;
isconst = 1;
num = 0;
***************
*** 510,516 ****
}
if (guesstype && num == 0) {
ex = p_ord_expr();
! type = ord_type(ex->val.type);
} else {
ex = p_expr(type);
}
--- 511,517 ----
}
if (guesstype && num == 0) {
ex = p_ord_expr();
! type = ex->val.type;
} else {
ex = p_expr(type);
}
***************
*** 550,561 ****
gettok();
else if (!wneedtok(TOK_RBR))
skippasttotoken(TOK_RBR, TOK_SEMI);
! tp = ord_type(first[0]->val.type);
if (guesstype) { /* must determine type */
! if (!exmax || maxv == LONG_MAX) {
! maxv = defaultsetsize-1;
! if (ord_range(tp, NULL, &max2) && maxv > max2)
maxv = max2;
exmax = makeexpr_long(maxv);
} else
exmax = copyexpr(exmax);
--- 551,566 ----
gettok();
else if (!wneedtok(TOK_RBR))
skippasttotoken(TOK_RBR, TOK_SEMI);
! tp = first[0]->val.type;
if (guesstype) { /* must determine type */
! if (maxv == LONG_MAX) {
! if (target && ord_range(target, NULL, &max2))
! maxv = max2;
! else if (ord_range(tp, NULL, &max2) && max2 < 1000000 &&
! (max2 >= defaultsetsize || num == 1))
maxv = max2;
+ else
+ maxv = defaultsetsize-1;
exmax = makeexpr_long(maxv);
} else
exmax = copyexpr(exmax);
***************
*** 1122,1128 ****
case TOK_LBR:
case TOK_LBRACE:
! return p_setfactor(NULL);
case TOK_NIL:
gettok();
--- 1127,1134 ----
case TOK_LBR:
case TOK_LBRACE:
! return p_setfactor(target && target->kind == TK_SET
! ? target->indextype : NULL, 0);
case TOK_NIL:
gettok();
***************
*** 1160,1166 ****
case TK_SET:
case TK_SMALLSET:
! return p_setfactor(type->indextype);
case TK_RECORD:
return p_constrecord(type, 0);
--- 1166,1172 ----
case TK_SET:
case TK_SMALLSET:
! return p_setfactor(type->indextype, 1);
case TK_RECORD:
return p_constrecord(type, 0);
Files src/string.pas and ../dist/src/string.pas are identical
Files src/stuff.c and ../dist/src/stuff.c are identical
diff -c -N -r -s src/sys.p2crc ../dist/src/sys.p2crc
*** src/sys.p2crc Fri Apr 13 21:04:44 1990
--- ../dist/src/sys.p2crc Tue May 1 00:09:36 1990
***************
*** 1,4 ****
! # Standard configuration file for "p2c" 1.15, the Pascal to C translator
# Copyright (C) 1989 David Gillespie.
# Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
--- 1,4 ----
! # Standard configuration file for "p2c" 1.16, the Pascal to C translator
# Copyright (C) 1989 David Gillespie.
# Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
***************
*** 1518,1523 ****
--- 1518,1527 ----
ArrayPutFBufName APUTFBUF # A special PutFBuf for files of arrays.
ArrayPutName # A special Put for files of arrays.
+
+ EofBufName BUFEOF # Name of a macro for "eof" of a buffered file.
+
+ FilePosBufName BUFFPOS # Name of a macro for buffered "filepos".
Files src/system.imp and ../dist/src/system.imp are identical
Files src/system.m2 and ../dist/src/system.m2 are identical
Files src/trans.c and ../dist/src/trans.c are identical
diff -c -N -r -s src/trans.h ../dist/src/trans.h
*** src/trans.h Fri Apr 13 21:04:57 1990
--- ../dist/src/trans.h Tue May 1 00:09:54 1990
***************
*** 1,4 ****
! /* "p2c", a Pascal to C translator, version 1.15.
Copyright (C) 1989 David Gillespie.
Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
--- 1,4 ----
! /* "p2c", a Pascal to C translator, version 1.16.
Copyright (C) 1989 David Gillespie.
Author's address: daveg at csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
***************
*** 134,140 ****
extern char *p2c_home;
#endif
! #define P2C_VERSION "1.15"
--- 134,140 ----
extern char *p2c_home;
#endif
! #define P2C_VERSION "1.16"
***************
*** 530,535 ****
--- 530,536 ----
*
* TK_POINTER: Pointer type.
* tp->basetype => Base type of pointer.
+ * tp->smin => EK_NAME for type if not-yet-resolved forward; else NULL.
* Only one pointer type is ever generated for a given other type;
* each tp->pointertype points back to that type if it has been generated.
*
***************
*** 1030,1035 ****
--- 1031,1037 ----
extern char putfbufname[40], charputfbufname[40], arrayputfbufname[40];
extern char getname[40], chargetname[40], arraygetname[40];
extern char putname[40], charputname[40], arrayputname[40];
+ extern char eofbufname[40], fileposbufname[40];
extern char storebitsname[40], signextname[40];
extern char filenotfoundname[40], filenotopenname[40];
extern char filewriteerrorname[40], badinputformatname[40], endoffilename[40];
***************
*** 1592,1597 ****
--- 1594,1601 ----
'C', 'V', "PUTNAME", (anyptr) putname, 40,
'C', 'V', "CHARPUTNAME", (anyptr) charputname, 40,
'C', 'V', "ARRAYPUTNAME", (anyptr) arrayputname, 40,
+ 'C', 'V', "EOFBUFNAME", (anyptr) eofbufname, 40,
+ 'C', 'V', "FILEPOSBUFNAME", (anyptr) fileposbufname, 40,
/* RANGE CHECKING */
'S', 'V', "CASECHECK", (anyptr) &casecheck, 0,
Files src/turbo.imp and ../dist/src/turbo.imp are identical
exit 0 # Just in case...
--
Please send comp.sources.unix-related mail to rsalz at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
More information about the Comp.sources.unix
mailing list