ceriel 28 anni fa
parent
commit
2d7f92d93a

+ 0 - 20
lang/basic/src.old/.distr

@@ -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

+ 0 - 53
lang/basic/src.old/Makefile

@@ -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)

+ 0 - 484
lang/basic/src.old/basic.lex

@@ -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;
-}

+ 0 - 483
lang/basic/src.old/basic.yacc

@@ -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"

+ 0 - 53
lang/basic/src.old/bem.c

@@ -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);
-}

+ 0 - 76
lang/basic/src.old/bem.h

@@ -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();

+ 0 - 24
lang/basic/src.old/compile.c

@@ -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);
-}

+ 0 - 444
lang/basic/src.old/eval.c

@@ -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));
-}

+ 0 - 223
lang/basic/src.old/func.c

@@ -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);
-}
-

+ 0 - 585
lang/basic/src.old/gencode.c

@@ -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");
-}

+ 0 - 298
lang/basic/src.old/graph.c

@@ -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);
-}

+ 0 - 40
lang/basic/src.old/graph.h

@@ -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();

+ 0 - 49
lang/basic/src.old/initialize.c

@@ -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 */
-}

+ 0 - 58
lang/basic/src.old/parsepar.c

@@ -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");
-}

+ 0 - 94
lang/basic/src.old/split.c

@@ -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();
-}

+ 0 - 294
lang/basic/src.old/symbols.c

@@ -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]);
-}

+ 0 - 89
lang/basic/src.old/symbols.h

@@ -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();

+ 0 - 91
lang/basic/src.old/util.c

@@ -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);
-}

+ 0 - 25
lang/basic/src.old/yywrap.c

@@ -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);
-}

+ 0 - 718
lang/cem/cemcom/Makefile.erik

@@ -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

+ 0 - 230
lang/cem/cemcom/cem.1

@@ -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

+ 0 - 764
lang/cem/cemcom/cem.c

@@ -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;
-}