d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

removed

Browse source
This commit is contained in:
ceriel 1995-12-06 13:21:54 +00:00
parent 2358a2f5e2
commit 4a5e3f42d3
22 changed files with 0 additions and 5195 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
lang/basic/src.old/.distr
View file

@ -1,20 +0,0 @@
Makefile
basic.yacc
bem.c
bem.h
compile.c
eval.c
func.c
gencode.c
graph.c
graph.h
initialize.c
basic.lex
parsepar.c
split.c
symbols.c
symbols.h
util.c
y.tab.c
y.tab.h
yywrap.c

53
lang/basic/src.old/Makefile
View file

@ -1,53 +0,0 @@
# $Header$
d=../../..
h=$d/h
l=$d/lib
INSTALL=$l/em_bem
CFLAGS = -I$h -O
FILES= bem.o y.tab.o symbols.o initialize.o compile.o \
parsepar.o yywrap.o gencode.o util.o graph.o \
eval.o func.o split.o
CFILES= bem.c y.tab.c symbols.c initialize.c compile.c \
parsepar.c yywrap.c gencode.c util.c graph.c \
eval.c func.c split.c
SRC= bem.h symbols.h graph.h y.tab.h \
bem.c basic.yacc symbols.c initialize.c compile.c \
parsepar.c yywrap.c gencode.c util.c graph.c \
eval.c func.c split.c
first : bem
cmp : bem
cmp bem $(INSTALL)
install: bem
cp bem $(INSTALL)
clean:
rm -f *.[osmk] *.old bem
opr:
make pr ^ opr
pr:
@pr $(SRC)
distr: y.tab.c y.tab.h
bem: $(FILES)
$(CC) -o bem $(FILES)
y.tab.o : y.tab.c basic.lex
$(CC) $(CFLAGS) -c y.tab.c
y.tab.h y.tab.c : basic.yacc
yacc -d basic.yacc
$(FILES) : bem.h symbols.h graph.h y.tab.h
lint: $(CFILES)
lint -phac -I$h $(CFILES)

484
lang/basic/src.old/basic.lex
View file

@ -1,484 +0,0 @@
#ifndef NORSCID
static char rcs_lex[] = "$Header$" ;
#endif
/* This file contains the new lexical analizer */
typedef struct {
char *name;
int token, classvalue,length;
} Key;
Key keywords [] ={
"abs", FUNCTION, ABSSYM, 0,
"and", BOOLOP, ANDSYM, 0,
"asc", FUNCTION, ASCSYM, 0,
"as", ASSYM, 0, 0,
"atn", FUNCTION, ATNSYM, 0,
"auto", ILLEGAL, 0, 0,
"base", BASESYM, 0, 0,
"call", CALLSYM, 0, 0,
"cdbl", FUNCTION, CDBLSYM, 0,
"chain", ILLEGAL, 0, 0,
"chr", FUNCTION, CHRSYM, 0,
"cint", FUNCTION, CINTSYM, 0,
"clear", CLEARSYM, 0, 0,
"cload", ILLEGAL, 0, 0,
"close", ILLEGAL, 0, 0,
"common", ILLEGAL, 0, 0,
"cont", ILLEGAL, 0, 0,
"cos", FUNCTION, COSSYM, 0,
"csng", FUNCTION, CSNGSYM, 0,
"csave", ILLEGAL, 0, 0,
"cvi", FUNCTION, CVISYM, 0,
"cvs", FUNCTION, CVSSYM, 0,
"cvd", FUNCTION, CVDSYM, 0,
"data", DATASYM, 0, 0,
"defint", DEFINTSYM, 0, 0,
"defsng", DEFSNGSYM, 0, 0,
"defdbl", DEFDBLSYM, 0, 0,
"defstr", DEFSTRSYM, 0, 0,
"def", DEFSYM, 0, 0,
"delete", ILLEGAL, 0, 0,
"dim", DIMSYM, 0, 0,
"edit", ILLEGAL, 0, 0,
"else", ELSESYM, 0, 0,
"end", ENDSYM, 0, 0,
"eof", FUNCTION, EOFSYM, 0,
"eqv", BOOLOP, EQVSYM, 0,
"erase", ILLEGAL, 0, 0,
"error", ERRORSYM, 0, 0,
"err", ERRSYM, 0, 0,
"erl", ERLSYM, 0, 0,
"exp", FUNCTION, EXPSYM, 0,
"field", FIELDSYM, 0, 0,
"fix", FUNCTION, FIXSYM, 0,
"for", FORSYM, 0, 0,
"fre", FUNCTION, FRESYM, 0,
"get", GETSYM, 0, 0,
"gosub", GOSUBSYM, 0, 0,
"goto", GOTOSYM, 0, 0,
"hex", FUNCTION, HEXSYM, 0,
"if", IFSYM, 0, 0,
"imp", BOOLOP, IMPSYM, 0,
"inkey", INKEYSYM, 0, 0,
"input", INPUTSYM, 0, 0,
"inp", FUNCTION, INPSYM, 0,
"instr", FUNCTION, INSTRSYM, 0,
"int", FUNCTION, INTSYM, 0,
"kill", ILLEGAL, 0, 0,
"left", FUNCTION, LEFTSYM, 0,
"len", FUNCTION, LENSYM, 0,
"let", LETSYM, 0, 0,
"line", LINESYM, 0, 0,
"list", LISTSYM, 0, 0,
"llist", ILLEGAL, 0, 0,
"load", LOADSYM, 0, 0,
"loc", FUNCTION, LOCSYM, 0,
"log", FUNCTION, LOGSYM, 0,
"lpos", FUNCTION, LPOSSYM, 0,
"lprint", ILLEGAL, 0, 0,
"lset", LSETSYM, 0, 0,
"merge", MERGESYM, 0, 0,
"mid", MIDSYM, 0, 0,
"mki", FUNCTION, MKISYM, 0,
"mks", FUNCTION, MKSSYM, 0,
"mkd", FUNCTION, MKDSYM, 0,
"mod", MODSYM, 0, 0,
"name", ILLEGAL, 0, 0,
"new", ILLEGAL, 0, 0,
"next", NEXTSYM, 0, 0,
"not", NOTSYM, 0, 0,
"null", ILLEGAL, 0, 0,
"on", ONSYM, 0, 0,
"oct", FUNCTION, OCTSYM, 0,
"open", OPENSYM, 0, 0,
"option", OPTIONSYM, 0, 0,
"or", BOOLOP, ORSYM, 0,
"out", FUNCTION, OUTSYM, 0,
"peek", PEEKSYM, 0, 0,
"poke", POKESYM, 0, 0,
"print", PRINTSYM, 0, 0,
"pos", FUNCTION, POSSYM, 0,
"put", PUTSYM, 0, 0,
"randomi", RANDOMIZESYM, 0, 0,
"read", READSYM, 0, 0,
"rem", REMSYM, 0, 0,
"renum", ILLEGAL, 0, 0,
"ren", ILLEGAL, 0, 0,
"restore", RESTORESYM, 0, 0,
"resume", ILLEGAL, 0, 0,
"return", RETURNSYM, 0, 0,
"right", FUNCTION, RIGHTSYM, 0,
"rnd", FUNCTION, RNDSYM, 0,
"run", ILLEGAL, 0, 0,
"save", ILLEGAL, 0, 0,
"step", STEPSYM, 0, 0,
"sgn", FUNCTION, SGNSYM, 0,
"sin", FUNCTION, SINSYM, 0,
"space", FUNCTION, SPACESYM, 0,
"spc", FUNCTION, SPCSYM, 0,
"sqr", FUNCTION, SQRSYM, 0,
"stop", STOPSYM, 0, 0,
"string", FUNCTION, STRINGSYM, 0,
"str", FUNCTION, STRSYM, 0,
"swap", SWAPSYM, 0, 0,
"tab", FUNCTION, TABSYM, 0,
"tan", FUNCTION, TANSYM, 0,
"then", THENSYM, 0, 0,
"to", TOSYM, 0, 0,
"tron", TRONOFFSYM, TRONSYM, 0,
"troff", TRONOFFSYM, TROFFSYM, 0,
"using", USINGSYM, 0, 0,
"usr", FUNCTION, USRSYM, 0,
"val", FUNCTION, VALSYM, 0,
"varptr", FUNCTION, VARPTRSYM, 0,
"wait", ILLEGAL, 0, 0,
"while", WHILESYM, 0, 0,
"wend", WENDSYM, 0, 0,
"width", ILLEGAL, 0, 0,
"write", WRITESYM, 0, 0,
"xor", BOOLOP, XORSYM, 0,
0, 0, 0, 0
};
char *index();
/* Keyword index table */
int kex[27];
/* Initialize the keyword table */
fillkex()
{
Key *k;
int i;
for(k=keywords;k->name;k++)
k->length= strlen(k->name);
k=keywords;
for(i=0;k->name && i<='z'-'a';i++)
{
for(;k->name && *k->name<i+'a';k++);
if( *k->name!=i+'a') continue;
kex[*k->name-'a']=k-keywords;
for(;k->name && *k->name==i+'a';k++);
kex[*(k-1)->name-'a'+1]=k-keywords;
}
if(debug)
{
for(i=0;i<27;i++)
printf("%c:%d\n",'a'+i,kex[i]);
}
}
#include <ctype.h>
/* Get each line separately into the buffer */
/* Lines too long are terminated and flagged illegal */
#define MAXLINELENGTH 1024
char inputline[MAXLINELENGTH]; /* current source line */
char *cptr; /* next character to decode */
int yylineno=0; /* source line counter */
getline()
{
/* get next input line */
if( fgets(inputline,MAXLINELENGTH,yyin) == NULL)
return(FALSE);
yylineno ++;
if( index(inputline,'\n') == 0)
error("source line too long");
inputline[MAXLINELENGTH-1]=0;
if( listing)
fputs(inputline,stdout);
cptr= inputline;
return(TRUE);
}
yyerror(str)
char *str;
{
error("Syntax error");
}
typechar()
{
switch(*cptr)
{
case '$':
cptr++; return( STRINGTYPE);
case '%':
cptr++; return( INTTYPE);
case '!':
cptr++; return( FLOATTYPE);
case '#':
cptr++; return( DOUBLETYPE);
}
return(0);
}
/* symbols in Microsoft are significant for the first 40 characters */
#define SIGNIFICANT 40
char name[SIGNIFICANT+1];
lookup()
{
Key *k;
Symbol *Sym;
char *c;
int i, typech;
sval= name;
for(c=cptr; *c && isalnum(*c);c++)
if( isupper(*c) )
*c= tolower((*c));
for(k= keywords+kex[*cptr-'a']; k->name != 0 && *(k->name)== *cptr;k++)
if( strncmp(cptr,k->name,k->length)==0)
{
/* check functions first*/
if( isalnum( *(cptr+k->length) ) &&
k->token==FUNCTION) continue;
cptr += k->length;
yylval.integer= k->classvalue;
if(debug) printf("lookup:%d %d\n",
k->classvalue,k->token);
if( k->token == FUNCTION)
{
/* stripp type character */
typech=typechar();
}
/* illegals + rem */
if( k->token == REMSYM || k->token==ILLEGAL)
while( *cptr && *cptr!=':' && *cptr!='\n')
cptr++;
return( k->token);
}
/* Is it a function name ? */
c=cptr;
/* Identifier found, update the symbol table */
i=0;
while( isalnum(*c) || *c == '.')
if( i<SIGNIFICANT) name[i++]= *c++;
name[i]=0;
cptr=c;
Sym= srchsymbol(name);
yylval.Sptr = Sym;
typech= typechar();
if(Sym->symtype!=DEFAULTTYPE)
{
if(typech && typech!=Sym->symtype && wflag)
warning("type re-declared,ignored");
}
if( typech)
Sym->symtype=typech;
if(debug) printf("lookup:%d Identifier\n",Sym);
if( (name[0]=='f' || name[0]=='F') &&
(name[1]=='n' || name[1]=='N') )
return(FUNCTID);
return(IDENTIFIER);
}
/* Parsing unsigned numbers */
readconstant()
{
/* read HEX and OCTAL numbers */
char *c;
cptr++;
if( *cptr == 'H' || *cptr=='h')
{
/* HEX */
cptr++;
c=cptr;
while( isdigit(*cptr) ||
(*cptr>='a' && *cptr<='f' ) ||
(*cptr>='A' && *cptr<='F' ) )cptr++;
sscanf(c,"%x",&ival);
} else
if( *cptr == 'O' || *cptr == 'o')
{
/* OCTAL */
cptr++;
c=cptr;
while( isdigit(*cptr) ) cptr++;
sscanf(c,"%o",&ival);
} else
error("H or O expected");
return(INTVALUE);
}
number()
{
long i1;
double atof();
register char *c;
int overflow = 0;
char cx;
i1=0;
c=cptr;
while(isdigit(*c)){
i1= i1*10 + *c-'0';
if (i1 < 0) overflow = 1;
c++;
}
if( *c != '.'){
if( i1> MAXINT || i1<MININT || overflow) {
cx = *c;
*c = 0;
/*NOSTRICT*/ dval= atof(cptr);
cptr=c;
*c = cx;
return(FLTVALUE);
}
/*NOSTRICT*/ ival= i1;
cptr = c;
#ifdef YYDEBUG
if(yydebug) printf("number:INTVALUE %d",i1);
#endif
return(INTVALUE);
}
/* handle floats */
/*NOSTRICT*/
c++;
while( isdigit(*c)){
c++;
}
/* handle exponential part */
if( *c =='e' || *c == 'E'){
c++;
while(isdigit(*c)){
c++;
}
}
cx = *c; *c = 0;
dval = atof(cptr);
*c = cx; cptr=c;
#ifdef YYDEBUG
if(yydebug) printf("number:FLTVALUE %f",dval);
#endif
return(FLTVALUE);
}
scanstring()
{
int i,length;
char firstchar;
/* skip this string value, you might as well copy it to
the EM file as well, because it is not used internally
*/
/* generate label here */
yylval.integer= genrom();
length=0;
if( fputc('"',emfile) == EOF) fatal("scanstring");
sval= cptr;
firstchar = *cptr;
if( *cptr== '"') cptr++;
while( *cptr !='"')
{
switch(*cptr)
{
case 0:
case '\n':
#ifdef YYDEBUG
if(yydebug) printf("STRVALUE\n");
#endif
if( firstchar == '"')
error("non-terminated string");
return(STRVALUE);
case '\'':
case '\\':
putc('\\', emfile);
default:
fputc(*cptr,emfile);
}
cptr++;
length++;
}
*cptr=0;
cptr++;
fprintf(emfile,"\\000\"\n");
i=yylval.integer;
yylval.integer= genrom();
fprintf(emfile,"l%d,9999,%d\n",i,length);
#ifdef YYDEBUG
if(yydebug) printf("STRVALUE found\n");
#endif
return(STRVALUE);
}
yylex()
{
char *c;
/* Here is the big switch */
c= cptr;
switch(*c){
case 'a': case 'b': case 'c': case 'd': case 'e':
case 'f': case 'g': case 'h': case 'i': case 'j':
case 'k': case 'l': case 'm': case 'n': case 'o':
case 'p': case 'q': case 'r': case 's': case 't':
case 'u': case 'v': case 'w': case 'x': case 'y':
case 'z': case 'A': case 'B': case 'C': case 'D':
case 'E': case 'F': case 'G': case 'H': case 'I':
case 'J': case 'K': case 'L': case 'M': case 'N':
case 'O': case 'P': case 'Q': case 'R': case 'S':
case 'T': case 'U': case 'V': case 'W': case 'X':
case 'Y': case 'Z': case '_':
return(lookup());
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
case '.':
return(number());
case '\'':
/* comment at end of line */
while( *cptr != '\n' && *cptr) cptr++;
case '\n':
cptr++;
return(EOLN);
case 0:
#ifdef YYDEBUG
if( yydebug) printf("end of buffer");
#endif
return(0);
case '"':
return(scanstring());
/* handle double operators */
case ' ':
case '\t':
cptr++;
return(yylex());
case '&':
return(readconstant());
case '?':
cptr++;
return(PRINTSYM);
case '>':
if( *(c+1)=='='){
c++;c++;cptr=c; yylval.integer= GESYM;return(RELOP);
}
yylval.integer= '>';
cptr++;
return(RELOP);
case '<':
if( *(c+1)=='='){
c++; c++; cptr=c; yylval.integer=LESYM; return(RELOP);
} else
if( *(c+1)=='>'){
c++; c++; cptr=c; yylval.integer=NESYM; return(RELOP);
}
yylval.integer= '<';
cptr++;
return(RELOP);
}
return(*cptr++);
}
char *
index(s, c)
register char *s, c;
{
while (*s)
if (*s++ == c)
return --s;
return (char *)0;
}

483
lang/basic/src.old/basic.yacc
View file

