4bsd-f77@utah-cs.UUCP (4.2 BSD f77 bug reports) (09/01/84)
From: Jerry Berkman <jerry%ucbopal.CC@Berkeley.ARPA>
Subject: Using the f77 ASSIGN statement with FORMAT statement numbers
Index: usr.bin/f77/src/f77pass1 4.2BSD
Description:
[F77 sometimes breaks when asked to compile a program which
uses an ASSIGN statement to put the line number of a FORMAT
statement into a variable, and subsequently tries to WRITE
or PRINT with it. I have taken the liberty of adding headers
and running 'fmt' on Jerry's report. -- Ed.]
Repeat-By:
This works with f77 if the format statement occurs before the
assign statement, e.g.:
8020 format('hi')
assign 8020 to i
print i
end
or if the format statement number occurs as a format specifier
in an I/O statement before the assign statement, e.g.:
print 8020
assign 8020 to i
print i
8020 format ( ' hi there ' )
end
It does not work if the assign statement occurs before the
compiler knowns the label is a format label. You either get a
loading error(!):
assign 8020 to i
print 8020
print i
8020 format ( ' hi there ' )
end
or an execution I/O error:
assign 8020 to i
print i
8020 format ( ' hi there ' )
end
Fix:
The bug is in the grammar. In gram.head, in the action for
'thislabel', when a non-zero statement number is scanned, first
mklabel is called to get a label block for the statement
number. One is created if none existed for it.
Then, if it's not known to be a format, a label is put in the
text stream (see the putlabel() at line 157). This is all
before it looks at the statement body. When it looks at the
statement body, if it is a format statement, it calls fmtstmt()
(in io.c) to get a labelblock and then it calls setfmt() to put
the label in the initialized data stream.
So it puts one label in the text stream and one in the data
stream. So that they won't be the same, fmtstmt() gets a new
label and wipes out any prior label in the labelblock. Try
compiling the following with the -S flag:
i = 1
100 format('hi')
200 format('lo')
i =2
end
The assembler code shows two useless labels between the movl's
for 'i = 1' and 'i = 2'.
Back to the test program which got an I/O error:
assign 8000 to i
print i
8000 format('hi')
end
When the 8000 in the assign is scanned, a labelblock is created
for statement number 8000 and assigned label number 15. So the
assign is compiled to move the value of L15 into the variable
i. When the 8000 on the format statement is scanned, L15 is
put out in the text stream. Then it figures out it has a
format, replaces the 15 in the labelblock for 8000 by the label
17, and generates L17 in the data stream. So the assign is
pointing the wrong place and you get an I/O error during
execution.
The solution is to generate labels in the text stream only for
executable statements by moving the code from the action for
'thislabel' to the actions for 'end_spec' and 'let'. Then
delete the line in fmtstmt() which replaces the label with a
new label.
This has the side effect of generating less labels so that
larger source files may be compiled; it may also help the
optimizer.
Here are the diffs:
----------------------------------------------------------------
*** gram.exec4.2 Tue Jul 17 17:52:31 1984
***************
*** 77,82
newproc();
startproc(PNULL, CLMAIN);
}
}
;
--- 77,87 -----
newproc();
startproc(PNULL, CLMAIN);
}
+ if( yystno != 0 && thislabel->labtype != LABFORMAT)
+ if (optimflag)
+ optbuff (SKLABEL, 0, thislabel->labelno, 1);
+ else
+ putlabel(thislabel->labelno);
}
;
***************
*** 150,155
startproc(PNULL, CLMAIN);
}
if(parstate < INDATA) enddcl();
}
;
--- 155,165 -----
startproc(PNULL, CLMAIN);
}
if(parstate < INDATA) enddcl();
+ if( yystno != 0 && thislabel->labtype != LABFORMAT)
+ if (optimflag)
+ optbuff (SKLABEL, 0, thislabel->labelno, 1);
+ else
+ putlabel(thislabel->labelno);
+ yystno = 0;
}
;
----------------------------------------------------------------
----------------------------------------------------------------
*** gram.head4.2 Tue Jul 17 17:52:50 1984
***************
*** 156,167
convic( (ftnint) (thislabel->stateno) ) );
thislabel->blklevel = blklevel;
thislabel->labdefined = YES;
- if(thislabel->labtype != LABFORMAT)
- if (optimflag)
- optbuff (SKLABEL, 0,
- thislabel->labelno, 1);
- else
- putlabel(thislabel->labelno);
}
}
else $$ = thislabel = NULL;
--- 156,161 -----
convic( (ftnint) (thislabel->stateno) ) );
thislabel->blklevel = blklevel;
thislabel->labdefined = YES;
}
}
else $$ = thislabel = NULL;
----------------------------------------------------------------
----------------------------------------------------------------
*** io.c4.1 Tue Jul 17 17:53:13 1984
***************
*** 175,181
if(lp->labtype == LABUNKNOWN)
{
lp->labtype = LABFORMAT;
- lp->labelno = newlabel();
}
else if(lp->labtype != LABFORMAT)
{
--- 175,180 -----
if(lp->labtype == LABUNKNOWN)
{
lp->labtype = LABFORMAT;
}
else if(lp->labtype != LABFORMAT)
{
----------------------------------------------------------------
- Jerry Berkman
Computing Services, (415) 642-4804
ucbvax!ucbopal!jerry