v13i067: Patches for Pascal-to-C translator
Rich Salz
rsalz at bbn.com
Wed Feb 24 21:00:49 AEST 1988
Submitted-by: Per Bergsten <mcvax!enea!chalmers!holtec!perb>
Posting-number: Volume 13, Issue 67
Archive-name: pas2c.pch
The following diffs adress all errors in the Pascal-to-C-translator that have
been reported to me. The translator was posted during summer -87 and a few
bug-reports came in during August. I have had no reports since late September
which I take to mean that either nobody has found any use for the program or
that there are no remaining serious problems.
Happily, with one exception, no report concerned cases where the translator
silently produced wrong code. There were some cases where the translator would
fail or where it generated code that was syntactically incorrect.
The exception concerned the status of "input" before the program had tested
"eof". This was actually a "feature" since the behaviour was intended (though
not formally correct).
Comments, questions etc to:
Per Bergsten
perb at holtec.se (....mcvax!enea!chalmers!holtec!perb)
perb%holtec.uucp at chalmers.csnet
-------------------------------------------------------------------------------
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# READ_ME
# ptc.diff
export PATH; PATH=/bin:$PATH
if test -f 'READ_ME'
then
echo shar: will not over-write existing file "'READ_ME'"
else
cat << \SHAR_EOF > 'READ_ME'
The following problems have been adressed.
1) In some circumstances the reader misread 1..n which lead to
a complaint about malplaced floating point numbers.
2) The translator generated double "->" arrows for references to
VAR-parameters that were pointers.
3) Missing initialisation of pointers in a record variant for
case-statements sometimes caused the translator to crash.
4) Calling "write" with a boolean literal as parameter caused the
translator to crash.
5) Initialization of input. Programs that read input before
testing for eof can be made to work by defining a compiletime
constant STDINIT otherwise the first returned character will
be null.
6) The code generated for procedurecalls with string-literal
parameters could cause the resulting program to crash due to
alignment errors. This is truly a PATCH, i.e. the "correct"
solution would require a redesign of the translator.
In this case the problem has been swept under the carpet at
the cost of some runtime overhead by copying data.
The behaviour of the translator is controlled by a boolean
constant "align" which, if true, cuses the translator to
generate calls to to functions STRALIGN and SETALIGN.
STRALIGN and SETALIGN are macros which by default call simple
subroutines that will copy data to well aligned structures.
7) Types and variables in nested procedures were not always moved
to an enclosing scope when the procedures were un-nested.
8) The I/O macros were modified so that "rewind" was replaced by
"fseek" and so that the generated code is type-correct.
9) The translator didn't handle incomplete Pascal programs as
documented.
10) A few changes were made to remove illegal Pascal-code.
SHAR_EOF
fi # end of overwriting check
if test -f 'ptc.diff'
then
echo shar: will not over-write existing file "'ptc.diff'"
else
cat << \SHAR_EOF > 'ptc.diff'
*** ptc.p Fri Nov 13 18:45:21 1987
--- nptc.p Fri Nov 13 18:44:29 1987
***************
*** 42,48 ****
(** The code generated by the translator assumes that there is a **)
(** C-implementation with at least a reasonable <stdio> library **)
(** since all input/output is implemented in terms of C functions **)
! (** like fprintf(), getc(), fopen(), rewind() etc. **)
(** If the source-program uses Pascal functions like sin(), sqrt() **)
(** etc, there must also exist such functions in the C-library. **)
(** **)
--- 42,48 ----
(** The code generated by the translator assumes that there is a **)
(** C-implementation with at least a reasonable <stdio> library **)
(** since all input/output is implemented in terms of C functions **)
! (** like fprintf(), getc(), fopen(), fseek() etc. **)
(** If the source-program uses Pascal functions like sin(), sqrt() **)
(** etc, there must also exist such functions in the C-library. **)
(** **)
***************
*** 53,59 ****
label 9999; (* end of program *)
! const version = '@(#)ptc.p 1.5 Date 87/05/01';
keytablen = 38; (* nr of keywords *)
keywordlen = 10; (* length of a keyword *)
--- 53,59 ----
label 9999; (* end of program *)
! const version = '@(#)ptc.p 2.6 Date 87/09/12';
keytablen = 38; (* nr of keywords *)
keywordlen = 10; (* length of a keyword *)
***************
*** 67,75 ****
setbits = 15; (* CPU *)
(* a Pascal file is implemented as a struct which (among other *)
! (* things) contain a flag-field, currently 3 bits are used *)
filebits = 'unsigned short'; (* flags for files *)
! filefill = 12; (* 16 less used 3 bits *)
maxsetrange = 15; (* nr of words in a set *)
scalbase = 0; (* ordinal value of first scalar member *)
--- 67,75 ----
setbits = 15; (* CPU *)
(* a Pascal file is implemented as a struct which (among other *)
! (* things) contain a flag-field, currently 4 bits are used *)
filebits = 'unsigned short'; (* flags for files *)
! filefill = 12; (* 16 less used 4 bits *)
maxsetrange = 15; (* nr of words in a set *)
scalbase = 0; (* ordinal value of first scalar member *)
***************
*** 106,111 ****
--- 106,112 ----
temporary files for reset/rewrite, the last character is supplied
by the reset/rewrite routine *)
tmpfilename = '"/tmp/ptc%d%c", getpid(), '; (* OS *)
+ maxfilename = 'MAXFILENAME';
(* some frequently used characters *)
space = ' ';
***************
*** 146,151 ****
--- 147,154 ----
voidtyp = 'void'; (* for procedures *)
voidcast = '(void)';
+ align = true; (* align literal params *)
+
intlen = 10; (* length of written integer *)
fixlen = 20; (* length of written real *)
***************
*** 239,244 ****
--- 242,264 ----
sinteger: (vint : integer);
sreal: (vflt : strindx);
sstring: (vstr : strindx);
+
+ sand, sarray, sbegin, scase,
+ sconst, sdiv, sdo, sdownto,
+ selse, send, sextern, sfile,
+ sfor, sforward, sfunc, sgoto,
+ sif, sinn, slabel, smod,
+ snil, snot, sof, sor,
+ sother, spacked, sproc, spgm,
+ srecord, srepeat, sset, sthen,
+ sto, stype, suntil, svar,
+ swhile, swith, seof,
+ splus, sminus, smul, squot,
+ sarrow, slpar, srpar, slbrack,
+ srbrack, seq, sne, slt,
+ sle, sgt, sge, scomma,
+ scolon, ssemic, sassign, sdotdot,
+ sdot: ()
end;
(* enumeration of symnode variants *)
***************
*** 648,653 ****
--- 668,674 ----
cstdout, cstderr, cstrncmp, cstrncpy,
cstruct, cstatic, cswitch, ctypedef,
cundef, cungetc, cunion, cunlink,
+ cfseek, cgetchar, cputchar,
cunsigned, cwrite
);
***************
*** 661,667 ****
enew, esetbase, esetsize, eoverflow,
etree, etag, euprconf, easgnconf,
ecmpconf, econfconf, evrntfile, evarfile,
! emanymachs, ebadmach
);
machdefstr = packed array [ 1 .. machdeflen ] of char;
--- 682,688 ----
enew, esetbase, esetsize, eoverflow,
etree, etag, euprconf, easgnconf,
ecmpconf, econfconf, evrntfile, evarfile,
! emanymachs, ebadmach, eprconf
);
machdefstr = packed array [ 1 .. machdeflen ] of char;
***************
*** 683,688 ****
--- 704,711 ----
useins,
usescpy,
usecomp, (* source program uses string-compare *)
+ usealig, (* source program uses aligned params *)
+ usesal,
usefopn, (* source program uses reset/rewrite *)
usescan,
usegetl,
***************
*** 738,745 ****
varno : integer; (* counter for unique id's *)
! hexdig : packed array [ 0 .. 15 ] of char;
(* Prtmsg produces an error message. It asssumes that procedure *)
(* "message" (predefined) will "writeln" to user tty. OS *)
procedure prtmsg(m : errors);
--- 761,771 ----
varno : integer; (* counter for unique id's *)
! pushchr : char; (* pushback for lexical scanner *)
! pushed : boolean;
+ hexdig : array [ 0 .. 15 ] of char;
+
(* Prtmsg produces an error message. It asssumes that procedure *)
(* "message" (predefined) will "writeln" to user tty. OS *)
procedure prtmsg(m : errors);
***************
*** 814,819 ****
--- 840,847 ----
message(restr, 'Too many machine integer types');
ebadmach:
message(inter, 'Bad name for machine integer type');
+ eprconf:
+ message(restr, 'Cannot write conformant arrays');
end;(* case *)
if lastline <> 0 then
begin
***************
*** 1219,1225 ****
var c : char;
begin
! if eof then
c := chr(null)
else begin
colno := colno + 1;
--- 1247,1258 ----
var c : char;
begin
! if pushed then
! begin
! c := pushchr;
! pushed := false
! end
! else if eof then
c := chr(null)
else begin
colno := colno + 1;
***************
*** 1235,1241 ****
else
write(c);
if c = tab1 then
! colno := ((colno div tabwidth) + 1) * tabwidth
end;
if lastchr > 0 then
begin
--- 1268,1275 ----
else
write(c);
if c = tab1 then
! colno := (((colno - 1) div tabwidth) + 1) *
! tabwidth
end;
if lastchr > 0 then
begin
***************
*** 1249,1255 ****
function peekchar : char;
begin
! if eof then
peekchar := chr(null)
else
peekchar := input^
--- 1283,1291 ----
function peekchar : char;
begin
! if pushed then
! peekchar := pushchr
! else if eof then
peekchar := chr(null)
else
peekchar := input^
***************
*** 1458,1466 ****
end;
st := sinteger;
vint := n;
if realok then
begin
- (* accept real numbers *)
if peekchar = '.' then
begin
(* this is a real number *)
--- 1494,1508 ----
end;
st := sinteger;
vint := n;
+ if realok and (peekchar = '.') then
+ begin
+ c := nextchar;
+ realok := numchar(peekchar);
+ pushchr := c;
+ pushed := true
+ end;
if realok then
begin
if peekchar = '.' then
begin
(* this is a real number *)
***************
*** 1579,1585 ****
quote:
begin
(* assume the symbol is a literal string *)
! wl := 0;
ready := false;
repeat
if eoln then
--- 1621,1627 ----
quote:
begin
(* assume the symbol is a literal string *)
! wl := 1;
ready := false;
repeat
if eoln then
***************
*** 1602,1608 ****
end;
if not ready then
begin
! wl := wl + 1;
if wl >= maxtoknlen then
begin
lasttok[lastchr] :=
--- 1644,1650 ----
end;
if not ready then
begin
! wb[wl] := c;
if wl >= maxtoknlen then
begin
lasttok[lastchr] :=
***************
*** 1609,1618 ****
chr(null);
error(elongstring)
end;
! wb[wl] := c
end
until ready;
! if wl = 1 then
begin
(* only 1 character => not a string *)
st := schar;
--- 1651,1660 ----
chr(null);
error(elongstring)
end;
! wl := wl + 1;
end
until ready;
! if wl = 2 then
begin
(* only 1 character => not a string *)
st := schar;
***************
*** 1620,1631 ****
end
else begin
(* > 1 character => its a string *)
- wl := wl + 1;
- if wl >= maxtoknlen then
- begin
- lasttok[lastchr] := chr(null);
- error(elongstring)
- end;
wb[wl] := chr(null);
st := sstring;
vstr := savestr(wb)
--- 1662,1667 ----
***************
*** 2645,2650 ****
--- 2681,2687 ----
sproc, sfunc, sbegin]);
pbody(tp);
checksymbol([sdot]);
+ nextsymbol([seof]);
tp^.tscope := currscope;
leavescope;
pprogram := tp
***************
*** 2662,2668 ****
tp^.tsubid := nil;
tp^.tsubpar := nil;
pbody(tp);
! checksymbol([ssemic]);
tp^.tscope := currscope;
leavescope;
pmodule := tp
--- 2699,2707 ----
tp^.tsubid := nil;
tp^.tsubpar := nil;
pbody(tp);
! checksymbol([ssemic, seof]);
! if currsym.st = ssemic then
! nextsymbol([seof]);
tp^.tscope := currscope;
leavescope;
pmodule := tp
***************
*** 2799,2805 ****
enterscope(dp);
dp := currscope
end;
! nextsymbol([sid, scase] + [cs]);
tq := nil;
while currsym.st = sid do
begin
--- 2838,2844 ----
enterscope(dp);
dp := currscope
end;
! nextsymbol([sid, scase, cs]);
tq := nil;
while currsym.st = sid do
begin
***************
*** 2820,2826 ****
tq^.tbind := ptypedef;
enterscope(dp);
if currsym.st = ssemic then
! nextsymbol([sid, scase] + [cs])
end;
if currsym.st = scase then
begin
--- 2859,2865 ----
tq^.tbind := ptypedef;
enterscope(dp);
if currsym.st = ssemic then
! nextsymbol([sid, scase, cs])
end;
if currsym.st = scase then
begin
***************
*** 2852,2858 ****
tv := nil;
repeat
nextsymbol([sid, sinteger, schar, splus,
! sminus] + [cs]);
if currsym.st = cs then
goto 999;
if tv = nil then
--- 2891,2897 ----
tv := nil;
repeat
nextsymbol([sid, sinteger, schar, splus,
! sminus, cs]);
if currsym.st = cs then
goto 999;
if tv = nil then
***************
*** 3650,3655 ****
--- 3689,3696 ----
tq^.tnext := mknode(nchoise);
tq := tq^.tnext
end;
+ tq^.tchocon := nil;
+ tq^.tchostmt := nil;
tv := nil;
repeat
nextsymbol([sid, sinteger, schar,
***************
*** 3845,3852 ****
if currsym.st = spgm then
top := pprogram
else
! top := pmodule;
! nextsymbol([seof]);
end; (* parse *)
(* Compute value for a node (which must be some kind of constant). *)
--- 3886,3892 ----
if currsym.st = spgm then
top := pprogram
else
! top := pmodule
end; (* parse *)
(* Compute value for a node (which must be some kind of constant). *)
***************
*** 4317,4328 ****
move := true;
sp := ip^.tsym;
if sp^.lid^.inref > 1 then
- begin
sp^.lid :=
! mkrename( 'M', sp^.lid);
! sp^.lid^.inref :=
! sp^.lid^.inref - 1
! end;
ip := nil
end
else
--- 4357,4364 ----
move := true;
sp := ip^.tsym;
if sp^.lid^.inref > 1 then
sp^.lid :=
! mkrename('M', sp^.lid);
ip := nil
end
else
***************
*** 4619,4624 ****
--- 4655,4662 ----
(* mark those used in nested subroutines *)
global(tp^.tsubsub, tp, false);
+ global(tp^.tsubvar, tp, false);
+ global(tp^.tsubtype, tp, false);
(* move out variables used in inner scope *)
movevars(tp, tp^.tsubpar);
***************
*** 4887,4896 ****
a unique name *)
sp := tp^.tsubid^.tsym;
if sp^.lid^.inref > 1 then
! begin
! sp^.lid := mkrename('P', sp^.lid);
! sp^.lid^.inref := sp^.lid^.inref - 1
! end
end;
tp := tp^.tnext
end
--- 4925,4931 ----
a unique name *)
sp := tp^.tsubid^.tsym;
if sp^.lid^.inref > 1 then
! sp^.lid := mkrename('P', sp^.lid)
end;
tp := tp^.tnext
end
***************
*** 5131,5136 ****
--- 5166,5172 ----
const include = '# include ';
define = '# define ';
+ undef = '# undef ';
ifdef = '# ifdef ';
ifndef = '# ifndef ';
elsif = '# else';
***************
*** 5145,5152 ****
var conflag,
setused,
dropset,
- donearr : boolean;
doarrow,
indnt : integer;
procedure increment;
--- 5181,5188 ----
var conflag,
setused,
dropset,
doarrow,
+ donearr : boolean;
indnt : integer;
procedure increment;
***************
*** 5203,5216 ****
(* Emit code to select a record member. *)
procedure eselect(tp : treeptr);
begin
! doarrow := doarrow + 1;
eexpr(tp);
- doarrow := doarrow - 1;
if donearr then
donearr := false
else
! write('.')
end;
(* Emit code for call to a predefined function/procedure. *)
--- 5239,5255 ----
(* Emit code to select a record member. *)
procedure eselect(tp : treeptr);
+ var da : boolean;
+
begin
! da := doarrow;
! doarrow := true;
eexpr(tp);
if donearr then
donearr := false
else
! write('.');
! doarrow := da
end;
(* Emit code for call to a predefined function/procedure. *)
***************
*** 5435,5441 ****
else
write('*.*');
write('s')
! end
end (* case *)
end; (* eformat *)
--- 5474,5482 ----
else
write('*.*');
write('s')
! end;
! 'v':
! fatal(eprconf)
end (* case *)
end; (* eformat *)
***************
*** 5572,5578 ****
write(', ');
eexpr(tq)
end
! end
end (* case *)
end; (* ewrite *)
--- 5613,5621 ----
write(', ');
eexpr(tq)
end
! end;
! 'v':
! fatal(eprconf)
end (* case *)
end; (* ewrite *)
***************
*** 6212,6218 ****
write(', ');
tq := tp^.taparm^.tnext;
if tq = nil then
! write('NULL')
else begin
tq := typeof(tq);
if tq = typnods[tchar] then
--- 6255,6261 ----
write(', ');
tq := tp^.taparm^.tnext;
if tq = nil then
! write('NULL, 0')
else begin
tq := typeof(tq);
if tq = typnods[tchar] then
***************
*** 6221,6234 ****
ch := chr(cvalof(tp^.taparm^.tnext));
if (ch = bslash) or (ch = cite) then
write(bslash);
! write(ch, cite)
end
else if tq = typnods[tstring] then
! eexpr(tp^.taparm^.tnext)
! else if tq^.tt in [narray, nconfarr] then
begin
eexpr(tp^.taparm^.tnext);
! write('.A')
end
else
fatal(etree)
--- 6264,6282 ----
ch := chr(cvalof(tp^.taparm^.tnext));
if (ch = bslash) or (ch = cite) then
write(bslash);
! write(ch, cite, ', -1')
end
else if tq = typnods[tstring] then
! begin
! eexpr(tp^.taparm^.tnext);
! write(', -1')
! end
! else if tq^.tt = narray then
begin
eexpr(tp^.taparm^.tnext);
! write('.A, sizeof(');
! eexpr(tp^.taparm^.tnext);
! write('.A)')
end
else
fatal(etree)
***************
*** 6487,6507 ****
eexpr(tq);
write(')')
end
else
eexpr(tq);
end
! else if (tx = typnods[tstring]) or
! (tx = typnods[tset]) then
begin
- (* cast literal to proper type *)
write('*((');
etypedef(tf^.tup^.tbind);
write(' *)');
! if tx = typnods[tset] then
begin
! dropset := true;
eexpr(tq);
! dropset := false
end
else
eexpr(tq);
--- 6535,6574 ----
eexpr(tq);
write(')')
end
+ else if tf^.tup^.tt = nvarpar then
+ eaddr(tq)
else
+ eexpr(tq)
+ end
+ else if tx = typnods[tset] then
+ begin
+ write('*((');
+ etypedef(tf^.tup^.tbind);
+ write(' *)');
+ dropset := true;
+ if align then
+ begin
+ usesal := true;
+ write('SETALIGN(');
eexpr(tq);
+ write(')')
+ end
+ else
+ eexpr(tq);
+ dropset := false;
+ write(')')
end
! else if tx = typnods[tstring] then
begin
write('*((');
etypedef(tf^.tup^.tbind);
write(' *)');
! if align then
begin
! usealig := true;
! write('STRALIGN(');
eexpr(tq);
! write(')')
end
else
eexpr(tq);
***************
*** 6521,6528 ****
eexpr(tq);
(* add upper bound of actual value *)
if tq^.tnext = nil then
! write(', ',
! crange(tx^.taindx):1)
end
else begin
if tf^.tup^.tt = nvarpar then
--- 6588,6600 ----
eexpr(tq);
(* add upper bound of actual value *)
if tq^.tnext = nil then
! begin
! write(', (');
! eexpr(tx^.taindx^.thi);
! write(' - ');
! eexpr(tx^.taindx^.tlo);
! write(' + 1)')
! end
end
else begin
if tf^.tup^.tt = nvarpar then
***************
*** 6930,6944 ****
eexpr(tp^.texps);
write('.buf')
end
! else if doarrow = 0 then
begin
! write('*');
! eexpr(tp^.texps)
! end
! else begin
eexpr(tp^.texps);
write('->');
donearr := true
end
end;
nid:
--- 7002,7018 ----
eexpr(tp^.texps);
write('.buf')
end
! else if doarrow then
begin
! doarrow := false;
eexpr(tp^.texps);
write('->');
donearr := true
+ end
+ else begin
+ write('(*');
+ eexpr(tp^.texps);
+ write(')')
end
end;
nid:
***************
*** 6947,6966 ****
var-parameter or as a procedure-parameter *)
tq := idup(tp);
if tq^.tt = nvarpar then
! begin
! if (doarrow = 0) or
! (tq^.tattr = areference) then
begin
! write('(*');
printid(tp^.tsym^.lid);
! write(')')
end
else begin
printid(tp^.tsym^.lid);
! write('->');
! donearr := true
end
- end
else if (tq^.tt = nconst) and conflag then
write(cvalof(tp):1)
else if tq^.tt in [nparproc, nparfunc] then
--- 7021,7038 ----
var-parameter or as a procedure-parameter *)
tq := idup(tp);
if tq^.tt = nvarpar then
! if doarrow then
begin
! doarrow := false;
printid(tp^.tsym^.lid);
! write('->');
! donearr := true
end
else begin
+ write('(*');
printid(tp^.tsym^.lid);
! write(')')
end
else if (tq^.tt = nconst) and conflag then
write(cvalof(tp):1)
else if tq^.tt in [nparproc, nparfunc] then
***************
*** 7107,7112 ****
--- 7179,7206 ----
end
end; (* econst *)
+ (* Undefine constants. *)
+ procedure edconst(tp : treeptr);
+
+ var sp : symptr;
+
+ begin
+ while tp <> nil do
+ begin
+ sp := tp^.tidl^.tsym;
+ if tp^.tbind^.tt <> nstring then
+ begin
+ (* all non-strings are emitted as
+ preprocessor # defines *)
+ write(undef);
+ printid(sp^.lid);
+ writeln
+ end;
+ tp := tp^.tnext
+ end
+ end; (* edconst *)
+
+
(* Emit a typedef. *)
procedure etypedef;
***************
*** 7867,7876 ****
ncase:
begin
indent;
! write('switch (');
increment;
eexpr(tp^.tcasxp);
! writeln(') {');
decrement;
echoise(tp^.tcaslst);
indent;
--- 7961,7970 ----
ncase:
begin
indent;
! write('switch ((int)(');
increment;
eexpr(tp^.tcasxp);
! writeln(')) {');
decrement;
echoise(tp^.tcaslst);
indent;
***************
*** 8052,8058 ****
indent;
writeln(' case 0:');
indent;
! writeln(tab1, 'break');
tq := tp^.tsublab;
while tq <> nil do
begin
--- 8146,8152 ----
indent;
writeln(' case 0:');
indent;
! writeln(tab1, 'break;');
tq := tp^.tsublab;
while tq <> nil do
begin
***************
*** 8071,8077 ****
indent;
writeln(' default:');
indent;
! writeln(tab1, 'Caseerror(Line)');
indent;
writeln('}')
end
--- 8165,8171 ----
indent;
writeln(' default:');
indent;
! writeln(tab1, 'Caseerror(Line);');
indent;
writeln('}')
end
***************
*** 8198,8203 ****
--- 8292,8298 ----
writeln(';');
end;
decrement;
+ edconst(tp^.tsubconst);
writeln('}');
999:
writeln;
***************
*** 8337,8345 ****
writeln(define, 'Putl(f, v) (f).eoln = v')
end;
if use(dreset) or use(drewrite) or use(dclose) then
writeln(define, 'Finish(f) ((f).out && !(f).eoln) ? ',
'(Putchr(', nlchr, ', f), 0) : 0, ',
! 'rewind((f).fp)'); (* LIB *)
if use(dclose) then
begin
writeln(define, 'Close(f) (f).init = ',
--- 8432,8443 ----
writeln(define, 'Putl(f, v) (f).eoln = v')
end;
if use(dreset) or use(drewrite) or use(dclose) then
+ begin
writeln(define, 'Finish(f) ((f).out && !(f).eoln) ? ',
'(Putchr(', nlchr, ', f), 0) : 0, ',
! '!fseek((f).fp, 0L, 0)'); (* LIB *)
! writeln(xtern, 'int', tab1, 'fseek();') (* LIB *)
! end;
if use(dclose) then
begin
writeln(define, 'Close(f) (f).init = ',
***************
*** 8359,8371 ****
writeln(elsif);
writeln(static, chartyp, tab1, 'Rmode[] = "r+";');
writeln(endif);
! writeln(define, 'Reset(f, n) (f).init = ',
! '(f).init ? rewind((f).fp) : ', (* LIB *)
! '(((f).fp = Fopen(n, Rmode)), 1), ',
'(f).eof = (f).out = 0, Get(f)');
! writeln(define, 'Resetx(f, n) (f).init = ',
'(f).init ? (Finish(f)) : ',
! '(((f).fp = Fopen(n, Rmode)), 1), ',
'(f).eof = (f).out = 0, Getx(f)');
usefopn := true
end;
--- 8457,8469 ----
writeln(elsif);
writeln(static, chartyp, tab1, 'Rmode[] = "r+";');
writeln(endif);
! writeln(define, 'Reset(f, n, l) (f).init = ',
! '(f).init ? !fseek((f).fp, 0L, 0) : ', (* LIB *)
! '(((f).fp = Fopen(n, l, Rmode)), 1), ',
'(f).eof = (f).out = 0, Get(f)');
! writeln(define, 'Resetx(f, n, l) (f).init = ',
'(f).init ? (Finish(f)) : ',
! '(((f).fp = Fopen(n, l, Rmode)), 1), ',
'(f).eof = (f).out = 0, Getx(f)');
usefopn := true
end;
***************
*** 8376,8388 ****
writeln(elsif);
writeln(static, chartyp, tab1, 'Wmode[] = "w+";');
writeln(endif);
! writeln(define, 'Rewrite(f, n) (f).init = ',
! '(f).init ? rewind((f).fp) : ', (* LIB *)
! '(((f).fp = Fopen(n, Wmode)), 1), ',
'(f).out = (f).eof = 1');
! writeln(define, 'Rewritex(f, n) (f).init = ',
'(f).init ? (Finish(f)) : ',
! '(((f).fp = Fopen(n, Wmode)), 1), ',
'(f).out = (f).eof = (f).eoln = 1');
usefopn := true
end;
--- 8474,8486 ----
writeln(elsif);
writeln(static, chartyp, tab1, 'Wmode[] = "w+";');
writeln(endif);
! writeln(define, 'Rewrite(f, n, l) (f).init = ',
! '(f).init ? !fseek((f).fp, 0L, 0) : ', (* LIB *)
! '(((f).fp = Fopen(n, l, Wmode)), 1), ',
'(f).out = (f).eof = 1');
! writeln(define, 'Rewritex(f, n, l) (f).init = ',
'(f).init ? (Finish(f)) : ',
! '(((f).fp = Fopen(n, l, Wmode)), 1), ',
'(f).out = (f).eof = (f).eoln = 1');
usefopn := true
end;
***************
*** 8389,8395 ****
if usefopn then
begin
writeln('FILE *Fopen();');
! writeln(define, 'MAXFILENAME 256')
end;
if usecase or usejmps then
begin
--- 8487,8495 ----
if usefopn then
begin
writeln('FILE *Fopen();');
! writeln(ifndef, maxfilename);
! writeln(define, maxfilename, ' ', (maxtoknlen+1):1);
! writeln(endif)
end;
if usecase or usejmps then
begin
***************
*** 8443,8449 ****
write(' (');
printid(defnams[dboolean]^.lid);
writeln(')1');
! writeln(xtern, chartyp, tab1, '*Bools[];')
end;
capital(defnams[dinteger]);
if use(dinteger) then
--- 8543,8549 ----
write(' (');
printid(defnams[dboolean]^.lid);
writeln(')1');
! writeln(chartyp, tab1, '*Bools[];')
end;
capital(defnams[dinteger]);
if use(dinteger) then
***************
*** 8519,8527 ****
writeln(setptyp, tab1, 'Insmem(), Mksubr();');
writeln(setptyp, tab1, 'Currset(), Inter();');
writeln(static, setptyp, tab1, 'Tmpset;');
! writeln(xtern, setptyp, tab1, 'Conset[];');
writeln(voidtyp, tab1, 'Setncpy();')
end;
writeln(xtern, chartyp, ' *strncpy();'); (* LIB *)
if use(dargc) or use(dargv) then
begin
--- 8619,8640 ----
writeln(setptyp, tab1, 'Insmem(), Mksubr();');
writeln(setptyp, tab1, 'Currset(), Inter();');
writeln(static, setptyp, tab1, 'Tmpset;');
! writeln(setptyp, tab1, 'Conset[];');
writeln(voidtyp, tab1, 'Setncpy();')
end;
+ if align then (* CPU *)
+ begin
+ writeln(ifndef, 'SETALIGN');
+ writeln(define, 'SETALIGN(x) Alignset(x)');
+ writeln('struct Set { ', wordtype, tab1, 'S[',
+ maxsetrange:1, '+1]; } *Alignset();');
+ writeln(endif);
+ writeln(ifndef, 'STRALIGN');
+ writeln(define, 'STRALIGN(x) Alignstr(x)');
+ writeln('struct String { char A[',
+ maxtoknlen:1, '+1]; } *Alignstr();');
+ writeln(endif)
+ end;
writeln(xtern, chartyp, ' *strncpy();'); (* LIB *)
if use(dargc) or use(dargv) then
begin
***************
*** 8577,8589 ****
--- 8690,8711 ----
writeln('main()');
writeln('{')
end;
+ if use(dinput) then
+ begin
+ writeln(ifdef, 'STDINIT');
+ writeln(tab1, voidcast, '(Getx(input));');
+ writeln(endif)
+ end;
increment;
elabel(tp);
estmt(tp^.tsubstmt);
indent;
writeln('exit(0);');
+ indent;
+ writeln('/', '* NOTREACHED *', '/');
decrement;
writeln('}');
+ edconst(tp^.tsubconst);
writeln('/', '*');
writeln('** End of program code');
writeln('*', '/')
***************
*** 8716,8725 ****
conflag := false;
setused := false;
dropset := false;
! doarrow := 0;
eprogram(top);
if usebool then
! writeln(chartyp, tab1, '*Bools[] = { "false", "true" };');
if usescan then
begin
writeln;
--- 8838,8848 ----
conflag := false;
setused := false;
dropset := false;
! doarrow := false;
! donearr := false;
eprogram(top);
if usebool then
! writeln(static, chartyp, tab1, '*Bools[] = { "false", "true" };');
if usescan then
begin
writeln;
***************
*** 8749,8770 ****
begin
writeln;
writeln(static, 'FILE *');
! writeln('Fopen(n, m)');
writeln(chartyp, tab1, '*n, *m;');
writeln('{');
writeln(tab1, 'FILE', tab2, '*f;');
writeln(tab1, registr, chartyp, tab1, '*s;');
writeln(tab1, static, chartyp, tab1, 'ch = ',
quote, 'A', quote, ';');
! writeln(tab1, static, chartyp, tab1, 'tmp[MAXFILENAME];');
! writeln(tab1, xtern , inttyp, tab1, 'unlink();'); (* OS *)
writeln;
writeln(tab1, 'if (n == NULL)');
writeln(tab2, 'sprintf(tmp, ', tmpfilename, 'ch++);');
writeln(tab1, 'else {');
writeln(tab2, 'strncpy(tmp, n, sizeof(tmp));');
writeln(tab2, 'for (s = &tmp[sizeof(tmp)-1]; *s == ',
! spchr, ' || *s == ', nulchr, '; )');
writeln(tab3, '*s-- = ', nulchr, ';');
writeln(tab2, 'if (tmp[sizeof(tmp)-1]) {');
writeln(tab3, voidcast, 'fprintf(stderr, "Too long filename ',
--- 8872,8897 ----
begin
writeln;
writeln(static, 'FILE *');
! writeln('Fopen(n, l, m)');
writeln(chartyp, tab1, '*n, *m;');
+ writeln(inttyp, tab1, 'l;');
writeln('{');
writeln(tab1, 'FILE', tab2, '*f;');
writeln(tab1, registr, chartyp, tab1, '*s;');
writeln(tab1, static, chartyp, tab1, 'ch = ',
quote, 'A', quote, ';');
! writeln(tab1, static, chartyp, tab1, 'tmp[', maxfilename, '];');
! writeln(tab1, xtern , inttyp, tab1, 'unlink(),'); (* OS *)
! writeln(tab3, 'strlen();'); (* OS *)
writeln;
writeln(tab1, 'if (n == NULL)');
writeln(tab2, 'sprintf(tmp, ', tmpfilename, 'ch++);');
writeln(tab1, 'else {');
+ writeln(tab2, 'if (l < 0)');
+ writeln(tab3, 'l = strlen(n);');
writeln(tab2, 'strncpy(tmp, n, sizeof(tmp));');
writeln(tab2, 'for (s = &tmp[sizeof(tmp)-1]; *s == ',
! spchr, ' || *s == ', nulchr, ' || s - tmp > l; )');
writeln(tab3, '*s-- = ', nulchr, ';');
writeln(tab2, 'if (tmp[sizeof(tmp)-1]) {');
writeln(tab3, voidcast, 'fprintf(stderr, "Too long filename ',
***************
*** 8782,8788 ****
writeln(tab2, 'unlink(tmp);'); (* OS *)
writeln(tab1, 'return (f);');
writeln('}');
- writeln(xtern, inttyp, tab1, 'rewind();')
end;
if setcnt > 0 then
econset(setlst, setcnt);
--- 8909,8914 ----
***************
*** 9098,9106 ****
writeln(tab2, '*S1++ = 0;');
writeln('}')
end;
! if usecase then
begin
writeln;
writeln(static, voidtyp);
writeln('Caseerror(n)');
writeln(tab1, inttyp, tab1, 'n;');
--- 9224,9263 ----
writeln(tab2, '*S1++ = 0;');
writeln('}')
end;
! if usesal then
begin
writeln;
+ writeln(static, 'struct Set *');
+ writeln('Alignset(Sp)');
+ writeln(tab1, registr, wordtype, tab1, '*Sp;');
+ writeln('{');
+ writeln(tab1, static, 'struct Set', tab1, 'tmp;');
+ writeln(tab1, registr, wordtype, tab1, '*tp = tmp.S;');
+ writeln(tab1, registr, inttyp, tab2, 'i = *Sp;');
+ writeln;
+ writeln(tab1, 'while (i-- >= 0)');
+ writeln(tab2, '*tp++ = *Sp++;');
+ writeln(tab1, 'return (&tmp);');
+ writeln('}')
+ end;
+ if usealig then
+ begin
+ writeln;
+ writeln(static, 'struct String *');
+ writeln('Alignstr(Cp)');
+ writeln(tab1, registr, chartyp, tab1, '*Cp;');
+ writeln('{');
+ writeln(tab1, static, 'struct String', tab1, 'tmp;');
+ writeln(tab1, registr, chartyp, tab1, '*sp = tmp.A;');
+ writeln;
+ writeln(tab1, 'while (*sp++ = *Cp++)');
+ writeln(tab2, ';');
+ writeln(tab1, 'return (&tmp);');
+ writeln('}')
+ end;
+ if usecase or usejmps then
+ begin
+ writeln;
writeln(static, voidtyp);
writeln('Caseerror(n)');
writeln(tab1, inttyp, tab1, 'n;');
***************
*** 9108,9113 ****
--- 9265,9271 ----
writeln(tab1, voidcast,
'fprintf(stderr, "Missing case limb: line %d\n", n);');
writeln(tab1, 'exit(1);');
+ writeln(tab1, '/', '* NOTREACHED *', '/');
writeln('}')
end;
if usemax then
***************
*** 9153,9158 ****
--- 9311,9318 ----
t : pretyps;
d : predefs;
+ hx : packed array [ 1 .. 16 ] of char;
+
(* Define names in ctable. *)
procedure defname(cn : cnames; str : keyword);
***************
*** 9328,9339 ****
begin (* initialize *)
lineno := 1;
colno := 0;
initstrstore;
setlst := nil;
setcnt := 0;
! hexdig := '0123456789ABCDEF';
symtab := nil;
statlvl := 0;
--- 9488,9501 ----
begin (* initialize *)
lineno := 1;
colno := 0;
+ pushed := false;
initstrstore;
setlst := nil;
setcnt := 0;
! hx := '0123456789ABCDEF';
! unpack(hx, hexdig, 0);
symtab := nil;
statlvl := 0;
***************
*** 9366,9371 ****
--- 9528,9535 ----
usecomp := false;
usemax := false;
+ usealig := false;
+ usesal := false;
for s := 0 to hashmax do
idtab[s] := nil;
***************
*** 9541,9546 ****
--- 9705,9713 ----
defname(cungetc, 'ungetc '); (* LIB *)
defname(cunion, 'union ');
defname(cunlink, 'unlink '); (* OS *)
+ defname(cfseek, 'fseek '); (* LIB *)
+ defname(cgetchar, 'getchar '); (* LIB *)
+ defname(cputchar, 'putchar '); (* LIB *)
defname(cunsigned, 'unsigned ');
defname(cwrite, 'write '); (* OS *)
***************
*** 9613,9619 ****
describing type, fill in constant identifying type *)
case t of
tboolean:
! typnods[t] := deftab[dboolean]; (* scalar type *)
tchar:
typnods[t] := deftab[dchar]^.tbind;
tinteger:
--- 9780,9786 ----
describing type, fill in constant identifying type *)
case t of
tboolean:
! typnods[t] := deftab[dboolean]^.tbind;
tchar:
typnods[t] := deftab[dchar]^.tbind;
tinteger:
SHAR_EOF
fi # end of overwriting check
# End of shell archive
exit 0
--
For comp.sources.unix stuff, mail to sources at uunet.uu.net.
More information about the Comp.sources.unix
mailing list