@ -1,483 +0,0 @@
%token ILLEGAL
%token ASSYM
%token BASESYM
%token CALLSYM
%token CLEARSYM
%token CLOSESYM
%token DATASYM
%token DEFINTSYM
%token DEFSNGSYM
%token DEFDBLSYM
%token DEFSTRSYM
%token DEFSYM
%token DIMSYM
%token ELSESYM
%token ERRSYM
%token ERLSYM
%token ERRORSYM
%token FIELDSYM
%token FORSYM
%token <integer> FUNCTION
%token <Sptr> FUNCTID
%token INKEYSYM
%token GETSYM
%token GOSUBSYM
%token GOTOSYM
%token <integer> IFSYM
%token INPUTSYM
%token LETSYM
%token LINESYM
%token LSETSYM
%token MIDSYM
%token NEXTSYM
%token ONSYM
%token OPENSYM
%token OPTIONSYM
%token PRINTSYM
%token POKESYM
%token PUTSYM
%token RANDOMIZESYM
%token READSYM
%token REMSYM
%token RESTORESYM
%token RETURNSYM
%token ENDSYM
%token STOPSYM
%token STEPSYM
%token SWAPSYM
%token THENSYM
%token TOSYM
%token <integer> TRONOFFSYM
%token USINGSYM
%token USRSYM
%token WHILESYM
%token WENDSYM
%token WRITESYM
/* special tokens */
%token EOLN
%token INTVALUE
%token FLTVALUE
%token DBLVALUE
%token <integer> STRVALUE
%token UNARYSYM
%token <Sptr> IDENTIFIER
%token ANDSYM
%token ORSYM
%token VARPTR
%type <Sptr> arraydcl identifier indexed
%type <cptr> getput
%type <integer> exprlist expression negation compare sum term factor
%type <integer> parmlist variable printlist inputtail funcname funccall
%left <integer> BOOLOP
%left NOTSYM
%left '=' '<' '>' LESYM GESYM NESYM
%left <integer> RELOP
%left '+' '-'
%left '*' '/' '\\' MODSYM
%left '^'
%left UNARYMINUS
%{
#define YYDEBUG
#include "bem.h"
typedef union {
int integer ;
Symbol *Sptr ;
char *cptr ;
} YYSTYPE ;
int ival;
double dval;
char *sval;
int e1,e2;
char *formatstring; /* formatstring used for printing */
Symbol *s; /* Symbol dummy */
%}
%%
programline : INTVALUE {newblock(ival); newemblock(ival);} stmts EOLN
| '#' INTVALUE STRVALUE EOLN
| EOLN
;
stmts : singlestmt
| stmts ':' singlestmt
;
singlestmt : callstmt
| clearstmt
| closestmt
| datastmt
| deffnstmt
| defvarstmt
| defusrstmt
| dimstmt
| ERRORSYM expression {errorstmt($2);}
| fieldstmt
| forstmt
| getstmt
| gosubstmt
| ongotostmt
| ifstmt
| illegalstmt
| inputstmt
| letstmt
| lineinputstmt
| lsetstmt
| midstmt
| exceptionstmt
| nextstmt
| GOTOSYM INTVALUE {gotostmt(ival);}
| openstmt
| optionstmt
| pokestmt
| printstmt
| randomizestmt
| readstmt
| REMSYM
| restorestmt
| returnstmt
| ENDSYM { emcode("loc","0");
emcode("cal","$_hlt");
emcode("asp",EMINTSIZE);}
| STOPSYM { emcode("cal","$_stop");}
| swapstmt
| TRONOFFSYM { tronoff=$1;}
| whilestmt
| wendstmt
| writestmt
| /* EMPTY STATEMENT */
;
illegalstmt: ILLEGAL {illegalcmd();}
callstmt: CALLSYM IDENTIFIER parmlist ')'
{
emcode("cal",proclabel($2->symname));
while($3 -- >0) emcode("asp",EMPTRSIZE);
}
| CALLSYM IDENTIFIER
{ emcode("cal",proclabel($2->symname));}
parmlist: '(' variable { $$=1;}
| parmlist ',' variable { $$= $1+1;}
clearstmt: CLEARSYM {warning("statement ignored");}
| CLEARSYM ',' expression {warning("statement ignored");}
| CLEARSYM ',' expression ',' expression {warning("statement ignored");}
closestmt: CLOSESYM filelist
| CLOSESYM {emcode("cal","$_close");}
filelist: cross intvalue { emcode("loc",itoa(ival));
emcode("cal","$_clochn");
emcode("asp",EMINTSIZE);}
| filelist ',' cross intvalue { emcode("loc",itoa(ival));
emcode("cal","$_clochn");
emcode("asp",EMINTSIZE);}
datastmt: DATASYM {datastmt();} datalist {fprintf(datfile,"\n");}
dataelm : INTVALUE {fprintf(datfile,"%d",ival);}
| '-' INTVALUE {fprintf(datfile,"%d",-ival);}
| FLTVALUE {fprintf(datfile,"%f",dval);}
| '-' FLTVALUE {fprintf(datfile,"%f",-dval);}
| STRVALUE {fprintf(datfile,"\"%s\"",sval);}
| IDENTIFIER {fprintf(datfile,"\"%s\"",sval);}
;
datalist: dataelm
| datalist ',' {fputc(',',datfile);} dataelm
;
deffnstmt: DEFSYM heading '=' expression {endscope($4);}
heading : FUNCTID { newscope($1); heading();}
| FUNCTID {newscope($1);} '(' idlist ')' { heading();}
idlist : IDENTIFIER { dclparm($1);}
| idlist ',' IDENTIFIER { dclparm($3);}
;
defvarstmt: DEFINTSYM { setdefaulttype( INTTYPE);}
| DEFSNGSYM { setdefaulttype( FLOATTYPE);}
| DEFDBLSYM { setdefaulttype( DOUBLETYPE);}
| DEFSTRSYM { setdefaulttype( STRINGTYPE);}
defusrstmt: DEFSYM USRSYM error ':' {illegalcmd();}
dimstmt: DIMSYM arraydcl ')' {dclarray($2);}
| dimstmt ',' arraydcl ')' {dclarray($3);}
;
arraydcl : IDENTIFIER '(' INTVALUE {$$=$1; s= $1;
s->dimlimit[s->dimensions]=ival;
s->dimensions++;
}
| arraydcl ',' INTVALUE {$$=$1; s= $1;
if(s->dimensions<MAXDIMENSIONS)
{
s->dimlimit[s->dimensions]=ival;
s->dimensions++;
} else
error("too many dimensions");
}
fieldstmt: FIELDSYM cross intvalue {setchannel(ival);} ',' fieldlist {notyetimpl();}
fieldlist: intvalue ASSYM variable
| fieldlist ',' intvalue ASSYM variable
;
forstmt: FORSYM IDENTIFIER {forinit($2);} '=' expression {forexpr($5);}
TOSYM expression {forlimit($8);} step
;
step : STEPSYM expression {forstep($2);}
| /*EMPTY*/ {emcode("loc","1"); forstep(INTTYPE);}
;
nextstmt: NEXTSYM IDENTIFIER {nextstmt($2);}
| NEXTSYM { nextstmt((Symbol *)0);}
| nextstmt ',' IDENTIFIER { nextstmt($3);}
getstmt: getput {emcode("loc",itoa(0));
emcode("cal",$1);
emcode("asp",EMINTSIZE);}
| getput ',' intvalue
{ /* position seek pointer first*/
emcode("loc",itoa(ival));
emcode("cal",$1);
emcode("asp",EMINTSIZE);
}
getput: GETSYM cross intvalue { setchannel(ival); $$= "$_getrec";}
| PUTSYM cross intvalue { setchannel(ival); $$= "$_putsym";}
gosubstmt: GOSUBSYM INTVALUE {gosubstmt(ival);}
returnstmt: RETURNSYM {returnstmt();}
ifstmt: IFSYM expression {$1=ifstmt($2);} thenpart
{$1=thenpart($1);} elsepart {elsepart($1);}
;
thenpart: THENSYM INTVALUE {gotostmt(ival);}
| THENSYM stmts
| GOTOSYM INTVALUE {gotostmt(ival);}
;
elsepart: ELSESYM INTVALUE {gotostmt(ival);}
| ELSESYM stmts
| /* empty */
;
inputstmt: INPUTSYM semiprompt readlist
| INPUTSYM '#' intvalue {setchannel(ival);}',' readlist
;
semiprompt : semi STRVALUE ';' { loadstr($2); prompt(1);}
| semi STRVALUE ',' { loadstr($2); prompt(0);}
| /*EMPTY*/ { setchannel(-1);
emcode("cal","$_qstmark");}
semi : ';' | /* empty */ ;
letstmt: LETSYM {e1=where();} variable {e2=where();}
'=' expression {assign($3,$6);}
| {e1=where();} variable {e2=where();}
'=' expression {assign($2,$5);}
lineinputstmt: LINESYM INPUTSYM semiprompt {setchannel(-1);} variable {linestmt($5);}
| LINESYM '#' intvalue {setchannel(ival);} ',' variable {linestmt($6);}
;
readlist: readelm
| readlist ',' readelm
;
readelm: variable {readelm($1);}
lsetstmt: LSETSYM variable '=' expression {notyetimpl();}
midstmt: MIDSYM '$' midparms '=' expression
{ emcode("cal","$_midstmt");
emcode("asp",EMINTSIZE);
emcode("asp",EMINTSIZE);
emcode("asp",EMPTRSIZE);
emcode("asp",EMPTRSIZE);}
midparms: '(' midfirst midsec midthird ')'
midfirst: expression { conversion($1,STRINGTYPE); }
midsec: ',' expression { conversion($2,INTTYPE); }
midthird: ',' expression { conversion($2,INTTYPE); }
| /* empty */ { emcode("loc","-1");}
exceptionstmt: ONSYM ERRORSYM GOTOSYM INTVALUE {exceptstmt(ival);}
ongotostmt: ONSYM expression
GOSUBSYM constantlist {ongosubstmt($2);}
| ONSYM expression
GOTOSYM constantlist {ongotostmt($2);}
constantlist: INTVALUE {jumpelm(ival);}
| constantlist ',' INTVALUE { jumpelm(ival);}
openstmt: OPENSYM mode openchannel expression
{ conversion($4,STRINGTYPE); openstmt(0);}
| OPENSYM mode openchannel
expression {conversion($4,STRINGTYPE);}
INTVALUE { openstmt(ival);}
openchannel: cross INTVALUE ',' { setchannel(ival);}
mode : expression ',' {conversion($1,STRINGTYPE);}
| ',' { emcode("lae","_iomode");}
;
optionstmt: OPTIONSYM BASESYM intvalue { optionbase(ival);}
printstmt: PRINTSYM {setchannel(-1);emcode("cal","$_nl");}
| PRINTSYM file format printlist
{ if( $4) emcode("cal","$_nl");}
file : '#' intvalue ',' {setchannel(ival);}
| /* empty */ {setchannel(-1);}
;
format : USINGSYM STRVALUE ';' { loadstr($2);}
| USINGSYM variable ';' {
if($2!=STRINGTYPE) error("string variable expected");}
| /* empty */ {formatstring=0;}
printlist: expression { printstmt($1); $$=1;}
| ',' { zone(1); $$=0;}
| ';' { zone(0); $$=0;}
| printlist expression { printstmt($2); $$=1;}
| printlist ',' { zone(1);$$=0;}
| printlist ';' { zone(0);$$=0;}
;
pokestmt: POKESYM expression ',' expression {pokestmt($2,$4);}
;
randomizestmt: RANDOMIZESYM
{ emcode("cal","$_randomi");}
| RANDOMIZESYM expression
{ conversion($2,INTTYPE);
emcode("cal","$_setrand");
emcode("asp",EMINTSIZE);}
readstmt: READSYM {setchannel(0);} variable { readelm($3);}
| readstmt ',' variable { readelm($3);}
restorestmt: RESTORESYM INTVALUE { restore(ival);}
| RESTORESYM { restore(0);}
swapstmt: SWAPSYM variable ',' variable { swapstmt($2,$4);}
whilestmt: WHILESYM {whilestart();} expression {whiletst($3);}
;
wendstmt : WENDSYM {wend();}
writestmt: WRITESYM {setchannel(-1);emcode("cal","$_wrnl");}
| WRITESYM file writelist {emcode("cal","$_wrnl");}
;
writelist: expression {writestmt($1,0);}
| writelist ',' expression {writestmt($3,1);}
;
cross: '#' | /* empty */
intvalue: INTVALUE
;
variable: identifier { $$=loadaddr($1);}
| indexed ')' {$$=endarrayload();}
| ERRSYM {emcode("lae","_errsym"); $$= INTTYPE;}
| ERLSYM {emcode("lae","_erlsym"); $$= INTTYPE;}
;
indexed : identifier '(' {newarrayload($1);}
expression {loadarray($4); $$=$1;}
| indexed ',' expression {loadarray($3); $$=$1;}
;
expression:
negation
| expression BOOLOP expression {$$=boolop($1,$3,$2);}
;
negation: NOTSYM compare {$$=boolop($2,0,NOTSYM);}
| compare
;
compare : sum
| sum RELOP sum {$$=relop($1,$3,$2);}
| sum '=' sum {$$=relop($1,$3,'=');}
;
sum : term
| sum '-' sum {$$=plusmin($1,$3,'-');}
| sum '+' sum {$$=plusmin($1,$3,'+');}
;
term : factor
| factor '^' factor {$$=power($1,$3);}
| term '*' term {$$=muldiv($1,$3,'*');}
| term '\\' term {$$=muldiv($1,$3,'\\');}
| term '/' term {$$=muldiv($1,$3,'/');}
| term MODSYM term {$$=muldiv($1,$3,MODSYM);}
;
factor : INTVALUE {$$=loadint(ival);}
| '(' expression ')' {$$=$2;}
| '-' factor { $$=negate($2);}
| FLTVALUE {$$=loaddbl(dval);}
| STRVALUE {$$= STRINGTYPE; loadstr($1);}
| variable {$$=$1; loadvar($1);}
| INKEYSYM '$' { emcode("cal","$_inkey");
emcode("lfr",EMPTRSIZE);
$$= STRINGTYPE;
}
| VARPTR '(' '#' intvalue ')' { warning("Not supported"); $$=INTTYPE;}
| FUNCTION {$$= callfcn($1,0);}
| FUNCTION '(' cross exprlist')' {$$=callfcn($1,$4);}
| funcname { $$=fcnend(0);}
| funcname funccall ')' { $$=fcnend($2);}
| MIDSYM '$' midparms
{
emcode("cal","$_mid");
emcode("asp",EMINTSIZE);
emcode("asp",EMINTSIZE);
emcode("asp",EMPTRSIZE);
/* emcode("asp",itoa($3)); */
emcode("lfr",EMPTRSIZE);
$$= STRINGTYPE;
}
| INPUTSYM '$' '(' expression inputtail
{
emcode("cal","$_inpfcn");
emcode("asp",EMINTSIZE);
emcode("asp",EMINTSIZE);
emcode("asp",EMPTRSIZE);
$$= STRINGTYPE;
}
inputtail: ',' expression ')' { conversion($2,INTTYPE); $$= INTTYPE;}
| ',' '#' expression ')' { conversion($3,INTTYPE); $$= INTTYPE;}
| ')' { emcode("loc","-1"); $$= INTTYPE;}
funcname: FUNCTID {$$=fcncall($1);}
funccall: '(' expression { callparm(0,$2); $$=1;}
| funccall ',' expression { callparm($1,$3); $$=$1+1;}
identifier: IDENTIFIER { dcltype($1); $$=$1;}
exprlist: expression { typetable[0]= $1; $$=1;}
| exprlist ',' expression { typetable[$1]=$3;$$=$1+1;}
%%
#ifndef NORCSID
static char rcs_id[] = "$Header$" ;
#endif
#include "basic.lex"

53
lang/basic/src.old/bem.c
View file

@ -1,53 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
static char rcs_bem[] = RCS_BEM ;
static char rcs_symb[] = RCS_SYMB ;
static char rcs_graph[] = RCS_GRAPH ;
#endif
/* Author: M.L. Kersten
**
** This is the main routine for the BASIC-EM frontend.
** Program parameters are decoded, the BASIC program is parsed
** and compiled to an executable program
**
** Bem expects at least three parameters. One ending with '.i' is considered
** the input to the compiler, '.e' denotes the file to be generated,
** and the last name denotes the name of the user supplied file name.
** The latter is used to store the data entries.
** Additional flags may be supplied, see parseparms.
*/
char *program;
char datfname[MAXFILENAME] ;
char tmpfname[MAXFILENAME] ;
char *inpfile, *outfile;
main(argc,argv)
int argc;
char **argv;
{
extern int errorcnt;
/* parseparams */
parseparams(argc,argv);
/* initialize the system */
initialize();
/* compile source programs */
compileprogram(program);
linewarnings();
if( errorcnt) {
unlink(tmpfname);
exit(-1);
}
/* process em object files */
simpleprogram();
exit(0);
}

76
lang/basic/src.old/bem.h
View file

@ -1,76 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include <stdio.h>
#include <ctype.h>
#include <signal.h>
/* Author: M.L. Kersten
** Here all the global objects are defined.
*/
#include "symbols.h"
#include "graph.h"
#include "y.tab.h"
#ifndef NORCSID
# define RCS_BEM "$Header$"
#endif
#define MAXINT 32768
#define MININT -32767
#define EMINTSIZE "EM_WSIZE"
#define EMPTRSIZE "EM_PSIZE"
#define EMFLTSIZE "EM_DSIZE"
#define MAXPIECES 100
#define MAXFILENAME 200
#define CHANNEL 0
#define THRESHOLD 40 /* for splitting blocks */
#define void int /* Some C compilers don't know void */
extern char *program; /* name of source program */
extern char *inpfile; /* input tko compiler */
extern char *outfile; /* output from compiler */
extern char datfname[MAXFILENAME]; /* data statements file */
extern char tmpfname[MAXFILENAME]; /* temporary statements file */
extern FILE *emfile; /* EM output file */
extern FILE *datfile; /* data file */
extern FILE *Tmpfile; /* compiler temporary */
extern FILE *yyin; /* Compiler input */
extern int endofinput;
extern int wflag;
extern int hflag;
extern int traceflag;
extern int yydebug;
extern int yylineno;
extern int listing;
extern int nolins;
extern int threshold;
extern int debug;
extern int tronoff;
extern int emlinecount; /* counts lines on Tmpfile */
extern int dataused;
extern int typetable[10]; /* parameters to standard functions */
extern Linerecord *currline;
extern char *itoa();
extern char *datalabel();
extern char *instrlabel();
extern char *proclabel();
extern char *typesize();
extern char *typestring();
extern char *salloc();
extern char *sprintf();
extern char *strcpy();
extern char *strcat();
extern char *malloc();

24
lang/basic/src.old/compile.c
View file

