Path: utzoo!utgpu!news-server.csri.toronto.edu!mailrus!umich!yale!mintaka!mit-eddie!bbn.com!papaya.bbn.com!rsalz From: rsalz@uunet.uu.net (Rich Salz) Newsgroups: comp.sources.unix Subject: v22i035: Update kit for p2c Pascal to C translator, Part02/02 Message-ID: <2515@papaya.bbn.com> Date: 8 May 90 13:11:22 GMT Lines: 695 Approved: rsalz@uunet.UU.NET X-Checksum-Snefru: e1acef03 5743dae4 f13a77d6 22188d02 Submitted-by: David Gillespie 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 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@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@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<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@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@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@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@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@uunet.uu.net. Use a domain-based address or give alternate paths, or you may lose out.