260 lines
4.4 KiB
C
260 lines
4.4 KiB
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;
|
|
}
|