@ -1,24 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
/* compile the next program in the list */
/* Here we should open the input file. (for the future) */
FILE *yyin;
compileprogram(dummyprog)
char *dummyprog;
{
while( getline())
(void) yyparse();
(void) fclose(yyin);
}

444
lang/basic/src.old/eval.c
View file

@ -1,444 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
/* Here you find all routines to evaluate expressions and
generate code for assignment statements
*/
exprtype(ltype,rtype)
int ltype,rtype;
{
/* determine the result type of an expression */
if( ltype== STRINGTYPE || rtype==STRINGTYPE)
{
if( ltype!=rtype)
error("type conflict, string expected");
return( STRINGTYPE);
}
/* take maximum */
if( ltype<rtype) return(rtype);
return(ltype);
}
conversion(oldtype,newtype)
int oldtype,newtype;
{
/* the value on top of the stack should be converted */
if( oldtype==newtype) return;
switch( oldtype)
{
case INTTYPE:
if( newtype==FLOATTYPE || newtype==DOUBLETYPE)
{
emcode("loc",EMINTSIZE);
emcode("loc",EMFLTSIZE);
emcode("cif","");
}else{
if(debug)
printf("type n=%d o=%d\n",newtype,oldtype);
error("conversion error");
}
break;
case FLOATTYPE:
case DOUBLETYPE:
if( newtype==INTTYPE)
{
/* rounded ! */
emcode("cal","$_cint");
emcode("asp",EMFLTSIZE);
emcode("lfr",EMINTSIZE);
break;
}else
if( newtype== FLOATTYPE || newtype==DOUBLETYPE)
break;
default:
if(debug)
printf("type n=%d o=%d\n",newtype,oldtype);
error("conversion error");
}
}
extraconvert(oldtype,newtype,topstack)
int oldtype,newtype,topstack;
{
/* the value below the top of the stack should be converted */
if( oldtype==newtype ) return;
if( debug) printf("extra convert %d %d %d\n",oldtype,newtype,topstack);
/* save top in dummy */
switch( topstack)
{
case INTTYPE:
emcode("ste","dummy1");
break;
case FLOATTYPE:
case DOUBLETYPE:
/* rounded ! */
emcode("lae","dummy1");
emcode("sti",EMFLTSIZE);
break;
default:
error("conversion error");
return;
}
/* now its on top of the stack */
conversion(oldtype,newtype);
/* restore top */
switch( topstack)
{
case INTTYPE:
emcode("loe","dummy1");
break;
case FLOATTYPE:
case DOUBLETYPE:
/* rounded ! */
emcode("lae","dummy1");
emcode("loi",EMFLTSIZE);
}
}
boolop(ltype,rtype,operator)
int ltype,rtype,operator;
{
if( operator != NOTSYM)
{
extraconvert(ltype,INTTYPE,rtype);
conversion(rtype,INTTYPE);
} else conversion(ltype,INTTYPE);
switch( operator)
{
case NOTSYM: emcode("com",EMINTSIZE); break;
case ANDSYM: emcode("and",EMINTSIZE); break;
case ORSYM: emcode("ior",EMINTSIZE); break;
case XORSYM: emcode("xor",EMINTSIZE); break;
case EQVSYM:
emcode("xor",EMINTSIZE);
emcode("com",EMINTSIZE);
break;
case IMPSYM:
/* implies */
emcode("com",EMINTSIZE);
emcode("and",EMINTSIZE);
emcode("com",EMINTSIZE);
break;
default: error("boolop:unexpected");
}
return(INTTYPE);
}
genbool(opcode)
char *opcode;
{
int l1,l2;
l1= genlabel();
l2= genlabel();
emcode(opcode,instrlabel(l1));
emcode("loc",itoa(0));
emcode("bra",instrlabel(l2));
fprintf(Tmpfile,"%d\n",l1); emlinecount++;
emcode("loc",itoa(-1));
fprintf(Tmpfile,"%d\n",l2); emlinecount++;
}
relop( ltype,rtype,operator)
int ltype,rtype,operator;
{
int result;
if(debug) printf("relop %d %d op=%d\n",ltype,rtype,operator);
result= exprtype(ltype,rtype);
extraconvert(ltype,result,rtype);
conversion(rtype,result);
/* compare the objects */
if( result== INTTYPE)
emcode("cmi", EMINTSIZE);
else
if( result==FLOATTYPE || result==DOUBLETYPE)
emcode("cmf",EMFLTSIZE);
else
if( result==STRINGTYPE)
{
emcode("cal","$_strcomp");
emcode("asp",EMPTRSIZE);
emcode("asp",EMPTRSIZE);
emcode("lfr",EMINTSIZE);
} else error("relop:unexpected");
/* handle the relational operators */
switch(operator)
{
case '<': genbool("zlt"); break;
case '>': genbool("zgt"); break;
case '=': genbool("zeq"); break;
case NESYM: genbool("zne"); break;
case LESYM: genbool("zle"); break;
case GESYM: genbool("zge"); break;
default: error("relop:unexpected operator");
}
return(INTTYPE);
}
plusmin(ltype,rtype,operator)
int ltype,rtype,operator;
{
int result;
result= exprtype(ltype,rtype);
if( result== STRINGTYPE)
{
if( operator== '+')
{
emcode("cal","$_concat");
emcode("asp",EMPTRSIZE);
emcode("asp",EMPTRSIZE);
emcode("lfr",EMPTRSIZE);
} else error("illegal operator");
} else {
extraconvert(ltype,result,rtype);
conversion(rtype,result);
if( result== INTTYPE)
{
if( operator=='+')
emcode("adi",EMINTSIZE);
else emcode("sbi",EMINTSIZE);
} else{
if( operator=='+')
emcode("adf",EMFLTSIZE);
else emcode("sbf",EMFLTSIZE);
}
}
return(result);
}
muldiv(ltype,rtype,operator)
int ltype,rtype,operator;
{
int result;
result= exprtype(ltype,rtype);
if(operator==MODSYM || operator== '\\') result=INTTYPE;
extraconvert(ltype,result,rtype);
conversion(rtype,result);
if( result== INTTYPE)
{
if( operator=='/')
{
result= DOUBLETYPE;
extraconvert(ltype,result,rtype);
conversion(rtype,result);
emcode("dvf",EMFLTSIZE);
} else
if( operator=='\\')
emcode("dvi",EMINTSIZE);
else
if( operator=='*')
emcode("mli",EMINTSIZE);
else
if( operator==MODSYM)
emcode("rmi",EMINTSIZE);
else error("illegal operator");
} else{
if( operator=='/')
emcode("dvf",EMFLTSIZE);
else
if( operator=='*')
emcode("mlf",EMFLTSIZE);
else error("illegal operator");
}
return(result);
}
negate(type)
int type;
{
switch(type)
{
case INTTYPE:
emcode("ngi",EMINTSIZE); break;
case DOUBLETYPE:
case FLOATTYPE:
emcode("ngf",EMFLTSIZE); break;
default:
error("Illegal operator");
}
return(type);
}
power(ltype,rtype)
int ltype,rtype;
{
extraconvert(ltype,DOUBLETYPE,rtype);
conversion(rtype,DOUBLETYPE);
emcode("cal","$_power");
emcode("asp",EMFLTSIZE);
emcode("asp",EMFLTSIZE);
emcode("lfr",EMFLTSIZE);
return(DOUBLETYPE);
}
char *typesize(ltype)
int ltype;
{
switch( ltype)
{
case INTTYPE:
return(EMINTSIZE);
case FLOATTYPE:
case DOUBLETYPE:
return(EMFLTSIZE);
case STRINGTYPE:
return(EMPTRSIZE);
default:
error("typesize:unexpected");
if(debug) printf("type received %d\n",ltype);
}
return(EMINTSIZE);
}
/*
loadptr(s)
Symbol *s;
{
if( POINTERSIZE==WORDSIZE)
fprintf(Tmpfile," loe l%d\n",s->symalias);
else
if( POINTERSIZE== 2*WORDSIZE)
fprintf(Tmpfile," lde l%d\n",s->symalias);
else error("loadptr:unexpected pointersize");
}
*/
char *typestring(type)
int type;
{
switch(type)
{
case INTTYPE:
return(EMINTSIZE);
case FLOATTYPE:
case DOUBLETYPE:
return(EMFLTSIZE);
case STRINGTYPE:
return(EMPTRSIZE);
default:
error("typestring: unexpected type");
}
return("0");
}
loadvar(type)
int type;
{
/* load a simple variable its address is on the stack*/
emcode("loi",typestring(type));
}
loadint(value)
int value;
{
emcode("loc",itoa(value));
return(INTTYPE);
}
loaddbl(value)
double value;
{
int index;
index= genlabel();
fprintf(emfile,"l%d\n bss 8,%fF8,1\n",index,value);
emcode("lae",datalabel(index));
emcode("loi",EMFLTSIZE);
return(DOUBLETYPE);
}
loadstr(value)
int value;
{
emcode("lae",datalabel(value));
}
loadaddr(s)
Symbol *s;
{
extern Symbol *fcn;
int i,j;
if(debug) printf("load %s %d\n",s->symname,s->symtype);
if( s->symalias>0)
emcode("lae",datalabel(s->symalias));
else{
j= -s->symalias;
if(debug) printf("load parm %d\n",j);
fprintf(Tmpfile," lal ");
for(i=fcn->dimensions;i>j;i--)
fprintf(Tmpfile,"%s+",typesize(fcn->dimlimit[i-1]));
fprintf(Tmpfile,"0\n");
emlinecount++;
/*
emcode("lal",datalabel(fcn->dimalias[-s->symalias]));
*/
}
return(s->symtype);
}
assign(type,lt)
int type,lt;
{
extern int e1,e2;
conversion(lt,type);
exchange(e1,e2);
/* address is on stack already */
emcode("sti",typestring(type) );
}
storevar(lab,type)
int lab,type;
{
/*store value back */
emcode("lae",datalabel(lab));
emcode("sti",typestring(type));
}
/* maintain a stack of array references */
int dimstk[MAXDIMENSIONS], dimtop= -1;
Symbol *arraystk[MAXDIMENSIONS];
newarrayload(s)
Symbol *s;
{
if( dimtop<MAXDIMENSIONS) dimtop++;
if( s->dimensions==0)
{
s->dimensions=1;
defarray(s);
}
dimstk[dimtop]= s->dimensions;
arraystk[dimtop]= s;
emcode("lae",datalabel(s->symalias));
}
endarrayload()
{
return(arraystk[dimtop--]->symtype);
}
loadarray(type)
int type;
{
int dim;
Symbol *s;
if( dimtop<0 || dimtop>=MAXDIMENSIONS)
fatal("too many nested array references");
/* index expression is on top of stack */
s=arraystk[dimtop];
dim= dimstk[dimtop];
if( dim==0)
{
error("too many indices");
dimstk[dim--]=0;
return;
}
conversion(type,INTTYPE);
dim--;
/* first check index range */
fprintf(Tmpfile," lae r%d\n",s->dimalias[dim]);
emlinecount++;
emcode("rck",EMINTSIZE);
emcode("lae",datalabel(s->dimalias[dim]));
emcode("aar",EMINTSIZE);
dimstk[dimtop]--;
}
storearray(type)
{
/* used only in let statement */
extern int e1,e2;
exchange(e1,e2);
emcode("sti",typestring(type));
}

223
lang/basic/src.old/func.c
View file

@ -1,223 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
/* expression types for predefined functions are assembled */
int typetable[10];
int exprlimit;
/* handle all predefined functions */
#define cv(X) conversion(type,X); pop=X
#define cl(X) emcode("cal",X);
parm(cnt)
int cnt;
{
if( cnt> exprlimit)
error("Not enough arguments");
if( cnt < exprlimit)
error("Too many arguments");
}
callfcn(fcnnr,cnt)
int fcnnr,cnt;
{
int pop=DOUBLETYPE;
int res=DOUBLETYPE;
int type;
type= typetable[0];
exprlimit=cnt;
if(debug) printf("fcn=%d\n",fcnnr);
switch(fcnnr)
{
case ABSSYM: cv(DOUBLETYPE);
cl("$_abr");
parm(1);
break;
case ASCSYM: cv(STRINGTYPE);
cl("$_asc"); res=INTTYPE;
parm(1);
break;
case ATNSYM: cv(DOUBLETYPE);
cl("$_atn");
parm(1);
break;
case CDBLSYM: cv(DOUBLETYPE); return(DOUBLETYPE);;
case CHRSYM: cv(INTTYPE);
cl("$_chr"); res=STRINGTYPE;
parm(1);
break;
case CSNGSYM:
cv(DOUBLETYPE); return(DOUBLETYPE);
case CINTSYM: cv(INTTYPE); return(INTTYPE);
case COSSYM: cv(DOUBLETYPE);
cl("$_cos");
parm(1);
break;
case CVISYM: cv(STRINGTYPE);
cl("$_cvi"); res=INTTYPE;
parm(1);
break;
case CVSSYM: cv(STRINGTYPE);
cl("$_cvd"); res=DOUBLETYPE;
parm(1);
break;
case CVDSYM: cv(STRINGTYPE);
cl("$_cvd"); res=DOUBLETYPE;
parm(1);
break;
case EOFSYM:
if( cnt==0)
{
res= INTTYPE;
pop= INTTYPE;
emcode("loc","-1");
} else cv(INTTYPE);
cl("$_ioeof"); res=INTTYPE;
break;
case EXPSYM: cv(DOUBLETYPE);
cl("$_exp");
parm(1);
break;
case FIXSYM: cv(DOUBLETYPE);
cl("$_fix"); res=INTTYPE;
parm(1);
break;
case INPSYM:
case LPOSSYM:
case FRESYM: pop=0;
warning("function not supported");
parm(1);
break;
case HEXSYM: cv(INTTYPE);
cl("$_hex"); res=STRINGTYPE;
parm(1);
break;
case OUTSYM:
case INSTRSYM: cv(DOUBLETYPE);
cl("$_instr"); res=STRINGTYPE;
parm(1);
break;
case INTSYM: cv(DOUBLETYPE);
cl("$_fcint");
parm(1);
break;
case LEFTSYM: parm(2);
extraconvert(type, STRINGTYPE,typetable[1]);
type= typetable[1];
cv(INTTYPE);
cl("$_left"); res=STRINGTYPE;
emcode("asp",EMPTRSIZE);
emcode("asp",EMINTSIZE);
emcode("lfr",EMPTRSIZE);
return(STRINGTYPE);
case LENSYM: cv(STRINGTYPE);
cl("$_len"); res=INTTYPE;
parm(1);
break;
case LOCSYM: cv(INTTYPE);
cl("$_loc"); res=INTTYPE;
parm(1);
break;
case LOGSYM: cv(DOUBLETYPE);
cl("$_log");
parm(1);
break;
case MKISYM: cv(INTTYPE);
cl("$_mki"); res=STRINGTYPE;
parm(1);
break;
case MKSSYM: cv(DOUBLETYPE);
cl("$_mkd"); res=STRINGTYPE;
parm(1);
break;
case MKDSYM: cv(DOUBLETYPE);
cl("$_mkd"); res=STRINGTYPE;
parm(1);
break;
case OCTSYM: cv(INTTYPE);
cl("$_oct"); res=STRINGTYPE;
parm(1);
break;
case PEEKSYM: cv(INTTYPE);
cl("$_peek"); res=INTTYPE;
parm(1);
break;
case POSSYM: emcode("asp",typestring(type));
emcode("exa","_pos");
emcode("loe","_pos");
return(INTTYPE);
case RIGHTSYM: parm(2);
extraconvert(type, STRINGTYPE,typetable[1]);
type= typetable[1];
cv(INTTYPE);
cl("$_right"); res=STRINGTYPE;
emcode("asp",EMINTSIZE);
emcode("asp",EMPTRSIZE);
emcode("lfr",EMPTRSIZE);
return(STRINGTYPE);
case RNDSYM: if( cnt==1) pop=type; else pop=0;
cl("$_rnd"); res= DOUBLETYPE;
break;
case SGNSYM: cv(DOUBLETYPE);
cl("$_sgn"); res=INTTYPE;
parm(1);
break;
case SINSYM: cv(DOUBLETYPE);
cl("$_sin");
parm(1);
break;
case SPACESYM: cv(INTTYPE);
cl("$_space"); res=STRINGTYPE;
parm(1);
break;
case SPCSYM: cv(INTTYPE);
cl("$_spc"); res=0;
parm(1);
break;
case SQRSYM: cv(DOUBLETYPE);
cl("$_sqt");
parm(1);
break;
case STRSYM: cv(DOUBLETYPE);
cl("$_str");
parm(1);
break;
case STRINGSYM: cv(STRINGTYPE);
cl("$_string"); res=STRINGTYPE;
parm(1);
break;
case TABSYM: cv(INTTYPE);
cl("$_tab"); res=0;
parm(1);
break;
case TANSYM: cv(DOUBLETYPE);
cl("$_tan");
parm(1);
break;
case VALSYM: cv(STRINGTYPE);
cl("$atol"); res=INTTYPE;
parm(1);
break;
case VARPTRSYM: cv(DOUBLETYPE);
cl("$_valptr");
parm(1);
break;
default: error("unknown function");
}
if(pop)
emcode("asp",typestring(pop));
if(res)
emcode("lfr",typestring(res));
return(res);
}

585
lang/basic/src.old/gencode.c
View file

