V6/usr/source/rat/r1.c
#include "r.h"
char scrat[500];
int brkptr -1;
int brkstk[10];
int forptr 0;
int forstk[10];
repcode() {
outcont(0);
yyval = genlab();
outcont(yyval);
brkstk[++brkptr] = yyval+1;
genlab();
genlab();
}
untils(p1) int p1; {
outnum(p1+1);
outcode("\tif(.not.");
balpar(scrat);
outcode(scrat);
outcode(")");
outgoto(p1);
outcont(p1+2);
brkptr--;
}
ifcode(p1) int p1; {
outcode("\tif(.not.");
balpar(scrat);
outcode(scrat);
outcode(")");
outgoto(yyval=genlab()); genlab();
}
whilecode(p1) int p1; {
outcont(0);
brkstk[++brkptr] = yyval = genlab(); genlab();
outnum(yyval);
outcode("\tif(.not.");
balpar(scrat);
outcode(scrat);
outcode(")");
outgoto(yyval+1);
}
whilestat(p1) int p1; {
outgoto(p1);
outcont(p1+1);
brkptr--;
}
balpar(bp) char *bp; {
int i, c, lpar;
extern int peek;
while( (c=getc()) == ' ' || c == '\t' || c=='\n' );
peek = c;
if( c != '(' ){
error("missing left paren");
bp[0] = '\0';
return(bp);
}
for( lpar=i=0; (bp[i++]=c=getc())!='\0'; ){
if( c=='\'' || c=='"' )
while( (bp[i++]=getc()) != c );
if( i>=499 || c=='{' || c=='}' ){
error("missing right parenthesis at %.20s", bp);
break;
}
if( c=='(' )
lpar++;
else if( c==')' )
lpar--;
if( lpar == 0 )
break;
}
bp[i] = '\0';
return(bp);
}
int labval 23000;
genlab(){
return(++labval);
}
gokcode(p1) char *p1; {
outcode("\t");
outcode(p1);
eatup(p1,scrat);
outcode(scrat);
outcode(0);
}
eatup(p1,bp) char *p1, *bp; {
extern int peek;
int i,c,lnb,lpar;
lnb = '\n';
while( c = *p1++ )
if( c!=' ' )
lnb = c;
i = lpar = 0;
more:
for( ; (bp[i++]=c=getc())!=';' && c!='{' && c!='\n' && c!='}'; ){
if( i>=499 ){
error("statement too long at %.20s", bp);
break;
}
if( c != ' ' && c != '\t' )
lnb = c;
if( c=='\'' || c=='"' )
while( (bp[i++]=getc()) != c );
if( c=='(' )
lpar++;
else if( c==')' ) {
lpar--;
if( lpar < 0 )
error("missing left paren at %.20s",bp);
}
}
if( c == '\n' ){
if( lnb=='\n' || lnb=='+' || lnb=='-' || lnb=='*' || lnb=='('
|| lnb=='/' || lnb==',' || lnb=='&' || lnb=='|'
|| lnb=='=' )
goto more;
c = ';';
}
if( c!=';' )
peek = c;
bp[i-1] = '\0';
if( lpar > 0 )
error("missing right paren at %.20s",bp);
return(bp);
}
forcode(){
extern int peek;
int i,j,c;
char *bp, *getvec();
outcont(0);
balpar(scrat);
yyval = genlab(); genlab(); genlab();
brkstk[++brkptr] = yyval+1;
if( scrat[0] == '\0' ){
forstk[forptr++] = bp = getvec(1);
*bp = '\0';
return;
}
scrat[0] = '\t';
for( i=1; (c=scrat[i++])!=';' && c!='\0' ; )
if( c=='\'' || c=='"' )
while( scrat[i++] != c );
scrat[i-1] = '\0';
if( nonblank(scrat) ){
outcode(scrat);
outcode(0);
}
for( j=i; (c=scrat[i++])!=';' && c!='\0' ; )
if( c=='\'' || c=='"' )
while( scrat[i++] != c );
scrat[i-1] = '\0';
if( nonblank(&scrat[j]) ){
outnum(yyval);
outcode("\tif(.not.(");
outcode(&scrat[j]);
outcode("))");
outgoto(yyval+2);
}
else
outcont(yyval);
for( j=0; scrat[i+1]!='\0'; )
scrat[j++] = scrat[i++];
scrat[j] = '\0';
forstk[forptr++] = bp = getvec(j+1);
for(i=0; *bp++ = scrat[i++]; );
}
forstat(p1) int p1; {
char *bp, *q;
int i;
bp = forstk[--forptr];
outnum(p1+1);
if( nonblank(bp) ){
outcode("\t");
outcode(bp);
outcode(0);
}
outgoto(p1);
outcont(p1+2);
for( q=bp; *q++; );
relvec(bp, q-bp);
brkptr--;
}
docode(new,p1) int new; char *p1; {
outcode("\t");
outcode(p1);
eatup(p1,scrat);
yyval = 0;
if(new){
yyval = genlab(); genlab();
brkstk[++brkptr] = yyval;
outnum(yyval);
}
outcode(scrat);
outcode(0);
}
dostat(p1) int p1; {
if( p1==0 )
return;
outcont(p1);
outcont(p1+1);
brkptr--;
}
breakcode(p1) int p1; {
if(brkptr<0){
error("illegal BREAK");
return;
}
outgoto(brkstk[brkptr]+1);
}
nextcode(p1) int p1; {
if(brkptr<0){
error("illegal NEXT");
return;
}
outgoto(brkstk[brkptr]);
}
nonblank(s) char *s; {
int c;
while( c = *s++ )
if( c!=' ' && c!='\t' && c!='\n' )
return(1);
return(0);
}
error(s1, s2) char *s1, *s2; {
extern int linect[],ninclude,infile;
printf( 2, "error at line %d, file %d: ",linect[ninclude],infile);
printf( 2, s1,s2);
printf( 2, "\n");
errorflag = 1;
}
errcode(p1) char *p1; {
int c;
extern int yychar;
extern int linect[],ninclude,infile;
printf( 2, "\nsyntax error, line %d, file %d\n", linect[ninclude],infile);
while( (c=getc()) != ';' && c != '}' && c != '\n' && c != '\0' );
yychar = -1;
errorflag = 1;
}