@ -1,585 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
/* Here we find all routines dealing with pure EM code generation */
static int emlabel=1;
genlabel() { return(emlabel++);}
genemlabel()
{
int l;
l=genlabel();
fprintf( emfile,"l%d\n",l);
return(l);
}
genrom()
{
int l;
l= genemlabel();
fprintf(emfile," rom ");
return(l);
}
where()
{
return(emlinecount);
}
exchange(blk1,blk2)
int blk1,blk2;
{
/* exchange assembler blocks */
if(debug) printf("exchange %d %d %d\n",blk1,blk2,emlinecount);
fprintf(Tmpfile," exc %d,%d\n",blk2-blk1,emlinecount-blk2);
emlinecount++;
}
/* routines to manipulate the Tmpfile */
int emlinecount; /* count number of lines generated */
/* this value can be used to generate EXC */
int tronoff=0;
newemblock(nr)
int nr;
{
/* save location on Tmpfile */
currline->offset= ftell(Tmpfile);
fprintf(Tmpfile,"%d\n",currline->emlabel);
emlinecount++;
if (! nolins) {
fprintf(Tmpfile," lin %d\n",nr);
emlinecount++;
}
if( tronoff || traceflag) {
emcode("loc",itoa(nr));
emcode("cal","$_trace");
emcode("asp","EM_WSIZE");
}
}
emcode(operation,params)
char *operation,*params;
{
fprintf(Tmpfile," %s %s\n",operation,params);
emlinecount++;
}
/* Handle data statements */
int dataused=0;
List *datalist=0;
datastmt()
{
List *l,*l1;
/*NOSTRICT*/ l= (List *) salloc(sizeof(List));
l->linenr= currline->linenr;
/*NOSTRICT?*/ l->emlabel= (long) ftell(datfile);
if( datalist==0)
{
datalist=l;
datfile= fopen(datfname,"w");
if( datfile==NULL) fatal("improper file creation permission");
}else{
l1= datalist;
while(l1->nextlist) l1= l1->nextlist;
l1->nextlist=l;
}
dataused=1;
}
datatable()
{
List *l;
int line=0;
/* called at end to generate the data seek table */
fprintf(emfile," exa _seektab\n");
fprintf(emfile,"_seektab\n");
l= datalist;
while(l)
{
fprintf(emfile," rom %d,%d\n", l->linenr,line++);
l= l->nextlist;
}
fprintf(emfile," rom 0,0\n");
}
/* ERROR and exception handling */
exceptstmt(lab)
int lab;
{
/* exceptions to subroutines are supported only */
extern int gosubcnt;
List *l;
emcode("loc",itoa(gosubcnt));
l= (List *) gosublabel();
l->emlabel= gotolabel(lab);
emcode("cal","$_trpset");
emcode("asp",EMINTSIZE);
}
errorstmt(exprtype)
int exprtype;
{
/* convert expression to a valid error number */
/* obtain the message and print it */
emcode("cal","$error");
emcode("asp",typesize(exprtype));
}
/* BASIC IO */
openstmt(recsize)
int recsize;
{
emcode("loc",itoa(recsize));
emcode("cal","$_opnchn");
emcode("asp",EMPTRSIZE);
emcode("asp",EMPTRSIZE);
emcode("asp",EMINTSIZE);
}
printstmt(exprtype)
int exprtype;
{
switch(exprtype)
{
case INTTYPE:
emcode("cal","$_prinum");
emcode("asp",typestring(INTTYPE));
break;
case FLOATTYPE:
case DOUBLETYPE:
emcode("cal","$_prfnum");
emcode("asp",typestring(DOUBLETYPE));
break;
case STRINGTYPE:
emcode("cal","$_prstr");
emcode("asp",EMPTRSIZE);
break;
case 0: /* result of tab function etc */
break;
default:
error("printstmt:unexpected");
}
}
zone(i)
int i;
{
if( i)emcode("cal","$_zone");
}
writestmt(exprtype,comma)
int exprtype,comma;
{
if( comma) emcode("cal","$_wrcomma");
switch(exprtype)
{
case INTTYPE:
emcode("cal","$_wrint");
break;
case FLOATTYPE:
case DOUBLETYPE:
emcode("cal","$_wrint");
break;
case STRINGTYPE:
emcode("cal","$_wrstr");
break;
default:
error("printstmt:unexpected");
}
emcode("asp",EMPTRSIZE);
}
restore(lab)
int lab;
{
/* save this information too */
emcode("loc",itoa(0));
emcode("cal","$_setchan");
emcode("asp",EMINTSIZE);
emcode("loc",itoa(lab));
emcode("cal","$_restore");
emcode("asp",EMINTSIZE);
}
prompt(qst)
int qst;
{
setchannel(-1);
emcode("cal","$_prstr");
emcode("asp",EMPTRSIZE);
if(qst) emcode("cal","$_qstmark");
}
linestmt(type)
int type;
{
if( type!= STRINGTYPE)
error("String variable expected");
emcode("cal","$_rdline");
emcode("asp",EMPTRSIZE);
}
readelm(type)
int type;
{
switch(type)
{
case INTTYPE:
emcode("cal","$_readint");
break;
case FLOATTYPE:
case DOUBLETYPE:
emcode("cal","$_readflt");
break;
case STRINGTYPE:
emcode("cal","$_readstr");
break;
default:
error("readelm:unexpected type");
}
emcode("asp",EMPTRSIZE);
}
/* Swap exchanges the variable values */
swapstmt(ltype,rtype)
int ltype, rtype;
{
if( ltype!= rtype)
error("Type mismatch");
else
switch(ltype)
{
case INTTYPE:
emcode("cal","$_intswap");
break;
case FLOATTYPE:
case DOUBLETYPE:
emcode("cal","$_fltswap");
break;
case STRINGTYPE:
emcode("cal","$_strswap");
break;
default:
error("swap:unexpected");
}
emcode("asp",EMPTRSIZE);
emcode("asp",EMPTRSIZE);
}
/* input/output handling */
setchannel(val)
int val;
{ /* obtain file descroption */
emcode("loc",itoa(val));
emcode("cal","$_setchan");
emcode("asp",EMINTSIZE);
}
/* The if-then-else statements */
ifstmt(type)
int type;
{
/* This BASIC follows the True= -1 rule */
int nr;
nr= genlabel();
if( type == INTTYPE)
emcode("zeq",instrlabel(nr));
else
if( type == FLOATTYPE)
{
emcode("lae","fltnull");
emcode("loi",EMFLTSIZE);
emcode("cmf",EMFLTSIZE);
emcode("zeq",instrlabel(nr));
}
else error("Integer or Float expected");
return(nr);
}
thenpart( elselab)
int elselab;
{
int nr;
nr=genlabel();
emcode("bra",instrlabel(nr));
fprintf(Tmpfile,"%d\n",elselab);
emlinecount++;
return(nr);
}
elsepart(lab)int lab;
{
fprintf(Tmpfile,"%d\n",lab); emlinecount++;
}
/* generate code for the for-statement */
#define MAXFORDEPTH 20
struct FORSTRUCT{
Symbol *loopvar; /* loop variable */
int initaddress;
int limitaddress;
int stepaddress;
int fortst; /* variable limit test */
int forinc; /* variable increment code */
int forout; /* end of loop */
} fortable[MAXFORDEPTH];
int forcnt= -1;
forinit(s)
Symbol *s;
{
int type;
struct FORSTRUCT *f;
dcltype(s);
type= s->symtype;
forcnt++;
if( (type!=INTTYPE && type!=FLOATTYPE && type!=DOUBLETYPE) ||
s->dimensions)
error("Illegal loop variable");
if( forcnt >=MAXFORDEPTH)
error("too many for statements");
else{
f=fortable+forcnt;
f->loopvar=s;
f->fortst=genlabel();
f->forinc=genlabel();
f->forout=genlabel();
/* generate space for temporary objects */
f->initaddress= dclspace(type);
f->limitaddress= dclspace(type);
f->stepaddress= dclspace(type);
}
}
forexpr(type)
int type;
{
/* save start value of loop variable in a save place*/
/* to avoid clashing with final value and step expression */
int result;
result= fortable[forcnt].loopvar->symtype;
conversion(type,result);
storevar(fortable[forcnt].initaddress, result);
}
forlimit(type)
int type;
{
/* save the limit value too*/
int result;
result= fortable[forcnt].loopvar->symtype;
conversion(type,result);
storevar(fortable[forcnt].limitaddress, result);
}
forskipped(f)
struct FORSTRUCT *f;
{
int type;
type= f->loopvar->symtype;
/* evaluate lower bound times sign of step */
emcode("lae",datalabel(f->initaddress));
loadvar(type);
conversion(type,DOUBLETYPE);
emcode("lae",datalabel(f->stepaddress));
loadvar(type);
conversion(type,DOUBLETYPE);
emcode("cal","$_sgn");
emcode("asp",EMFLTSIZE);
emcode("lfr",EMINTSIZE);
conversion(INTTYPE,DOUBLETYPE);
emcode("mlf",EMFLTSIZE);
/* evaluate higher bound times sign of step */
emcode("lae",datalabel(f->limitaddress));
loadvar(type);
conversion(type,DOUBLETYPE);
emcode("lae",datalabel(f->stepaddress));
loadvar(type);
conversion(type,DOUBLETYPE);
emcode("cal","$_sgn");
emcode("asp",EMFLTSIZE);
emcode("lfr",EMINTSIZE);
conversion(INTTYPE,DOUBLETYPE);
emcode("mlf",EMFLTSIZE);
/* skip condition */
emcode("cmf",EMFLTSIZE);
emcode("zgt",instrlabel(f->forout));
}
forstep(type)
int type;
{
int result;
int varaddress;
struct FORSTRUCT *f;
f= fortable+forcnt;
result= f->loopvar->symtype;
varaddress= f->loopvar->symalias;
conversion(type,result);
storevar(f->stepaddress, result);
/* all information available, generate for-loop head */
/* test for ingoring loop */
forskipped(f);
/* set initial value */
emcode("lae",datalabel(f->initaddress));
loadvar(result);
emcode("lae",datalabel(varaddress));
emcode("sti",typestring(result));
emcode("bra",instrlabel(f->fortst));
/* increment loop variable */
fprintf(Tmpfile,"%d\n",f->forinc);
emlinecount++;
emcode("lae",datalabel(varaddress));
loadvar(result);
emcode("lae",datalabel(f->stepaddress));
loadvar(result);
if(result == INTTYPE)
emcode("adi",EMINTSIZE);
else emcode("adf",EMFLTSIZE);
emcode("lae",datalabel(varaddress));
emcode("sti",typestring(result));
/* test boundary */
fprintf(Tmpfile,"%d\n",f->fortst);
emlinecount++;
emcode("lae",datalabel(varaddress));
loadvar(result);
emcode("lae",datalabel(f->limitaddress));
loadvar(result);
if(result == INTTYPE)
emcode("cmi",EMINTSIZE);
else emcode("cmf",EMFLTSIZE);
emcode("zgt",instrlabel(f->forout));
}
nextstmt(s)
Symbol *s;
{
if(forcnt>MAXFORDEPTH || forcnt<0 ||
( s && s!= fortable[forcnt].loopvar))
error("NEXT without FOR");
else{
/* address of variable is on top of stack ! */
emcode("bra",instrlabel(fortable[forcnt].forinc));
fprintf(Tmpfile,"%d\n",fortable[forcnt].forout);
forcnt--;
}
}
pokestmt(type1,type2)
int type1,type2;
{
conversion(type1,INTTYPE);
conversion(type2,INTTYPE);
emcode("cal","$_poke");
emcode("asp",EMINTSIZE);
emcode("asp",EMINTSIZE);
}
/* generate code for the while statement */
#define MAXDEPTH 20
int whilecnt, whilelabels[MAXDEPTH][2]; /*0=head,1=out */
whilestart()
{
whilecnt++;
if( whilecnt==MAXDEPTH)
fatal("too many nestings");
/* gendummy label in graph */
newblock(-1);
whilelabels[whilecnt][0]= currline->emlabel;
whilelabels[whilecnt][1]= genlabel();
fprintf(Tmpfile,"%d\n", whilelabels[whilecnt][0]);
emlinecount++;
}
whiletst(exprtype)
int exprtype;
{
/* test expression type */
conversion(exprtype,INTTYPE);
fprintf(Tmpfile," zeq *%d\n",whilelabels[whilecnt][1]);
emlinecount++;
}
wend()
{
if( whilecnt<1)
error("not part of while statement");
else{
fprintf(Tmpfile," bra *%d\n",whilelabels[whilecnt][0]);
fprintf(Tmpfile,"%d\n",whilelabels[whilecnt][1]);
emlinecount++;
emlinecount++;
whilecnt--;
}
}
/* generate code for the final version */
prologcode()
{
/* generate the EM prolog code */
fprintf(emfile,"fltnull\n con 0,0,0,0\n");
fprintf(emfile,"dummy2\n con 0,0,0,0\n");
fprintf(emfile,"tronoff\n con 0\n");
fprintf(emfile,"dummy1\n con 0,0,0,0\n");
fprintf(emfile," exa _iomode\n_iomode\n rom \"O\"\n");
fprintf(emfile," exa _errsym\n");
fprintf(emfile,"_errsym\n bss EM_WSIZE,0,1\n");
fprintf(emfile," exa _erlsym\n");
fprintf(emfile,"_erlsym\n bss EM_WSIZE,0,1\n");
}
prolog2()
{
fprintf(emfile," exp $main\n");
fprintf(emfile," pro $main,0\n");
fprintf(emfile," mes 3\n");
fprintf(emfile," mes 9,0\n");
/* Trap handling */
fprintf(emfile," cal $_ini_trp\n");
fprintf(emfile," exa trpbuf\n");
fprintf(emfile," lae trpbuf\n");
fprintf(emfile," cal $setjmp\n");
fprintf(emfile," asp 4\n");
fprintf(emfile," lfr %s\n",EMINTSIZE);
fprintf(emfile," dup %s\n",EMINTSIZE);
fprintf(emfile," zeq *0\n");
fprintf(emfile," lae returns\n");
fprintf(emfile," csa %s\n",EMINTSIZE);
fprintf(emfile,"0\n");
fprintf(emfile," asp EM_WSIZE\n");
/* when data lists are used open its file */
if( dataused)
{
fprintf(emfile," loc 0\n");
fprintf(emfile," cal $_setchan\n");
fprintf(emfile," asp EM_WSIZE\n");
fprintf(emfile,"datfname\n rom \"%s\\0\"\n", datfname);
fprintf(emfile,"dattyp\n rom \"i\\0\"\n");
fprintf(emfile,"datfdes\n rom datfname,1,%d\n",
strlen(datfname));
fprintf(emfile,"dattdes\n rom dattyp,1,1\n");
fprintf(emfile," lae dattdes\n");
fprintf(emfile," lae datfdes\n");
fprintf(emfile," loc 0\n");
fprintf(emfile," cal $_opnchn\n");
fprintf(emfile," asp EM_PSIZE\n");
fprintf(emfile," asp EM_PSIZE\n");
fprintf(emfile," asp EM_WSIZE\n");
}
datatable();
}
epilogcode()
{
/* finalization code */
int nr;
nr= genlabel();
fprintf(emfile," bra *%d\n",nr);
genreturns();
fprintf(emfile,"%d\n",nr);
fprintf(emfile," loc 0\n");
fprintf(emfile," cal $_hlt\n");
fprintf(emfile," end 0\n");
fprintf(emfile," mes 4,4\n");
}

298
lang/basic/src.old/graph.c
View file

@ -1,298 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
List *forwardlabel=0;
Linerecord *firstline,
*currline,
*lastline;
List *newlist()
{
List *l;
/*NOSTRICT*/ l= (List *) salloc(sizeof(List));
return(l);
}
/* Line management is handled here */
Linerecord *srchline(nr)
int nr;
{
Linerecord *l;
for(l=firstline;l && l->linenr<=nr;l= l->nextline)
if( l->linenr== nr) return(l);
return(0);
}
List *srchforward(nr)
int nr;
{
List *l;
for(l=forwardlabel;l ;l=l->nextlist)
if( l->linenr== nr) return(l);
return(0);
}
linewarnings()
{
List *l;
extern int errorcnt;
l= forwardlabel;
while(l)
{
if( !srchline(l->linenr))
{
fprintf(stderr,"ERROR: line %d not defined\n",l->linenr);
errorcnt++;
}
l=l->nextlist;
}
}
newblock(nr)
int nr;
{
Linerecord *l;
List *frwrd;
if( debug) printf("newblock at %d\n",nr);
if( nr>0 && currline && currline->linenr>= nr)
{
if( debug) printf("old line:%d\n",currline->linenr);
error("Lines out of sequence");
}
frwrd=srchforward(nr);
if( frwrd && debug) printf("forward found %d\n",frwrd->emlabel);
l= srchline(nr);
if( l)
{
error("Line redefined");
nr= -genlabel();
}
/* make new EM block structure */
/*NOSTRICT*/ l= (Linerecord *) salloc(sizeof(*l));
l->emlabel= frwrd? frwrd->emlabel: genlabel();
l->linenr= nr;
/* save offset into Tmpfile too */
l->offset = (long) ftell(Tmpfile);
l->codelines= emlinecount;
/* insert this record */
if( firstline)
{
currline->nextline=l;
l->prevline= currline;
lastline= currline=l;
} else
firstline = lastline =currline=l;
}
gotolabel(nr)
int nr;
{
/* simulate a goto statement in the line record table */
Linerecord *l1;
List *ll;
if(debug) printf("goto label %d\n",nr);
/* update currline */
ll= newlist();
ll-> linenr=nr;
ll-> nextlist= currline->gotos;
currline->gotos= ll;
/* try to generate code */
l1= srchline(nr);
if( (ll=srchforward(nr))!=0)
nr= ll->emlabel;
else
if( l1==0)
{
/* declare forward label */
if(debug) printf("declare forward %d\n",nr);
ll= newlist();
ll->emlabel= genlabel();
ll-> linenr=nr;
ll->nextlist= forwardlabel;
forwardlabel= ll;
nr= ll->emlabel;
} else
nr= l1->emlabel;
return(nr);
}
gotostmt(nr)
int nr;
{
emcode("bra",instrlabel(gotolabel(nr)));
}
/* GOSUB-return, assume that proper entries are made to subroutines
only. The return statement is triggered by a fake constant label */
List *gosubhead, *gotail;
int gosubcnt=1;
List *gosublabel()
{
List *l;
l= newlist();
l->nextlist=0;
l->emlabel=genlabel();
if( gotail){
gotail->nextlist=l;
gotail=l;
} else gotail= gosubhead=l;
gosubcnt++;
return(l);
}
gosubstmt(lab)
int lab;
{
List *l;
int nr,n;
n=gosubcnt;
l= gosublabel();
nr=gotolabel(lab);
emcode("loc",itoa(n)); /*return index */
emcode("cal","$_gosub"); /* administer legal return */
emcode("asp",EMINTSIZE);
emcode("bra",instrlabel(nr));
fprintf(Tmpfile,"%d\n",l->emlabel);
emlinecount++;
}
genreturns()
{
int nr;
nr= genlabel();
fprintf(emfile,"returns\n");
fprintf(emfile," rom *%d,1,%d\n",nr,gosubcnt-1);
while( gosubhead)
{
fprintf(emfile," rom *%d\n",gosubhead->emlabel);
gosubhead= gosubhead->nextlist;
}
fprintf(emfile,"%d\n",nr);
fprintf(emfile," loc 1\n");
fprintf(emfile," cal $error\n");
}
returnstmt()
{
emcode("cal","$_retstmt"); /* ensure legal return*/
emcode("lfr",EMINTSIZE);
fprintf(Tmpfile," lae returns\n");
emlinecount++;
emcode("csa",EMINTSIZE);
}
/* compound goto-gosub statements */
List *jumphead,*jumptail;
int jumpcnt;
jumpelm(nr)
int nr;
{
List *l;
l= newlist();
l->emlabel= gotolabel(nr);
l->nextlist=0;
if( jumphead==0) jumphead= jumptail= l;
else {
jumptail->nextlist=l;
jumptail=l;
}
jumpcnt++;
}
ongotostmt(type)
int type;
{
/* generate the code itself, index in on top of the stack */
/* blurh, store the number of entries in the descriptor */
int firstlabel;
int descr;
List *l;
/* create descriptor first */
descr= genlabel();
firstlabel=genlabel();
fprintf(Tmpfile,"l%d\n",descr); emlinecount++;
fprintf(Tmpfile," rom *%d,1,%d\n",firstlabel,jumpcnt-1); emlinecount++;
l= jumphead;
while( l)
{
fprintf(Tmpfile," rom *%d\n",l->emlabel); emlinecount++;
l= l->nextlist;
}
jumphead= jumptail=0; jumpcnt=0;
if(debug) printf("ongotst:%d labels\n", jumpcnt);
conversion(type,INTTYPE);
emcode("lae",datalabel(descr));
emcode("csa",EMINTSIZE);
fprintf(Tmpfile,"%d\n",firstlabel); emlinecount++;
}
ongosubstmt(type)
int type;
{
List *l;
int firstlabel;
int descr;
/* create descriptor first */
descr= genlabel();
firstlabel=genlabel();
fprintf(Tmpfile,"l%d\n",descr); emlinecount++;
fprintf(Tmpfile," rom *%d,1,%d\n",firstlabel,jumpcnt-1); emlinecount++;
l= jumphead;
while( l)
{
fprintf(Tmpfile," rom *%d\n",l->emlabel); emlinecount++;
l= l->nextlist;
}
jumphead= jumptail=0; jumpcnt=0;
l= newlist();
l->nextlist=0;
l->emlabel=firstlabel;
if( gotail){
gotail->nextlist=l;
gotail=l;
} else gotail= gosubhead=l;
/* save the return point of the gosub */
emcode("loc",itoa(gosubcnt));
emcode("cal","$_gosub");
emcode("asp",EMINTSIZE);
gosubcnt++;
/* generate gosub */
conversion(type,INTTYPE);
emcode("lae",datalabel(descr));
emcode("csa",EMINTSIZE);
fprintf(Tmpfile,"%d\n",firstlabel);
emlinecount++;
}
/* REGION ANALYSIS and FINAL VERSION GENERATION */
simpleprogram()
{
char buf[512];
int length;
/* a small EM programs has been found */
prologcode();
prolog2();
(void) fclose(Tmpfile);
Tmpfile= fopen(tmpfname,"r");
if( Tmpfile==NULL)
fatal("tmp file disappeared");
while( (length=fread(buf,1,512,Tmpfile)) != 0)
(void) fwrite(buf,1,length,emfile);
epilogcode();
(void) unlink(tmpfname);
}

40
lang/basic/src.old/graph.h
View file

@ -1,40 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#
#ifndef NORCSID
# define RCS_GRAPH "$Header$"
#endif
/*
** The control graph is represented by a multi-list structure.
** The em code is stored on the em intermediate file already
** The offset and length is saved only.
** Although this makes code generation mode involved, it allows
** rather large BASIC programs to be processed.
*/
typedef struct LIST {
int emlabel; /* em label used with forwards */
int linenr; /* BASIC line number */
struct LIST *nextlist;
} List;
typedef struct LINERECORD{
int emlabel; /* target label */
int linenr; /* BASIC line number */
long offset; /* file offset in em file */
long codelines; /* number of em code lines */
List *callers; /* used from where ? */
List *gotos; /* fanout labels */
struct LINERECORD *nextline, *prevline;
int fixed; /* fixation of block */
} Linerecord;
extern Linerecord *firstline,
*currline,
*lastline;
extern List *forwardlabel;
extern List *gosublabel();

49
lang/basic/src.old/initialize.c
View file

@ -1,49 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#include <em_path.h>
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
/* generate temporary files etc */
FILE *emfile;
FILE *Tmpfile;
FILE *datfile;
initialize()
{
register char *cindex, *cptr ;
sprintf(tmpfname,"%s/abc%d",TMP_DIR,getpid());
/* Find the basename */
/* Strip leading directories */
cindex= (char *)0 ;
for ( cptr=program ; *cptr ; cptr++ ) if ( *cptr=='/' ) cindex=cptr ;
if ( !cindex ) cindex= program ;
else {
cindex++ ;
if ( !*cindex ) {
warning("Null program name, assuming \"basic\"") ;
cindex= "basic" ;
}
}
cptr=datfname ;
while ( *cptr++ = *cindex++ ) ;
/* Strip trailing suffix */
if ( cptr>datfname+3 && cptr[-3]=='.' ) cptr[-3]=0 ;
strcat(datfname,".d");
yyin= fopen(inpfile,"r");
emfile= fopen(outfile,"w");
Tmpfile= fopen(tmpfname,"w");
if( yyin==NULL || emfile== NULL || Tmpfile== NULL )
fatal("Improper file permissions");
fillkex(); /* initialize symbol table */
fprintf(emfile,"#\n");
fprintf(emfile," mes 2,EM_WSIZE,EM_PSIZE\n");
initdeftype(); /* set default symbol declarers */
}

58
lang/basic/src.old/parsepar.c
View file

@ -1,58 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
int listing; /* -E listing required */
int debug; /* -d compiler debugging */
int wflag=0; /* -w no warnings */
int hflag=0; /* -h<number> to split EM program */
int traceflag=0; /* generate line tracing code */
int nolins=0; /* -l: generate no LIN statements */
parseparams(argc,argv)
int argc;
char **argv;
{
int files=0 ;
int i;
char *ext;
if(argc< 4)
{
fprintf(stderr,"usage %s <flags> <file> <file> <source>\n", argv[0]);
exit(-1);
}
for(i=1;i<argc;i++)
if( argv[i][0]=='-')
switch(argv[i][1])
{
case 'D': yydebug++; break; /* parser debugging */
case 't': traceflag++; break; /* line tracing */
case 'h':/* split EM file */
hflag=0;
threshold= atoi(argv[i][2]);
if( threshold==0)
threshold= THRESHOLD;
break;
case 'd': debug++; break;
case 'L': nolins++; break; /* no EM lin statements */
case 'E': listing++; break; /* generate full listing */
case 'w': wflag++; break;
} else {
/* new input file */
switch ( files++ ) {
case 0: inpfile= argv[i]; break;
case 1: outfile= argv[i]; break;
case 2: /* should be the source file name */
program= argv[i]; break;
default:fatal("Too many file arguments") ;
}
}
if (files < 3) fatal("Too few file arguments");
}

94
lang/basic/src.old/split.c
View file

@ -1,94 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
/* Split the intermediate code into procedures.
This is necessary to make the EM code fit on
smaller machines. (for the Peephole optimizer!)
*/
/* Heuristic is to collect all basic blocks of more then THRESHOLD
em instructions into a procedure
*/
int procnum;
int threshold; /* can be set by the user */
fix(lnr)
int lnr;
{
/* this block may not be moved to a procedure */
Linerecord *lr;
if(debug) printf("fixate %d\n",lnr);
for(lr= firstline;lr; lr=lr->nextline)
if( lr->linenr == lnr)
lr->fixed=1;
}
fixblock(l)
List *l;
{
while(l)
{
fix(l->linenr);
l=l->nextlist;
}
}
phase1()
{
/* copy all offloaded blocks */
Linerecord *lr, *lf;
long blksize;
lf= lr= firstline;
blksize= lr->codelines;
while( lr)
{
if( lr->fixed){
if( !lf->fixed && blksize>threshold)
{
/*move block */
if(debug) printf("%d %d->%d moved\n",
blksize,lf->linenr, lr->linenr);
}
lf= lr;
blksize= lr->codelines;
}
lr= lr->nextline;
}
}
phase2()
{
/* copy main procedure */
prolog2();
epilogcode();
}
split()
{
/* selectively copy the intermediate code to procedures */
Linerecord *lr;
if( debug) printf("split EM code using %d\n",threshold);
/* First consolidate the goto's and caller's */
lr= firstline;
while(lr)
{
fixblock(lr->callers);
fixblock(lr->gotos);
lr= lr->nextline;
}
/* Copy the temporary file piecewise */
prologcode();
phase1();
phase2();
}

294
lang/basic/src.old/symbols.c
View file

@ -1,294 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
/* Symboltable management module */
int deftype[128]; /* default type declarer */
/* which may be set by OPTION BASE */
initdeftype()
{
int i;
for(i='a';i<='z';i++) deftype[i]= DOUBLETYPE;
for(i='A';i<='Z';i++) deftype[i]= DOUBLETYPE;
}
int indexbase=0; /* start of array subscripting */
Symbol *firstsym = NIL;
Symbol *alternate = NIL;
Symbol *srchsymbol(str)
char *str;
{
Symbol *s;
/* search symbol table entry or create it */
if(debug) printf("srchsymbol %s\n",str);
s=firstsym;
while(s)
{
if( strcmp(s->symname,str)==0) return(s);
s= s->nextsym;
}
/* search alternate list */
s=alternate;
while(s)
{
if( strcmp(s->symname,str)==0) return(s);
s= s->nextsym;
}
/* not found, create an emty slot */
/*NOSTRICT*/ s= (Symbol *) salloc(sizeof(Symbol));
s->symtype= DEFAULTTYPE;
s->nextsym= firstsym;
s->symname= (char *) salloc((unsigned)(strlen(str)+1));
strcpy(s->symname,str);
firstsym= s;
if(debug) printf("%s allocated\n",str);
return(s);
}
dcltype(s)
Symbol *s;
{
/* type declarer */
int type;
if( s->isparam) return;
type=s->symtype;
if(type==DEFAULTTYPE)
/* use the default rule */
type= deftype[*s->symname];
/* generate the emlabel too */
if( s->symalias==0)
s->symalias= dclspace(type);
s->symtype= type;
if(debug) printf("symbol set to %d\n",type);
}
dclarray(s)
Symbol *s;
{
int i; int size;
if( s->symtype==DEFAULTTYPE) s->symtype= DOUBLETYPE;
if(debug) printf("generate space and descriptors for %d\n",s->symtype);
if(debug) printf("dim %d\n",s->dimensions);
s->symalias= genlabel();
/* generate descriptors */
size=1;
for(i=0;i<s->dimensions;i++)
s->dimalias[i]= genlabel();
for(i=s->dimensions-1;i>=0;i--)
{
fprintf(emfile,"l%d\n rom %d,%d,%d*%s\n",
s->dimalias[i],
indexbase,
s->dimlimit[i]-indexbase,
size, typesize(s->symtype));
size = size* (s->dimlimit[i]+1-indexbase);
}
if(debug) printf("size=%d\n",size);
/* size of stuff */
fprintf(emfile,"l%d\n bss %d*%s,0,1\n",
s->symalias,size,typesize(s->symtype));
/* Generate the range check descriptors */
for( i= 0; i<s->dimensions;i++)
fprintf(emfile,"r%d\n rom %d,%d\n",
s->dimalias[i],
indexbase,
s->dimlimit[i]);
}
defarray(s)
Symbol *s;
{
/* array is used without dim statement, set default limits */
int i;
for(i=0;i<s->dimensions;i++) s->dimlimit[i]=10;
dclarray(s);
}
dclspace(type)
{
int nr;
nr= genemlabel();
switch( type)
{
case STRINGTYPE:
fprintf(emfile," bss %s,0,1\n",EMPTRSIZE);
break;
case INTTYPE:
fprintf(emfile," bss %s,0,1\n",EMINTSIZE);
break;
case FLOATTYPE:
case DOUBLETYPE:
fprintf(emfile," bss 8,0.0F %s,1\n",EMFLTSIZE);
break;
}
return(nr);
}
/* SOME COMPILE TIME OPTIONS */
optionbase(ival)
int ival;
{
if( ival<0 || ival>1)
error("illegal option base value");
else indexbase=ival;
}
setdefaulttype(type)
int type;
{
extern char *cptr;
char first,last,i;
/* handcrafted parser for letter ranges */
if(debug) printf("deftype:%s\n",cptr);
while( isspace(*cptr)) cptr++;
if( !isalpha(*cptr))
error("letter expected");
first= *cptr++;
if(*cptr=='-')
{
/* letter range */
cptr++;
last= *cptr;
if( !isalpha(last))
error("letter expected");
else for(i=first;i<=last;i++) deftype[i]= type;
cptr++;
} else deftype[first]=type;
if( *cptr== ',')
{
cptr++;
setdefaulttype(type); /* try again */
}
}
Symbol *fcn;
newscope(s)
Symbol *s;
{
if(debug) printf("new scope for %s\n",s->symname);
alternate= firstsym;
firstsym = NIL;
fcn=s;
s->isfunction=1;
if( fcn->dimensions)
error("Array redeclared");
if( fcn->symtype== DEFAULTTYPE)
fcn->symtype=DOUBLETYPE;
}
/* User defined functions */
heading( )
{
char procname[50];
sprintf(procname,"$_%s",fcn->symname);
emcode("pro",procname);
if( fcn->symtype== DEFAULTTYPE)
fcn->symtype= DOUBLETYPE;
}
fcnsize()
{
/* generate portable function size */
int i;
for(i=0;i<fcn->dimensions;i++)
fprintf(Tmpfile,"%s+",typesize(fcn->dimlimit[i]));
fprintf(Tmpfile,"0\n"); emlinecount++;
}
endscope(type)
int type;
{
Symbol *s;
if( debug) printf("endscope");
conversion(type,fcn->symtype);
emcode("ret", typestring(fcn->symtype));
/* generate portable EM code */
fprintf(Tmpfile," end ");
fcnsize();
s= firstsym;
while(s)
{
firstsym = s->nextsym;
/*NOSTRICT*/ free((char *)s);
s= firstsym;
}
firstsym= alternate;
alternate = NIL;
fcn=NIL;
}
dclparm(s)
Symbol *s;
{
int size=0;
if( s->symtype== DEFAULTTYPE)
s->symtype= DOUBLETYPE;
s->isparam=1;
fcn->dimlimit[fcn->dimensions]= s->symtype;
fcn->dimensions++;
/*
OLD STUFF
for(i=fcn->dimensions;i>0;i--)
fcn->dimalias[i]= fcn->dimalias[i-1];
*/
/*fcn->parmsize += typesize(s->symtype);*/
/* fcn->dimalias[0]= -typesize(s->symtype)-fcn->dimalias[1];*/
s->symalias= -fcn->dimensions;
if( debug) printf("parameter %d offset %d\n",fcn->dimensions-1,-size);
}
/* unfortunately function calls have to be stacked as well */
#define MAXNESTING 50
Symbol *fcntable[MAXNESTING];
int fcnindex= -1;
fcncall(s)
Symbol *s;
{
if( !s->isfunction)
error("Function not declared");
else{
fcn= s;
fcnindex++;
fcntable[fcnindex]=s;
}
return(s->symtype);
}
fcnend(parmcount)
int parmcount;
{
int type;
/* check number of arguments */
if( parmcount <fcn->dimensions)
error("not enough parameters");
if( parmcount >fcn->dimensions)
error("too many parameters");
fprintf(Tmpfile," cal $_%s\n",fcn->symname);
emlinecount++;
fprintf(Tmpfile," asp ");
fcnsize();
emcode("lfr",typestring(fcn->symtype));
type= fcn->symtype;
fcnindex--;
if( fcnindex>=0)
fcn= fcntable[fcnindex];
return(type);
}
callparm(ind,type)
int ind,type;
{
if( fcnindex<0) error("unexpected parameter");
if( ind >= fcn->dimensions)
error("too many parameters");
else
conversion(type,fcn->dimlimit[ind]);
}

89
lang/basic/src.old/symbols.h
View file

@ -1,89 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#ifndef NORCSID
# define RCS_SYMB "$Header$"
#endif
#define NIL 0
#define TRUE 1
#define FALSE 0
#define DEFAULTTYPE 500
#define INTTYPE 501
#define FLOATTYPE 502
#define DOUBLETYPE 503
#define STRINGTYPE 504
#define ABSSYM 520
#define ASCSYM 521
#define ATNSYM 522
#define CDBLSYM 524
#define CHRSYM 525
#define CINTSYM 526
#define COSSYM 527
#define CSNGSYM 528
#define CVISYM 529
#define CVSSYM 530
#define CVDSYM 531
#define EOFSYM 532
#define EXPSYM 533
#define FIXSYM 534
#define FRESYM 535
#define HEXSYM 536
#define INPSYM 538
#define INSTRSYM 539
#define LEFTSYM 540
#define LENSYM 541
#define LOCSYM 542
#define LOGSYM 543
#define LPOSSYM 544
#define MKISYM 546
#define MKSSYM 547
#define MKDSYM 548
#define OCTSYM 549
#define PEEKSYM 550
#define POSSYM 551
#define RIGHTSYM 552
#define RNDSYM 553
#define SGNSYM 554
#define SINSYM 555
#define SPACESYM 556
#define SPCSYM 557
#define SQRSYM 558
#define STRSYM 559
#define STRINGSYM 560
#define TABSYM 561
#define TANSYM 562
#define VALSYM 564
#define VARPTRSYM 565
/* some stuff forgotten */
#define INTSYM 567
#define AUTOSYM 568
#define LISTSYM 569
#define LOADSYM 570
#define MERGESYM 571
#define TRONSYM 572
#define TROFFSYM 573
#define XORSYM 574
#define EQVSYM 575
#define IMPSYM 576
#define OUTSYM 577
#define MAXDIMENSIONS 10
typedef struct SYMBOL{
char *symname;
int symalias;
int symtype;
int dimensions; /* dimension array/function */
int dimlimit[MAXDIMENSIONS]; /* type of parameter */
int dimalias[MAXDIMENSIONS];
struct SYMBOL *nextsym;
int isfunction;
int parmsize;
int isparam;
} Symbol;
extern Symbol *srchsymbol();

91
lang/basic/src.old/util.c
View file

@ -1,91 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
#define abs(X) (X>=0?X:-X)
/* Miscelaneous routines can be found here */
int errorcnt;
warning(str)
char *str;
{
if (! wflag) Xerror("WARNING",str);
}
error(str)
char *str;
{
Xerror("ERROR",str);
errorcnt++;
}
Xerror(type,str)
char *str;
char *type;
{
extern int listing,yylineno;
if( !listing) fprintf(stderr,"LINE %d:",yylineno);
fprintf(stderr,"%s:%s\n",type,str);
}
fatal(str)
char *str;
{
Xerror("FATAL",str);
unlink(tmpfname);
exit(-1);
}
notyetimpl()
{
warning("not yet implemented");
}
illegalcmd()
{
warning("illegal command");
}
char *itoa(i)
int i;
{
static char buf[30];
sprintf(buf,"%d",i);
return(buf);
}
char *instrlabel(i)
int i;
{
static char buf[30];
sprintf(buf,"*%d",i);
return(buf);
}
char *datalabel(i)
int i;
{
static char buf[30];
if( i>0)
sprintf(buf,"l%d",i);
else sprintf(buf,"%d",-i);
return(buf);
}
char *salloc(length)
unsigned length;
{
char *s,*c;
extern char *malloc() ;
s=c= malloc(length);
if ( !s ) fatal("Out of memory") ;
while(length--)*c++ =0;
return(s);
}
char * proclabel(str)
char *str;
{
static char buf[50];
sprintf(buf,"$%s",str);
return(buf);
}

25
lang/basic/src.old/yywrap.c
View file

@ -1,25 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
#include "bem.h"
#ifndef NORSCID
static char rcs_id[] = "$Header$" ;
#endif
/* Author: M.L. Kersten
** yywrap is called upon encountering endoffile on yyin.
** when more input files are present, it moves to the next
** otherwise -1 is returned and simultaneous endofinput is set
*/
int endofinput =0;
yywrap()
{
if( fclose(yyin) == EOF)
fatal("fclose problems ");
/* check for next input file */
return(-1);
}

718
lang/cem/cemcom/Makefile.erik
View file

@ -1,718 +0,0 @@
# $Id$
# M A K E F I L E F O R A C K C - C O M P I L E R
# Machine and environ dependent definitions
EMHOME = /usr/em# # ACK tree on this machine
DESTINATION = /user1/$$USER/bin# # where to put the stuff
MKDEP = $(EMHOME)/bin/mkdep# # dependency generator
MAP =
#MAP = -DInsertFile=ins_file -DInsertText=ins_text# bug in m68k2 back end
SIM = /user1/dick/bin/sim# # Dicks sim program
LINT = /usr/new/lint
# Libraries and EM interface definitions
SYSLIB = $(EMHOME)/modules/lib/libsystem.a
EMKLIB = $(EMHOME)/modules/lib/libemk.a
EMELIB = $(EMHOME)/modules/lib/libeme.a $(EMHOME)/lib/em_data.a
STRLIB = $(EMHOME)/modules/lib/libstring.a
PRTLIB = $(EMHOME)/modules/lib/libprint.a
EMMESLIB = $(EMHOME)/modules/lib/libem_mes.a
INPLIB = $(EMHOME)/modules/lib/libinput.a
ALLOCLIB = $(EMHOME)/modules/lib/liballoc.a
MALLOC = $(EMHOME)/modules/lib/malloc.o
#CH3LIB = $(EMHOME)/modules/lib/libch3.a
CH3LIB =
LIBS = $(INPLIB) $(CH3LIB) $(EMMESLIB) $(EMKLIB) \
$(PRTLIB) $(STRLIB) $(ALLOCLIB) $(MALLOC) $(SYSLIB)
ELIBS = $(INPLIB) $(CH3LIB) $(EMMESLIB) $(EMELIB) \
$(PRTLIB) $(STRLIB) $(ALLOCLIB) $(MALLOC) $(SYSLIB)
LIB_INCLUDES = -I$(EMHOME)/modules/h -I$(EMHOME)/modules/pkg
EM_INCLUDES = -I$(EMHOME)/h
SYSLLIB = $(EMHOME)/modules/lib/llib-lsys.ln
EMKLLIB = $(EMHOME)/modules/lib/llib-lemk.ln
EMELLIB = $(EMHOME)/modules/lib/llib-leme.ln
STRLLIB = $(EMHOME)/modules/lib/llib-lstr.ln
PRTLLIB = $(EMHOME)/modules/lib/llib-lprint.ln
EMMESLLIB = $(EMHOME)/modules/lib/llib-lmes.ln
INPLLIB = $(EMHOME)/modules/lib/llib-linput.ln
CH3LLIB = $(EMHOME)/modules/lib/llib-lch3.ln
ALLOCLLIB = $(EMHOME)/modules/lib/llib-alloc.ln
LINTLIBS =
#LINTLIBS = $(CH3LLIB) $(INPLLIB) $(EMMESLLIB) $(EMKLLIB) \
# $(PRTLLIB) $(STRLLIB) $(SYSLLIB) $(ALLOCLLIB)
# Where to install the compiler and its driver
CEMCOM = $(DESTINATION)/cemcom
DRIVER = $(DESTINATION)/cem
# What C compiler to use and how
# CC = $(ACK) -.c
# CC = CC
# CC = /bin/cc
COPTIONS =
# What parser generator to use and how
GEN = $(EMHOME)/bin/LLgen
GENOPTIONS = -vv
# Special #defines during compilation
CDEFS = $(MAP) $(EM_INCLUDES) $(LIB_INCLUDES)
CFLAGS = $(CDEFS) $(COPTIONS) -O# we cannot pass the COPTIONS to lint!
# Grammar files and their objects
LSRC = tokenfile.g declar.g statement.g expression.g program.g ival.g
GLCSRC = tokenfile.c declar.c statement.c expression.c program.c Lpars.c ival.c
LOBJ = tokenfile.o declar.o statement.o expression.o program.o Lpars.o ival.o
CSRC = main.c idf.c declarator.c decspecs.c struct.c \
expr.c ch7.c ch7bin.c cstoper.c arith.c \
asm.c code.c dumpidf.c error.c field.c\
tokenname.c LLlex.c LLmessage.c \
input.c domacro.c replace.c init.c options.c \
scan.c skip.c stack.c type.c ch7mon.c label.c eval.c \
switch.c conversion.c util.c \
blocks.c dataflow.c Version.c
# Objects of hand-written C files
COBJ = main.o idf.o declarator.o decspecs.o struct.o \
expr.o ch7.o ch7bin.o cstoper.o arith.o \
asm.o code.o dumpidf.o error.o field.o\
tokenname.o LLlex.o LLmessage.o \
input.o domacro.o replace.o init.o options.o \
scan.o skip.o stack.o type.o ch7mon.o label.o eval.o \
switch.o conversion.o util.o \
blocks.o dataflow.o Version.o
# Objects of other generated C files
GCSRC = char.c symbol2str.c next.c
GOBJ = char.o symbol2str.o next.o
# generated source files
GSRC = char.c symbol2str.c next.c \
code.h declar.h decspecs.h def.h expr.h field.h estack.h \
idf.h macro.h stack.h stmt.h struct.h switch.h type.h util.h
# .h files generated by `make hfiles'; PLEASE KEEP THIS UP-TO-DATE!
GHSRC = botch_free.h dataflow.h debug.h density.h errout.h \
idfsize.h ifdepth.h inputtype.h inumlength.h lapbuf.h \
nobitfield.h nofloat.h nopp.h noRoption.h nocross.h \
nparams.h numsize.h parbufsize.h pathlength.h \
strsize.h target_sizes.h textsize.h use_tmp.h spec_arith.h static.h \
reg_count.h
# Other generated files, for 'make clean' only
GENERATED = tokenfile.g Lpars.h LLfiles LL.output lint.out \
print Xref lxref hfiles cfiles $(GLCSRC)
# include files containing ALLOCDEF specifications
NEXTFILES = code.str declar.str decspecs.str def.str expr.str field.str \
estack.str util.str \
idf.str macro.str stack.str stmt.str struct.str switch.str type.str
.SUFFIXES: .str .h
.str.h:
./make.allocd <$*.str >$*.h
all: cc
cc:
make "EMHOME="$(EMHOME) "CC=$(CC)" hfiles
make "EMHOME="$(EMHOME) "CC=$(CC)" LLfiles
make "EMHOME="$(EMHOME) "CC=$(CC)" main
cem: cem.c
$(CC) -O cem.c $(SYSLIB) -o cem
lint.cem: cem.c
$(LINT) -bx cem.c
hfiles: ./make.hfiles Parameters
./make.hfiles Parameters
@touch hfiles
LLfiles: $(LSRC)
$(GEN) $(GENOPTIONS) $(LSRC)
@touch LLfiles
tokenfile.g: tokenname.c make.tokfile
<tokenname.c ./make.tokfile >tokenfile.g
symbol2str.c: tokenname.c make.tokcase
<tokenname.c ./make.tokcase >symbol2str.c
char.c: char.tab
$(EMHOME)/bin/tabgen -fchar.tab >char.c
next.c: make.next $(NEXTFILES)
./make.next $(NEXTFILES) >next.c
code.h: make.allocd
declar.h: make.allocd
decspecs.h: make.allocd
def.h: make.allocd
estack.h: make.allocd
expr.h: make.allocd
field.h: make.allocd
idf.h: make.allocd
macro.h: make.allocd
stack.h: make.allocd
stmt.h: make.allocd
struct.h: make.allocd
switch.h: make.allocd
type.h: make.allocd
util.h: make.allocd
# Objects needed for 'main'
OBJ = $(COBJ) $(LOBJ) $(GOBJ)
SRC = $(CSRC) $(LCSRC) $(GCSRC)
main: $(OBJ) Makefile.erik
$(CC) $(COPTIONS) $(LFLAGS) $(OBJ) $(LIBS) -o main
size main
emain: $(OBJ) Makefile.erik
$(CC) $(COPTIONS) $(LFLAGS) $(OBJ) $(ELIBS) -o emain
size emain
cfiles: hfiles LLfiles $(GSRC)
@touch cfiles
install: main cem
cp main $(CEMCOM)
cp cem $(DRIVER)
print: files
pr `cat files` > print
tags: cfiles
ctags $(SRC)
shar: files
shar `cat files`
listcfiles:
@echo $(SRC)
listobjects:
@echo $(OBJ)
depend: cfiles
sed '/^#AUTOAUTO/,$$d' Makefile.erik >Makefile.erik.new
echo '#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO' >>Makefile.erik.new
$(MKDEP) $(SRC) | sed 's/\.c:/.o:/' >>Makefile.erik.new
mv Makefile.erik Makefile.erik.old
mv Makefile.erik.new Makefile.erik
xref:
ctags -x `grep "\.[ch]" files`|sed "s/).*/)/">Xref
lxref:
lxref $(OBJ) -lc >lxref
lint: lint.main lint.cem
lint.main: cfiles
$(LINT) -bx $(CDEFS) $(SRC) $(LINTLIBS) >lint.out
cchk:
cchk $(SRC)
clean:
rm -f $(LCSRC) $(OBJ) $(GENERATED) $(GSRC) $(GHSRC)
sim: cfiles
$(SIM) $(SIMFLAGS) $(CSRC) $(GSRC) $(LSRC)
#AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
main.o: LLlex.h
main.o: Lpars.h
main.o: align.h
main.o: arith.h
main.o: debug.h
main.o: declar.h
main.o: file_info.h
main.o: idf.h
main.o: input.h
main.o: inputtype.h
main.o: level.h
main.o: noRoption.h
main.o: nobitfield.h
main.o: nocross.h
main.o: nofloat.h
main.o: nopp.h
main.o: sizes.h
main.o: spec_arith.h
main.o: specials.h
main.o: target_sizes.h
main.o: tokenname.h
main.o: type.h
main.o: use_tmp.h
idf.o: LLlex.h
idf.o: Lpars.h
idf.o: align.h
idf.o: arith.h
idf.o: assert.h
idf.o: botch_free.h
idf.o: debug.h
idf.o: declar.h
idf.o: decspecs.h
idf.o: def.h
idf.o: file_info.h
idf.o: idf.h
idf.o: idfsize.h
idf.o: label.h
idf.o: level.h
idf.o: noRoption.h
idf.o: nobitfield.h
idf.o: nocross.h
idf.o: nofloat.h
idf.o: nopp.h
idf.o: sizes.h
idf.o: spec_arith.h
idf.o: specials.h
idf.o: stack.h
idf.o: struct.h
idf.o: target_sizes.h
idf.o: type.h
declarator.o: Lpars.h
declarator.o: arith.h
declarator.o: botch_free.h
declarator.o: declar.h
declarator.o: expr.h
declarator.o: idf.h
declarator.o: label.h
declarator.o: nobitfield.h
declarator.o: nocross.h
declarator.o: nofloat.h
declarator.o: nopp.h
declarator.o: sizes.h
declarator.o: spec_arith.h
declarator.o: target_sizes.h
declarator.o: type.h
decspecs.o: Lpars.h
decspecs.o: arith.h
decspecs.o: decspecs.h
decspecs.o: def.h
decspecs.o: level.h
decspecs.o: noRoption.h
decspecs.o: nobitfield.h
decspecs.o: nofloat.h
decspecs.o: spec_arith.h
decspecs.o: type.h
struct.o: LLlex.h
struct.o: Lpars.h
struct.o: align.h
struct.o: arith.h
struct.o: assert.h
struct.o: botch_free.h
struct.o: debug.h
struct.o: def.h
struct.o: field.h
struct.o: file_info.h
struct.o: idf.h
struct.o: level.h
struct.o: noRoption.h
struct.o: nobitfield.h
struct.o: nocross.h
struct.o: nofloat.h
struct.o: nopp.h
struct.o: sizes.h
struct.o: spec_arith.h
struct.o: stack.h
struct.o: struct.h
struct.o: target_sizes.h
struct.o: type.h
expr.o: LLlex.h
expr.o: Lpars.h
expr.o: arith.h
expr.o: botch_free.h
expr.o: declar.h
expr.o: decspecs.h
expr.o: def.h
expr.o: expr.h
expr.o: file_info.h
expr.o: idf.h
expr.o: label.h
expr.o: level.h
expr.o: noRoption.h
expr.o: nobitfield.h
expr.o: nocross.h
expr.o: nofloat.h
expr.o: nopp.h
expr.o: sizes.h
expr.o: spec_arith.h
expr.o: target_sizes.h
expr.o: type.h
ch7.o: Lpars.h
ch7.o: arith.h
ch7.o: assert.h
ch7.o: debug.h
ch7.o: def.h
ch7.o: expr.h
ch7.o: idf.h
ch7.o: label.h
ch7.o: nobitfield.h
ch7.o: nofloat.h
ch7.o: nopp.h
ch7.o: spec_arith.h
ch7.o: struct.h
ch7.o: type.h
ch7bin.o: Lpars.h
ch7bin.o: arith.h
ch7bin.o: botch_free.h
ch7bin.o: expr.h
ch7bin.o: idf.h
ch7bin.o: label.h
ch7bin.o: noRoption.h
ch7bin.o: nobitfield.h
ch7bin.o: nofloat.h
ch7bin.o: nopp.h
ch7bin.o: spec_arith.h
ch7bin.o: struct.h
ch7bin.o: type.h
cstoper.o: Lpars.h
cstoper.o: arith.h
cstoper.o: assert.h
cstoper.o: debug.h
cstoper.o: expr.h
cstoper.o: idf.h
cstoper.o: label.h
cstoper.o: nobitfield.h
cstoper.o: nocross.h
cstoper.o: nofloat.h
cstoper.o: nopp.h
cstoper.o: sizes.h
cstoper.o: spec_arith.h
cstoper.o: target_sizes.h
cstoper.o: type.h
arith.o: Lpars.h
arith.o: arith.h
arith.o: botch_free.h
arith.o: expr.h
arith.o: field.h
arith.o: idf.h
arith.o: label.h
arith.o: mes.h
arith.o: noRoption.h
arith.o: nobitfield.h
arith.o: nofloat.h
arith.o: nopp.h
arith.o: spec_arith.h
arith.o: type.h
code.o: Lpars.h
code.o: arith.h
code.o: assert.h
code.o: atw.h
code.o: botch_free.h
code.o: code.h
code.o: dataflow.h
code.o: debug.h
code.o: declar.h
code.o: decspecs.h
code.o: def.h
code.o: expr.h
code.o: file_info.h
code.o: idf.h
code.o: label.h
code.o: level.h
code.o: noRoption.h
code.o: nobitfield.h
code.o: nocross.h
code.o: nofloat.h
code.o: nopp.h
code.o: sizes.h
code.o: spec_arith.h
code.o: specials.h
code.o: stack.h
code.o: stmt.h
code.o: target_sizes.h
code.o: type.h
code.o: use_tmp.h
dumpidf.o: Lpars.h
dumpidf.o: arith.h
dumpidf.o: debug.h
dumpidf.o: def.h
dumpidf.o: expr.h
dumpidf.o: field.h
dumpidf.o: idf.h
dumpidf.o: label.h
dumpidf.o: nobitfield.h
dumpidf.o: nofloat.h
dumpidf.o: nopp.h
dumpidf.o: spec_arith.h
dumpidf.o: stack.h
dumpidf.o: static.h
dumpidf.o: struct.h
dumpidf.o: type.h
error.o: LLlex.h
error.o: arith.h
error.o: debug.h
error.o: errout.h
error.o: expr.h
error.o: file_info.h
error.o: label.h
error.o: nofloat.h
error.o: nopp.h
error.o: spec_arith.h
error.o: tokenname.h
field.o: Lpars.h
field.o: align.h
field.o: arith.h
field.o: assert.h
field.o: code.h
field.o: debug.h
field.o: expr.h
field.o: field.h
field.o: idf.h
field.o: label.h
field.o: nobitfield.h
field.o: nocross.h
field.o: nofloat.h
field.o: nopp.h
field.o: sizes.h
field.o: spec_arith.h
field.o: target_sizes.h
field.o: type.h
tokenname.o: LLlex.h
tokenname.o: Lpars.h
tokenname.o: arith.h
tokenname.o: file_info.h
tokenname.o: idf.h
tokenname.o: nofloat.h
tokenname.o: nopp.h
tokenname.o: spec_arith.h
tokenname.o: tokenname.h
LLlex.o: LLlex.h
LLlex.o: Lpars.h
LLlex.o: arith.h
LLlex.o: assert.h
LLlex.o: class.h
LLlex.o: debug.h
LLlex.o: def.h
LLlex.o: file_info.h
LLlex.o: idf.h
LLlex.o: idfsize.h
LLlex.o: input.h
LLlex.o: nocross.h
LLlex.o: nofloat.h
LLlex.o: nopp.h
LLlex.o: numsize.h
LLlex.o: sizes.h
LLlex.o: spec_arith.h
LLlex.o: strsize.h
LLlex.o: target_sizes.h
LLmessage.o: LLlex.h
LLmessage.o: Lpars.h
LLmessage.o: arith.h
LLmessage.o: file_info.h
LLmessage.o: idf.h
LLmessage.o: nofloat.h
LLmessage.o: nopp.h
LLmessage.o: spec_arith.h
input.o: file_info.h
input.o: input.h
input.o: inputtype.h
input.o: nopp.h
domacro.o: LLlex.h
domacro.o: Lpars.h
domacro.o: arith.h
domacro.o: assert.h
domacro.o: botch_free.h
domacro.o: class.h
domacro.o: debug.h
domacro.o: file_info.h
domacro.o: idf.h
domacro.o: idfsize.h
domacro.o: ifdepth.h
domacro.o: input.h
domacro.o: interface.h
domacro.o: macro.h
domacro.o: nofloat.h
domacro.o: nopp.h
domacro.o: nparams.h
domacro.o: parbufsize.h
domacro.o: spec_arith.h
domacro.o: textsize.h
replace.o: LLlex.h
replace.o: arith.h
replace.o: assert.h
replace.o: class.h
replace.o: debug.h
replace.o: file_info.h
replace.o: idf.h
replace.o: input.h
replace.o: interface.h
replace.o: macro.h
replace.o: nofloat.h
replace.o: nopp.h
replace.o: pathlength.h
replace.o: spec_arith.h
replace.o: static.h
replace.o: strsize.h
init.o: class.h
init.o: idf.h
init.o: interface.h
init.o: macro.h
init.o: nopp.h
options.o: align.h
options.o: arith.h
options.o: botch_free.h
options.o: class.h
options.o: dataflow.h
options.o: idf.h
options.o: idfsize.h
options.o: macro.h
options.o: noRoption.h
options.o: nobitfield.h
options.o: nocross.h
options.o: nofloat.h
options.o: nopp.h
options.o: sizes.h
options.o: spec_arith.h
options.o: target_sizes.h
options.o: use_tmp.h
scan.o: class.h
scan.o: idf.h
scan.o: input.h
scan.o: interface.h
scan.o: lapbuf.h
scan.o: macro.h
scan.o: nopp.h
scan.o: nparams.h
skip.o: LLlex.h
skip.o: arith.h
skip.o: class.h
skip.o: file_info.h
skip.o: input.h
skip.o: interface.h
skip.o: nofloat.h
skip.o: nopp.h
skip.o: spec_arith.h
stack.o: Lpars.h
stack.o: arith.h
stack.o: botch_free.h
stack.o: debug.h
stack.o: def.h
stack.o: idf.h
stack.o: level.h
stack.o: mes.h
stack.o: noRoption.h
stack.o: nobitfield.h
stack.o: nofloat.h
stack.o: nopp.h
stack.o: spec_arith.h
stack.o: stack.h
stack.o: struct.h
stack.o: type.h
type.o: Lpars.h
type.o: align.h
type.o: arith.h
type.o: botch_free.h
type.o: def.h
type.o: idf.h
type.o: nobitfield.h
type.o: nocross.h
type.o: nofloat.h
type.o: nopp.h
type.o: sizes.h
type.o: spec_arith.h
type.o: target_sizes.h
type.o: type.h
ch7mon.o: Lpars.h
ch7mon.o: arith.h
ch7mon.o: botch_free.h
ch7mon.o: def.h
ch7mon.o: expr.h
ch7mon.o: idf.h
ch7mon.o: label.h
ch7mon.o: nobitfield.h
ch7mon.o: nofloat.h
ch7mon.o: nopp.h
ch7mon.o: spec_arith.h
ch7mon.o: type.h
label.o: Lpars.h
label.o: arith.h
label.o: def.h
label.o: idf.h
label.o: label.h
label.o: level.h
label.o: noRoption.h
label.o: nobitfield.h
label.o: nofloat.h
label.o: nopp.h
label.o: spec_arith.h
label.o: type.h
eval.o: Lpars.h
eval.o: align.h
eval.o: arith.h
eval.o: assert.h
eval.o: atw.h
eval.o: code.h
eval.o: dataflow.h
eval.o: debug.h
eval.o: def.h
eval.o: expr.h
eval.o: idf.h
eval.o: label.h
eval.o: level.h
eval.o: mes.h
eval.o: nobitfield.h
eval.o: nocross.h
eval.o: nofloat.h
eval.o: nopp.h
eval.o: sizes.h
eval.o: spec_arith.h
eval.o: specials.h
eval.o: stack.h
eval.o: target_sizes.h
eval.o: type.h
switch.o: Lpars.h
switch.o: arith.h
switch.o: assert.h
switch.o: botch_free.h
switch.o: code.h
switch.o: debug.h
switch.o: density.h
switch.o: expr.h
switch.o: idf.h
switch.o: label.h
switch.o: noRoption.h
switch.o: nobitfield.h
switch.o: nofloat.h
switch.o: nopp.h
switch.o: spec_arith.h
switch.o: switch.h
switch.o: type.h
conversion.o: Lpars.h
conversion.o: arith.h
conversion.o: nobitfield.h
conversion.o: nocross.h
conversion.o: nofloat.h
conversion.o: sizes.h
conversion.o: spec_arith.h
conversion.o: target_sizes.h
conversion.o: type.h
util.o: Lpars.h
util.o: align.h
util.o: def.h
util.o: nocross.h
util.o: nofloat.h
util.o: regcount.h
util.o: sizes.h
util.o: stack.h
util.o: target_sizes.h
util.o: use_tmp.h
util.o: util.h
blocks.o: Lpars.h
blocks.o: align.h
blocks.o: arith.h
blocks.o: atw.h
blocks.o: label.h
blocks.o: nocross.h
blocks.o: nofloat.h
blocks.o: sizes.h
blocks.o: spec_arith.h
blocks.o: stack.h
blocks.o: target_sizes.h
dataflow.o: dataflow.h
char.o: class.h
symbol2str.o: Lpars.h

230
lang/cem/cemcom/cem.1
View file

@ -1,230 +0,0 @@
.TH CEM 1L 86/11/12
.SH NAME
cem \- ACK C compiler
.SH SYNOPSIS
.B cem
[ option ] ... file ...
.SH DESCRIPTION
.I Cem
is a
.I cc (1)-like
C compiler that uses the C front-end compiler
.I cemcom (1)
of the Amsterdam Compiler Kit.
.I Cem
interprets its arguments not starting with a '\-' as
source files, to be compiled by the various parts of the compilation process,
which are listed below.
File arguments whose names end with \fB.\fP\fIcharacter\fP are interpreted as
follows:
.IP .[ao]
object file.
.IP .[ci]
C source code
.IP .e
EM assembler source file.
.IP .k
compact EM file, not yet optimized by the EM peephole optimizer.
.IP .m
compact EM file, already optimized by the peephole optimizer.
.IP .s
assembler file.
.LP
The actions to be taken by
.I cem
are directed by the type of file argument and the various options that are
presented to it.
.PP
The following set of options, which is a mixture of options interpreted by
.I cc (1)
and
.I ack (?)
are interpreted by
.I cem .
(The options not specified here are passed to the loader.)
.IP \fB\-B\fP\fIname\fP
Use
.I name
as front-end compiler instead of the default
.I cemcom (1).
.br
Same as "\fB\-Rcem=\fP\fIname\fP".
.IP \fB\-C\fP
Run C preprocessor
.I /lib/cpp
only and prevent it from eliding comments.
.IP \fB\-D\fP\fIname\fP\fB=\fP\fIdef\fP
Define the
.I name
to the preprocessor, as if by "#define".
.IP \fB\-D\fP\fIname\fP
.br
Same as "\fB\-D\fP\fIname\fP\fB=1\fP".
.IP \fB\-E\fP
Run only the macro preprocessor on the named files and send the
result to standard output.
.IP \fB\-I\fP\fIdir\fP
\&"#include" files whose names do not begin with '/' are always
sought first in the directory of the \fIfile\fP argument, then in directories
in \fB\-I\fP options, then in directories on a standard list (which in fact
consists of "/usr/include").
.IP \fB\-L\fP\fIdir\fP
Use \fIdir\fP as library-containing directory instead of the default.
.IP \fB\-N\fP\fIc\fP
Only effective if ACK pipeline is used.
This option causes some default actions and options to be suppressed, according
to
.I c :
.RS
.IP \fBc\fP
do not convert from EM a.out to local a.out format (i.e., skip the
.B cv
pass.)
.IP \fBl\fP
do not pass the default loader flags to the
.B ld
pass.
.RE
.IP \fB\-P\fP
Same as \fB\-E\fP, but sending the result of input file \fIfile\fP\fB.[ceis]\fP
to \fIfile\fP\fB.i\fP.
.IP \fB\-R\fP
Passed to \fIcemcom\fP(1) in order to parse the named C programs according
to the C language as described in [K&R] (also called \fIRestricted\fP C).
.IP \fB\-R\fP\fIprog\fP\fB=\fP\fIname\fP
.br
Use \fIname\fP as program for phase \fIprog\fP of the compilation instead of
the default.
\&\fIProg\fP is one of the following names:
.RS
.IP \fBcpp\fP
macro preprocessor
.IP \fBcem\fP
front\-end compiler
.IP \fBopt\fP
EM peephole optimizer
.IP \fBdecode\fP
EM compact to EM assembler translator
.IP \fBencode\fP
EM assembler to EM compact translator
.IP \fBbe\fP
EM compact code to target\-machine assembly code compiler
.IP \fBcg\fP
same as \fBbe\fP
.IP \fBas\fP
assembler
.IP \fBld\fP
linker/loader
.IP \fBcv\fP
a.out format converting program (only if ACK pipeline is used)
.RE
.IP \fB\-R\fP\fIprog\fP\fB\-\fP\fIoption\fP
.br
Pass \fB\-\fP\fIoption\fP to the compilation phase indicated by \fIprog\fP.
.IP \fB\-S\fP
Same as \fB\-c.s\fP.
.IP \fB\-U\fP\fIname\fP
.br
Remove any initial definition of \fIname\fP.
.IP \fB\-V\fP\fIcm\fP.\fIn\fP,\ \fB\-V\fIcm\fP.\fIncm\fP.\fIn\fP\ ...
.br
Set the size and alignment requirements of the C constructs of the named
C input files.
The letter \fIc\fP indicates the simple type, which is one of
\fBs\fP(short), \fBi\fP(int), \fBl\fP(long), \fBf\fP(float), \fBd\fP(double) or
\fBp\fP(pointer).
The \fIm\fP parameter can be used to specify the length of the type (in bytes)
and the \fIn\fP parameter for the alignment of that type.
Absence of \fIm\fP or \fIn\fP causes the default value to be retained.
To specify that the bitfields should be right adjusted instead of the
default left adjustment, specify \fBr\fP as \fIc\fP parameter
without parameters.
.br
This option is passed directly to \fIcemcom\fP(1).
.IP \fB\-c\fP
Same as \fB\-c.o\fP.
.IP \fB\-c.e\fP
Produce human-readable EM assembly code on \fIfile\fP\fB.e\fP for the
named files \fIfile\fP\fB.[cikm]\fP
.IP \fB\-c.k\fP
Compile C source \fIfile\fP\fB.[ci]\fP or
encode human-readable EM assembly code from \fIfile\fP\fB.e\fP
into non-optimized compact EM code and write the result on \fIfile\fP\fB.k\fP
.IP \fB\-c.m\fP
Compile C source \fIfile\fP\fB.[ci]\fP,
translate non-optimized EM code from \fIfile\fP\fB.k\fP or
encode EM assembly code from \fIfile\fP\fB.e\fP
into optimized compact EM code and write the result on \fIfile\fP\fB.m\fP
.IP \fB\-c.o\fP
Suppress the loading phase of the compilation, and force an object file to
be produced even if only one program is compiled
.IP \fB\-c.s\fP
Compile the named \fIfile\fP\fB.[ceikm]\fP input files, and leave the
assembly language output on corresponding files suffixed ".s".
.IP \fB\-k\fP
Same as \fB\-c.k\fP.
.IP \fB\-l\fP\fIname\fP
.br
Append the library \fBlib\fP\fIname\fP\fB.a\fP to the list of files that
should be loaded and linked into the final output file.
The library is searched for in the library directory.
.IP \fB\-m\fP
Same as \fB\-c.m\fP.
.IP \fB\-o\fP\ \fIoutput\fP
.br
Name the final output file \fIoutput\fP.
If this option is used, the default "a.out" will be left undisturbed.
.IP \fB\-p\fP
Produce EM profiling code (\fBfil\fP and \fBlin\fP instructions to
enable an interpreter to keep track of the current location in the
source code)
.IP \fB\-t\fP
Keep the intermediate files, produced during the various phases of the
compilation.
The produced files are named \fIfile\fP\fB.\fP\fIcharacter\fP where
\&\fIcharacter\fP indicates the type of the file as listed before.
.IP \fB\-v\fP
Verbose.
Print the commands before they are executed.
.IP \fB\-vn\fP
Do not really execute (for debugging purposes only).
.IP \fB\-vd\fP
Print some additional information (for debugging purposes only).
.IP \fB\-\-\fP\fIanything\fP
.br
Equivalent to \fB\-Rcem\-\-\fP\fIanything\fP.
The options
.B \-\-C ,
.B \-\-E
and
.B \-\-P
all have the same effect as respectively
.B \-C ,
.B \-E
and
.B \-P
except for the fact that the macro preprocessor is taken to be the
built\-in preprocessor of the \fBcem\fP phase.
Most "\-\-" options are used by
.I cemcom (1)
to set some internal debug switches.
.LP
.SH SEE ALSO
cemcom(1), cc(1), ack(?), as(1), ld(1)
.br
.IP [K&R]
B.W. Kernighan and D.M. Ritchie, \fIThe C Programming Language\fP,
Prentice-Hall, 1978.
.SH DIAGNOSTICS
.I Cem
reports any failure of its components.
.SH BUGS
.IP \(bu
All intermediate files are placed in the current working directory which
causes files with the same name as the intermediate files to be overwritten.
.IP \(bu
.B Cem
only accepts a limited number of arguments to be passed to the components.
(e.g., 256).
.IP \(bu
Please report suggestions and other bugs to erikb@vu44.uucp

764
lang/cem/cemcom/cem.c
View file

@ -1,764 +0,0 @@
/*
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
* See the copyright notice in the ACK home directory, in the file "Copyright".
*/
/* $Id$ */
/*
Driver for the CEMCOM compiler: works like /bin/cc and accepts
most of the options accepted by /bin/cc and /usr/em/bin/ack.
Date written: dec 4, 1985
Adapted for 68000 (Aug 19, 1986)
Merged the vax and mantra versions (Nov 10, 1986)
Author: Erik Baalbergen
*/
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <errno.h>
#include <signal.h>
#define MAXARGC 256 /* maximum number of arguments allowed in a list */
#define USTR_SIZE 1024 /* maximum length of string variable */
struct arglist {
int al_argc;
char *al_argv[MAXARGC];
};
/* some system-dependent variables */
char *PP = "/lib/cpp";
char *CEM = "/usr/em/lib/em_cemcom";
char *ENCODE = "/usr/em/lib/em_encode";
char *DECODE = "/usr/em/lib/em_decode";
char *OPT = "/usr/em/lib/em_opt";
char *SHELL = "/bin/sh";
#ifndef MANTRA
char *CG = "/usr/em/lib/vax4/cg";
char *AS = "/bin/as";
char *AS_FIX = "/user1/erikb/bin/mcomm";
char *LD = "/bin/ld";
char *LIBDIR = "/user1/cem/lib";
char *V_FLAG = "-Vs2.2w4.4i4.4l4.4f4.4d8.4p4.4";
#else MANTRA
char *CG = "/usr/em/lib/m68k2/cg";
char *AS = "/usr/em/lib/m68k2/as";
char *LD = "/usr/em/lib/em_led";
char *CV = "/usr/em/lib/m68k2/cv";
char *LIBDIR = "/usr/em/lib/m68k2";
char *V_FLAG = "-Vs2.2w2.2i2.2l4.2f4.2d8.2p4.2";
#endif MANTRA
struct arglist LD_HEAD = {
2,
{
#ifndef MANTRA
"/usr/em/lib/vax4/head_em",
"/usr/em/lib/vax4/head_cc"
#else MANTRA
"/usr/em/lib/m68k2/head_em",
"/usr/em/lib/m68k2/head_cc"
#endif MANTRA
}
};
struct arglist LD_TAIL = {
#ifndef MANTRA
4,
{
"/user1/cem/lib/libc.a",
"/user1/cem/lib/stb.o",
"/usr/em/lib/vax4/tail_mon",
"/usr/em/lib/vax4/tail_em"
}
#else MANTRA
7,
{
"/usr/em/lib/m68k2/tail_cc.1s",
"/usr/em/lib/m68k2/tail_cc.2g",
"/usr/em/lib/m68k2/tail_cem",
"/usr/em/lib/m68k2/tail_fp.a",
"/usr/em/lib/m68k2/tail_em.rt",
"/usr/em/lib/m68k2/tail_mon",
"/usr/em/lib/m68k2/end_em"
}
#endif MANTRA
};
char *o_FILE = "a.out";
#ifdef MANTRA
char *cv_FILE = "cv.out";
#endif MANTRA
#define remove(str) (((FLAG(t) == 0) && unlink(str)), (str)[0] = '\0')
#define cleanup(str) (str && remove(str))
#define mkname(dst, s1, s2) mkstr(dst, (s1), (s2), 0)
#define init(al) (al)->al_argc = 1
#define library(nm) \
mkstr(alloc((unsigned int)strlen(nm) + strlen(LIBDIR) + 7), \
LIBDIR, "/lib", nm, ".a", 0)
struct arglist SRCFILES, LDFILES, GEN_LDFILES, PP_FLAGS, CEM_FLAGS,
OPT_FLAGS, DECODE_FLAGS, ENCODE_FLAGS, CG_FLAGS, AS_FLAGS,
O_FLAGS, DEBUG_FLAGS, CALL_VEC;
#ifndef MANTRA
struct arglist LD_FLAGS;
#else MANTRA
struct arglist LD_FLAGS = {
5,
{
"-b0:0x80000",
"-a0:2",
"-a1:2",
"-a2:2",
"-a3:2"
}
};
struct arglist CV_FLAGS;
int Nc_flag = 0;
#endif MANTRA
/* option naming */
#define NAME(chr) chr
#define FLAG(chr) NAME(chr)_flag
int E_flag, P_flag, S_flag, c_flag, e_flag, k_flag,
m_flag, o_flag, t_flag, v_flag;
/* various passes */
struct prog {
char *p_name;
char **p_task;
struct arglist *p_flags;
} ProgParts[] = {
{ "cpp", &PP, &PP_FLAGS },
{ "cem", &CEM, &CEM_FLAGS },
{ "opt", &OPT, &OPT_FLAGS },
{ "decode", &DECODE, &DECODE_FLAGS },
{ "encode", &ENCODE, &ENCODE_FLAGS },
{ "be", &CG, &CG_FLAGS },
{ "cg", &CG, &CG_FLAGS },
{ "as", &AS, &AS_FLAGS },
{ "ld", &LD, &LD_FLAGS },
#ifdef MANTRA
{ "cv", &CV, &CV_FLAGS },
#endif MANTRA
{ 0, 0, 0 }
};
/* various forward declarations */
int trap();
char *mkstr();
char *alloc();
long sizeof_file();
/* various globals */
char *ProgCall = 0;
int debug = 0;
int exec = 1;
int RET_CODE = 0;
main(argc, argv)
char *argv[];
{
char *str, **argvec, *file, *ldfile = 0;
int count, ext;
char Nfile[USTR_SIZE], kfile[USTR_SIZE], sfile[USTR_SIZE],
mfile[USTR_SIZE], ofile[USTR_SIZE], BASE[USTR_SIZE];
register struct arglist *call = &CALL_VEC;
set_traps(trap);
ProgCall = *argv++;
append(&CEM_FLAGS, "-L");
while (--argc > 0) {
if (*(str = *argv++) != '-') {
append(&SRCFILES, str);
continue;
}
switch (str[1]) {
case '-':
switch (str[2]) {
case 'C':
case 'E':
case 'P':
FLAG(E) = 1;
append(&PP_FLAGS, str);
PP = CEM;
FLAG(P) = (str[2] == 'P');
break;
default:
append(&DEBUG_FLAGS, str);
break;
}
break;
case 'B':
PP = CEM = &str[2];
break;
case 'C':
case 'E':
case 'P':
FLAG(E) = 1;
append(&PP_FLAGS, str);
FLAG(P) = (str[1] == 'P');
break;
case 'c':
if (str[2] == '.') {
switch (str[3]) {
case 's':
FLAG(S) = 1;
break;
case 'k':
FLAG(k) = 1;
break;
case 'o':
FLAG(c) = 1;
break;
case 'm':
FLAG(m) = 1;
break;
case 'e':
FLAG(e) = 1;
break;
default:
bad_option(str);
}
}
else
if (str[2] == '\0')
FLAG(c) = 1;
else
bad_option(str);
break;
case 'D':
case 'I':
case 'U':
append(&PP_FLAGS, str);
break;
case 'k':
FLAG(k) = 1;
break;
case 'l':
if (str[2] == '\0') /* no standard libraries */
LD_HEAD.al_argc = LD_TAIL.al_argc = 0;
else /* use library from library directory */
append(&SRCFILES, library(&str[2]));
break;
case 'L': /* change default library directory */
LIBDIR = &str[2];
break;
case 'm':
FLAG(m) = 1;
break;
#ifdef MANTRA
case 'N':
switch (str[2]) {
case 'c': /* no a.out conversion */
Nc_flag = 1;
break;
case 'l': /* no default options to led */
LD_FLAGS.al_argc = 0;
break;
default:
bad_option(str);
}
break;
#endif MANTRA
case 'o':
FLAG(o) = 1;
if (argc-- < 0)
bad_option(str);
else
o_FILE = *argv++;
break;
case 'O':
append(&O_FLAGS, "-O");
break;
case 'R':
if (str[2] == '\0')
append(&CEM_FLAGS, str);
else
Roption(str);
break;
case 'S':
FLAG(S) = 1;
break;
case 't':
FLAG(t) = 1;
break;
case 'v': /* set debug switches */
FLAG(v) = 1;
switch (str[2]) {
case 'd':
debug = 1;
break;
case 'n': /* no execute */
exec = 0;
break;
case '\0':
break;
default:
bad_option(str);
}
break;
case 'V':
V_FLAG = str;
break;
default:
append(&LD_FLAGS, str);
}
}
if (debug) report("Note: debug output");
if (exec == 0)
report("Note: no execution");
count = SRCFILES.al_argc;
argvec = &(SRCFILES.al_argv[0]);
Nfile[0] = '\0';
while (count-- > 0) {
basename(file = *argvec++, BASE);
if (FLAG(E)) {
char ifile[USTR_SIZE];
init(call);
append(call, PP);
concat(call, &DEBUG_FLAGS);
concat(call, &PP_FLAGS);
append(call, file);
runvec(call, FLAG(P) ? mkname(ifile, BASE, ".i") : 0);
continue;
}
ext = extension(file);
/* .c to .k and .N */
if (ext == 'c' || ext == 'i') {
init(call);
append(call, CEM);
concat(call, &DEBUG_FLAGS);
append(call, V_FLAG);
concat(call, &CEM_FLAGS);
concat(call, &PP_FLAGS);
append(call, file);
append(call, mkname(kfile, BASE, ".k"));
append(call, mkname(Nfile, BASE, ".N"));
if (runvec(call, (char *)0)) {
file = kfile;
ext = 'k';
if (sizeof_file(Nfile) <= 0L)
remove(Nfile);
}
else {
remove(kfile);
remove(Nfile);
continue;
}
}
/* .e to .k */
if (ext == 'e') {
init(call);
append(call, ENCODE);
concat(call, &ENCODE_FLAGS);
append(call, file);
append(call, mkname(kfile, BASE, ".k"));
if (runvec(call, (char *)0) == 0)
continue;
file = kfile;
ext = 'k';
}
if (FLAG(k))
continue;
/* decode .k or .m */
if (FLAG(e) && (ext == 'k' || ext == 'm')) {
char efile[USTR_SIZE];
init(call);
append(call, DECODE);
concat(call, &DECODE_FLAGS);
append(call, file);
append(call, mkname(efile, BASE, ".e"));
runvec(call, (char *)0);
cleanup(kfile);
continue;
}
/* .k to .m */
if (ext == 'k') {
init(call);
append(call, OPT);
concat(call, &OPT_FLAGS);
append(call, file);
if (runvec(call, mkname(mfile, BASE, ".m")) == 0)
continue;
file = mfile;
ext = 'm';
cleanup(kfile);
}
if (FLAG(m))
continue;
/* .m to .s */
if (ext == 'm') {
init(call);
append(call, CG);
concat(call, &CG_FLAGS);
append(call, file);
append(call, mkname(sfile, BASE, ".s"));
if (runvec(call, (char *)0) == 0)
continue;
if (Nfile[0] != '\0') {
#ifndef MANTRA
init(call);
append(call, AS_FIX);
append(call, Nfile);
append(call, sfile);
runvec(call, (char *)0);
#endif MANTRA
remove(Nfile);
}
cleanup(mfile);
file = sfile;
ext = 's';
}
if (FLAG(S))
continue;
/* .s to .o */
if (ext == 's') {
ldfile = FLAG(c) ?
ofile :
alloc((unsigned)strlen(BASE) + 3);
init(call);
append(call, AS);
concat(call, &AS_FLAGS);
#ifdef MANTRA
append(call, "-");
#endif MANTRA
append(call, "-o");
append(call, mkname(ldfile, BASE, ".o"));
append(call, file);
if (runvec(call, (char *)0) == 0)
continue;
file = ldfile;
ext = 'o';
cleanup(sfile);
}
if (FLAG(c))
continue;
append(&LDFILES, file);
if (ldfile) {
append(&GEN_LDFILES, ldfile);
ldfile = 0;
}
}
/* *.o to a.out */
if (RET_CODE == 0 && LDFILES.al_argc > 0) {
init(call);
append(call, LD);
concat(call, &LD_FLAGS);
append(call, "-o");
#ifndef MANTRA
append(call, o_FILE);
#else MANTRA
append(call, Nc_flag ? o_FILE : cv_FILE);
#endif MANTRA
concat(call, &LD_HEAD);
concat(call, &LDFILES);
concat(call, &LD_TAIL);
if (runvec(call, (char *)0)) {
register i = GEN_LDFILES.al_argc;
while (i-- > 0)
remove(GEN_LDFILES.al_argv[i]);
#ifdef MANTRA
/* convert to local a.out format */
if (Nc_flag == 0) {
init(call);
append(call, CV);
concat(call, &CV_FLAGS);
append(call, cv_FILE);
append(call, o_FILE);
if (runvec(call, (char *)0))
remove(cv_FILE);
}
#endif MANTRA
}
}
exit(RET_CODE);
}
#define BUFSIZE (USTR_SIZE * MAXARGC)
char alloc_buf[BUFSIZE];
char *
alloc(u)
unsigned u;
{
static char *bufptr = &alloc_buf[0];
register char *p = bufptr;
if ((bufptr += u) >= &alloc_buf[BUFSIZE])
panic("no space");
return p;
}
append(al, arg)
register struct arglist *al;
char *arg;
{
if (al->al_argc >= MAXARGC)
panic("argument list overflow");
al->al_argv[(al->al_argc)++] = arg;
}
concat(al1, al2)
struct arglist *al1, *al2;
{
register int i = al2->al_argc;
register char **p = &(al1->al_argv[al1->al_argc]);
register char **q = &(al2->al_argv[0]);
if ((al1->al_argc += i) >= MAXARGC)
panic("argument list overflow");
while (i-- > 0)
*p++ = *q++;
}
/* The next function is a dirty old one, taking a variable number of
arguments.
Take care that the last argument is a null-valued pointer!
*/
/*VARARGS1*/
char *
mkstr(dst, arg)
char *dst, *arg;
{
char **vec = (char **) &arg;
register char *p;
register char *q = dst;
while (p = *vec++) {
while (*q++ = *p++);
q--;
}
return dst;
}
Roption(str)
char *str; /* of the form "prog=/-arg" */
{
char *eq;
char *prog, *arg;
char bc;
char *cindex();
prog = &str[2];
if (eq = cindex(prog, '='))
bc = '=';
else
if (eq = cindex(prog, '-'))
bc = '-';
else {
bad_option(str);
return;
}
*eq++ = '\0';
if (arg = eq) {
char *opt = 0;
struct prog *pp = &ProgParts[0];
if (bc == '-')
opt = mkstr(alloc((unsigned)strlen(arg) + 2),
"-", arg, 0);
while (pp->p_name) {
if (strcmp(prog, pp->p_name) == 0) {
if (opt)
append(pp->p_flags, opt);
else
*(pp->p_task) = arg;
return;
}
pp++;
}
}
bad_option(str);
}
basename(str, dst)
char *str;
register char *dst;
{
register char *p1 = str;
register char *p2 = p1;
while (*p1)
if (*p1++ == '/')
p2 = p1;
p1--;
if (*--p1 == '.') {
*p1 = '\0';
while (*dst++ = *p2++) {}
*p1 = '.';
}
else
while (*dst++ = *p2++) {}
}
int
extension(fn)
register char *fn;
{
char c;
while (*fn++) {}
fn--;
c = *--fn;
return (*--fn == '.') ? c : 0;
}
long
sizeof_file(nm)
char *nm;
{
struct stat stbuf;
if (stat(nm, &stbuf) == 0)
return stbuf.st_size;
return -1;
}
char * sysmsg[] = {
0,
"Hangup",
"Interrupt",
"Quit",
"Illegal instruction",
"Trace/BPT trap",
"IOT trap",
"EMT trap",
"Floating exception",
"Killed",
"Bus error",
"Memory fault",
"Bad system call",
"Broken pipe",
"Alarm call",
"Terminated",
"Signal 16"
};
runvec(vec, outp)
struct arglist *vec;
char *outp;
{
int status, fd;
char *task = vec->al_argv[1];
vec->al_argv[vec->al_argc] = 0;
if (FLAG(v))
print_vec(vec);
if (exec == 0)
return 1;
if (fork() == 0) { /* start up the process */
extern int errno;
if (outp) { /* redirect standard output */
close(1);
if ((fd = creat(outp, 0666)) < 0)
panic("cannot create %s", outp);
if (fd != 1)
panic("illegal redirection");
}
if (debug) report("exec %s", task);
execv(task, &(vec->al_argv[1]));
/* not an a.out file, let's try it with the SHELL */
if (debug) report("try it with %s", SHELL);
if (errno == ENOEXEC) {
vec->al_argv[0] = SHELL;
execv(SHELL, &(vec->al_argv[0]));
}
/* failed, so ... */
panic("cannot execute %s", task);
exit(1);
}
else {
int loworder, highorder, sig;
wait(&status);
loworder = status & 0377;
highorder = (status >> 8) & 0377;
if (loworder == 0) {
if (highorder)
report("%s: exit status %d", task, highorder);
return highorder ? ((RET_CODE = 1), 0) : 1;
}
else {
sig = loworder & 0177;
if (sig == 0177)
report("%s: stopped by ptrace", task);
else
if (sysmsg[sig])
report("%s: %s%s", task, sysmsg[sig],
(loworder & 0200)
? " - core dumped"
: "");
RET_CODE = 1;
return 0;
}
}
/*NOTREACHED*/
}
bad_option(str)
char *str;
{
report("bad option %s", str);
}
/*VARARGS1*/
report(fmt, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
char *fmt;
{
fprintf(stderr, "%s: ", ProgCall);
fprintf(stderr, fmt, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9);
fprintf(stderr, "\n");
}
/*VARARGS1*/
panic(fmt, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
char *fmt;
{
fprintf(stderr, "%s: ", ProgCall);
fprintf(stderr, fmt, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9);
fprintf(stderr, "\n");
exit(1);
}
set_traps(f)
int (*f)();
{
signal(SIGHUP, f);
signal(SIGINT, f);
signal(SIGQUIT, f);
signal(SIGALRM, f);
signal(SIGTERM, f);
}
/*ARGSUSED*/
trap(sig)
{
set_traps(SIG_IGN);
panic("Trapped");
}
print_vec(vec)
struct arglist *vec;
{
register i;
for (i = 1; i < vec->al_argc; i++)
printf("%s ", vec->al_argv[i]);
printf("\n");
}
char *
cindex(s, c)
char *s, c;
{
while (*s)
if (*s++ == c)
return s - 1;
return (char *) 0;
}