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

Merge pull request #174 from ccodere/carl-ansi-part1

Browse source 
Carl ansi part1
This commit is contained in:
David Given 2019-03-07 20:51:08 +01:00 committed by GitHub
parent ca3e272233 8f6073d446
commit e2625813c9
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
95 changed files with 2058 additions and 1622 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lang/basic/src/basic.g
View file

@ -90,6 +90,10 @@
#include <stdlib.h> #include <stdlib.h>
#include <stdio.h> #include <stdio.h>
#include "bem.h" #include "bem.h"
#include "util.h"
#include "gencode.h"
#include "eval.h"
#include "func.h"
#include "llmess.h" #include "llmess.h"
typedef union { typedef union {

23
lang/basic/src/basic.lex
View file

@ -3,7 +3,8 @@
* See the copyright notice in the ACK home directory, in the file "Copyright". * See the copyright notice in the ACK home directory, in the file "Copyright".
*/ */
#ifndef NORSCID
#ifndef NORCSID
static char rcs_lex[] = "$Id$" ; static char rcs_lex[] = "$Id$" ;
#endif #endif
@ -151,7 +152,7 @@ Key keywords [] ={
int kex[27]; int kex[27];
/* Initialize the keyword table */ /* Initialize the keyword table */
fillkex() void fillkex(void)
{ {
Key *k; Key *k;
int i; int i;
@ -235,7 +236,7 @@ File *stream;
} }
} }
getinputline() int getinputline(void)
{ {
/* get next input line */ /* get next input line */
@ -255,7 +256,7 @@ getinputline()
typechar() int typechar(void)
{ {
switch(*cptr) switch(*cptr)
{ {
@ -277,7 +278,7 @@ typechar()
char name[SIGNIFICANT+1]; char name[SIGNIFICANT+1];
lookup() int lookup(void)
{ {
Key *k; Key *k;
Symbol *Sym; Symbol *Sym;
@ -341,7 +342,7 @@ lookup()
/* Parsing unsigned numbers */ /* Parsing unsigned numbers */
readconstant() int readconstant(void)
{ {
/* read HEX and OCTAL numbers */ /* read HEX and OCTAL numbers */
char *c; char *c;
@ -372,9 +373,7 @@ readconstant()
#ifdef ____ #ifdef ____
/* Computes base to the power exponent. This was not done in the old /* Computes base to the power exponent. This was not done in the old
compiler */ compiler */
double powr(base,exp) double powr(double base,int exp)
double base;
int exp;
{ {
int i; int i;
double result; double result;
@ -398,7 +397,7 @@ int exp;
#endif #endif
number() int number(void)
{ {
long i1; long i1;
int overflow = 0; int overflow = 0;
@ -468,7 +467,7 @@ number()
scanstring() int scanstring(void)
{ {
int i,length=0; int i,length=0;
char firstchar = *cptr; char firstchar = *cptr;
@ -532,7 +531,7 @@ scanstring()
yylex() int yylex(void)
{ {
char *c; char *c;

14
lang/basic/src/bem.c
View file

@ -4,8 +4,12 @@
*/ */
#include "bem.h" #include "bem.h"
#include "parsepar.h"
#include "system.h"
#include "graph.h"
#ifndef NORSCID
#ifndef NORCSID
static char rcs_id[] = "$Id$" ; static char rcs_id[] = "$Id$" ;
static char rcs_bem[] = RCS_BEM ; static char rcs_bem[] = RCS_BEM ;
static char rcs_symb[] = RCS_SYMB ; static char rcs_symb[] = RCS_SYMB ;
@ -33,9 +37,11 @@ char *inpfile, *outfile;
int BEMINTSIZE = EMINTSIZE; int BEMINTSIZE = EMINTSIZE;
int BEMPTRSIZE = EMPTRSIZE; int BEMPTRSIZE = EMPTRSIZE;
int BEMFLTSIZE = EMFLTSIZE; int BEMFLTSIZE = EMFLTSIZE;
main(argc,argv)
int argc; extern void initialize(void);
char **argv; extern void compileprogram(void);
int main(int argc,char **argv)
{ {
extern int errorcnt; extern int errorcnt;

9
lang/basic/src/bem.h
View file

@ -4,13 +4,14 @@
*/ */
#include <stdlib.h> #include <stdlib.h>
#include <stdio.h>
#include <ctype.h> #include <ctype.h>
#include <string.h> #include <string.h>
#include <signal.h> #include <signal.h>
#include <system.h> #include "system.h"
#include <print.h> #include "print.h"
#include <em.h> #include "em.h"
#include <em_mes.h> #include "em_mes.h"
/* Author: M.L. Kersten /* Author: M.L. Kersten
** Here all the global objects are defined. ** Here all the global objects are defined.

14
lang/basic/src/compile.c
View file

@ -3,19 +3,25 @@
* See the copyright notice in the ACK home directory, in the file "Copyright". * See the copyright notice in the ACK home directory, in the file "Copyright".
*/ */
/*#include "bem.h"*/
#include <stdio.h>
#include "system.h"
#include "gencode.h"
#include "bem.h" #include "bem.h"
#ifndef NORSCID #ifndef NORCSID
static char rcs_id[] = "$Id$" ; static char rcs_id[] = "$Id$" ;
#endif #endif
extern int getinputline(void);
extern void LLparse(void);
/* compile the next program in the list */ /* compile the next program in the list */
/* Here we should open the input file. (for the future) */ /* Here we should open the input file. (for the future) */
File *yyin; File *yyin;
compileprogram() void compileprogram(void)
{ {
extern int basicline; extern int basicline;
@ -24,7 +30,9 @@ compileprogram()
epilogcode in the new version of the compiler */ epilogcode in the new version of the compiler */
while( basicline = 0, getinputline()) while( basicline = 0, getinputline())
(void) LLparse(); {
LLparse();
}
epilogcode(); epilogcode();
sys_close(yyin); sys_close(yyin);
} }

80
lang/basic/src/eval.c
View file

@ -4,8 +4,10 @@
*/ */
#include "bem.h" #include "bem.h"
#include "util.h"
#include "gencode.h"
#ifndef NORSCID #ifndef NORCSID
static char rcs_id[] = "$Id$" ; static char rcs_id[] = "$Id$" ;
#endif #endif
@ -14,8 +16,7 @@ static char rcs_id[] = "$Id$" ;
generate code for assignment statements generate code for assignment statements
*/ */
exprtype(ltype,rtype) static int exprtype(int ltype,int rtype)
int ltype,rtype;
{ {
/* determine the result type of an expression */ /* determine the result type of an expression */
if ( ltype==STRINGTYPE || rtype==STRINGTYPE) if ( ltype==STRINGTYPE || rtype==STRINGTYPE)
@ -31,9 +32,7 @@ int ltype,rtype;
void void conversion(int oldtype,int newtype)
conversion(oldtype,newtype)
int oldtype,newtype;
{ {
/* the value on top of the stack should be converted */ /* the value on top of the stack should be converted */
if ( oldtype==newtype) return; if ( oldtype==newtype) return;
@ -62,7 +61,10 @@ int oldtype,newtype;
C_lfr((arith)BEMINTSIZE); C_lfr((arith)BEMINTSIZE);
break; break;
} else if ( newtype==FLOATTYPE || newtype==DOUBLETYPE) } else if ( newtype==FLOATTYPE || newtype==DOUBLETYPE)
{
break; break;
}
break;
default: default:
if (debug) if (debug)
print("type n=%d o=%d\n",newtype,oldtype); print("type n=%d o=%d\n",newtype,oldtype);
@ -72,9 +74,7 @@ int oldtype,newtype;
void void extraconvert(int oldtype,int newtype,int topstack)
extraconvert(oldtype,newtype,topstack)
int oldtype,newtype,topstack;
{ {
/* the value below the top of the stack should be converted */ /* the value below the top of the stack should be converted */
if ( oldtype==newtype ) return; if ( oldtype==newtype ) return;
@ -116,8 +116,7 @@ int oldtype,newtype,topstack;
boolop(ltype,rtype,operator) int boolop(int ltype,int rtype,int operator)
int ltype,rtype,operator;
{ {
if ( operator != NOTSYM) if ( operator != NOTSYM)
{ {
@ -158,8 +157,7 @@ int ltype,rtype,operator;
genbool(operator) void genbool(int operator)
int operator;
{ {
int l1,l2; int l1,l2;
@ -186,8 +184,7 @@ int operator;
relop( ltype,rtype,operator) int relop(int ltype,int rtype,int operator)
int ltype,rtype,operator;
{ {
int result; int result;
@ -213,8 +210,7 @@ int ltype,rtype,operator;
plusmin(ltype,rtype,operator) int plusmin(int ltype,int rtype,int operator)
int ltype,rtype,operator;
{ {
int result; int result;
@ -246,8 +242,7 @@ int ltype,rtype,operator;
muldiv(ltype,rtype,operator) int muldiv(int ltype,int rtype,int operator)
int ltype,rtype,operator;
{ {
int result; int result;
@ -286,8 +281,7 @@ int ltype,rtype,operator;
negate(type) int negate(int type)
int type;
{ {
switch(type) switch(type)
{ {
@ -307,8 +301,7 @@ int type;
#ifdef ___ #ifdef ___
power(ltype,rtype) int power(int ltype,int rtype)
int ltype,rtype;
{ {
int resulttype = exprtype(ltype, rtype); int resulttype = exprtype(ltype, rtype);
@ -330,8 +323,7 @@ int ltype,rtype;
return(resulttype); return(resulttype);
} }
#else #else
power(ltype,rtype) int power(int ltype,int rtype)
int ltype,rtype;
{ {
extraconvert(ltype,DOUBLETYPE,rtype); extraconvert(ltype,DOUBLETYPE,rtype);
conversion(rtype,DOUBLETYPE); conversion(rtype,DOUBLETYPE);
@ -343,8 +335,7 @@ int ltype,rtype;
#endif #endif
int typesize(ltype) int typesize(int ltype)
int ltype;
{ {
switch( ltype) switch( ltype)
{ {
@ -364,8 +355,7 @@ int ltype;
int typestring(type) int typestring(int type)
int type;
{ {
switch(type) switch(type)
{ {
@ -384,8 +374,7 @@ int type;
loadvar(type) void loadvar(int type)
int type;
{ {
/* load a simple variable its address is on the stack*/ /* load a simple variable its address is on the stack*/
C_loi((arith)typestring(type)); C_loi((arith)typestring(type));
@ -393,8 +382,7 @@ int type;
loadint(value) int loadint(int value)
int value;
{ {
C_loc((arith)value); C_loc((arith)value);
return(INTTYPE); return(INTTYPE);
@ -402,8 +390,7 @@ int value;
loaddbl(value) int loaddbl(char* value)
char *value;
{ {
int index; int index;
@ -417,16 +404,14 @@ char *value;
loadstr(value) void loadstr(int value)
int value;
{ {
C_lae_dlb((label)value,(arith)0); C_lae_dlb((label)value,(arith)0);
} }
loadaddr(s) int loadaddr(Symbol *s)
Symbol *s;
{ {
extern Symbol *fcn; extern Symbol *fcn;
int i,j; int i,j;
@ -450,7 +435,7 @@ Symbol *s;
/* This is a new routine */ /* This is a new routine */
save_address() void save_address(void)
{ {
C_lae_dnam("dummy3",(arith)0); C_lae_dnam("dummy3",(arith)0);
C_sti((arith)BEMPTRSIZE); C_sti((arith)BEMPTRSIZE);
@ -458,8 +443,7 @@ save_address()
assign(type,lt) void assign(int type,int lt)
int type,lt;
{ {
extern int e1,e2; extern int e1,e2;
@ -472,8 +456,7 @@ int type,lt;
storevar(lab,type) void storevar(int lab,int type)
int lab,type;
{ {
/*store value back */ /*store value back */
C_lae_dlb((label)lab,(arith)0); C_lae_dlb((label)lab,(arith)0);
@ -488,8 +471,7 @@ Symbol *arraystk[MAXDIMENSIONS];
newarrayload(s) void newarrayload(Symbol *s)
Symbol *s;
{ {
if ( dimtop<MAXDIMENSIONS) dimtop++; if ( dimtop<MAXDIMENSIONS) dimtop++;
if ( s->dimensions==0) if ( s->dimensions==0)
@ -504,16 +486,14 @@ Symbol *s;
endarrayload() int endarrayload(void)
{ {
return(arraystk[dimtop--]->symtype); return(arraystk[dimtop--]->symtype);
} }
void void loadarray(int type)
loadarray(type)
int type;
{ {
int dim; int dim;
Symbol *s; Symbol *s;

54
lang/basic/src/eval.h Normal file
View file

@ -0,0 +1,54 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
*/
#ifndef __EVAL_H_INCLUDED__
#define __EVAL_H_INCLUDED__
#include "symbols.h"
/*--------------------------- Utilities -----------------------*/
/** From an internal type definition return the size in bytes of the data.
* If not a known data type return an integer size. */
extern int typesize(int ltype);
/** From an internal type definition return the size in bytes of the data. If not a
* known data type return a 0 size. */
extern int typestring(int type);
/*-------------------------- Code generation ---------------------*/
/** Emit code to convert from the old internal type to the new internal type definition.
* Generates an error if the type conversion is not allowed. */
extern void conversion(int oldtype,int newtype);
/** Emit code to store a value of the specified type from the top of stack
* into the specified variable pointed to by label.
*/
extern void storevar(int lab,int type);
/** Emit code to load a simple variable value on the stack. On input the address of the variable
* is on the stack. */
extern void loadvar(int type);
extern void extraconvert(int oldtype,int newtype,int topstack);
extern void loadstr(int value);
extern int endarrayload(void);
extern void loadarray(int type);
extern void save_address(void);
extern void assign(int type,int lt);
extern int boolop(int ltype,int rtype,int operator);
extern int relop(int ltype,int rtype,int operator);
extern int plusmin(int ltype,int rtype,int operator);
extern int muldiv(int ltype,int rtype,int operator);
extern int negate(int type);
extern int power(int ltype,int rtype);
extern int loadint(int value);
extern int loaddbl(char* value);
extern int loadaddr(Symbol *s);
extern void newarrayload(Symbol *s);
#endif /* __EVAL_H_INCLUDED */

11
lang/basic/src/func.c
View file

@ -4,8 +4,10 @@
*/ */
#include "bem.h" #include "bem.h"
#include "util.h"
#include "eval.h"
#ifndef NORSCID #ifndef NORCSID
static char rcs_id[] = "$Id$" ; static char rcs_id[] = "$Id$" ;
#endif #endif
@ -19,8 +21,7 @@ int exprlimit;
parm(cnt) void parm(int cnt)
int cnt;
{ {
if( cnt> exprlimit) if( cnt> exprlimit)
error("Not enough arguments"); error("Not enough arguments");
@ -30,9 +31,7 @@ int cnt;
callfcn(fcnnr,cnt,typetable) int callfcn(int fcnnr,int cnt,int *typetable)
int fcnnr,cnt;
int *typetable;
{ {
int pop=DOUBLETYPE; int pop=DOUBLETYPE;
int res=DOUBLETYPE; int res=DOUBLETYPE;

13
lang/basic/src/func.h Normal file
View file

@ -0,0 +1,13 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
*/
#ifndef __FUNC_H_INCLUDED__
#define __FUNC_H_INCLUDED__
extern int callfcn(int fcnnr,int cnt,int *typetable);
#endif /* __FUNC_H_INCLUDED__ */

101
lang/basic/src/gencode.c
View file

@ -4,9 +4,12 @@
*/ */
#include "bem.h" #include "bem.h"
#include "system.h" #include "graph.h"
#include "eval.h"
#include "util.h"
#include "gencode.h"
#ifndef NORSCID #ifndef NORCSID
static char rcs_id[] = "$Id$" ; static char rcs_id[] = "$Id$" ;
#endif #endif
@ -18,14 +21,14 @@ label err_goto_label;
genlabel() int genlabel(void)
{ {
return(emlabel++); return(emlabel++);
} }
genemlabel() int genemlabel(void)
{ {
int l; int l;
@ -39,8 +42,7 @@ genemlabel()
int tronoff=0; int tronoff=0;
newemblock(nr) void newemblock(int nr)
int nr;
{ {
C_df_ilb((label)currline->emlabel); C_df_ilb((label)currline->emlabel);
C_lin((arith)nr); C_lin((arith)nr);
@ -57,7 +59,7 @@ int nr;
/* Handle data statements */ /* Handle data statements */
List *datalist=0; List *datalist=0;
datastmt() void datastmt(void)
{ {
List *l,*l1; List *l,*l1;
@ -78,7 +80,7 @@ datastmt()
datatable() void datatable(void)
{ {
List *l; List *l;
int line=0; int line=0;
@ -100,8 +102,7 @@ datatable()
/* ERROR and exception handling */ /* ERROR and exception handling */
exceptstmt(lab) void exceptstmt(int lab)
int lab;
{ {
/* exceptions to subroutines are supported only */ /* exceptions to subroutines are supported only */
extern int gosubcnt; extern int gosubcnt;
@ -116,8 +117,7 @@ int lab;
errorstmt(exprtype) void errorstmt(int exprtype)
int exprtype;
{ {
/* convert expression to a valid error number */ /* convert expression to a valid error number */
/* obtain the message and print it */ /* obtain the message and print it */
@ -128,8 +128,7 @@ int exprtype;
/* BASIC IO */ /* BASIC IO */
openstmt(recsize) void openstmt(int recsize)
int recsize;
{ {
C_loc((arith)recsize); C_loc((arith)recsize);
C_cal("_opnchn"); C_cal("_opnchn");
@ -138,8 +137,7 @@ int recsize;
printstmt(exprtype) void printstmt(int exprtype)
int exprtype;
{ {
switch(exprtype) switch(exprtype)
{ {
@ -165,16 +163,14 @@ int exprtype;
zone(i) void zone(int i)
int i;
{ {
if ( i) C_cal("_zone"); if ( i) C_cal("_zone");
} }
writestmt(exprtype,comma) void writestmt(int exprtype, int comma)
int exprtype,comma;
{ {
if ( comma) C_cal("_wrcomma"); if ( comma) C_cal("_wrcomma");
@ -198,8 +194,7 @@ int exprtype,comma;
restore(lab) void restore(int lab)
int lab;
{ {
/* save this information too */ /* save this information too */
@ -213,8 +208,7 @@ int lab;
prompt(qst) void prompt(int qst)
int qst;
{ {
setchannel(-1); setchannel(-1);
C_cal("_prstr"); C_cal("_prstr");
@ -224,8 +218,7 @@ int qst;
linestmt(type) void linestmt(int type)
int type;
{ {
if ( type!= STRINGTYPE) if ( type!= STRINGTYPE)
error("String variable expected"); error("String variable expected");
@ -235,8 +228,7 @@ int type;
readelm(type) void readelm(int type)
int type;
{ {
switch(type) switch(type)
{ {
@ -259,8 +251,7 @@ int type;
/* Swap exchanges the variable values */ /* Swap exchanges the variable values */
swapstmt(ltype,rtype) void swapstmt(int ltype,int rtype)
int ltype, rtype;
{ {
if ( ltype!= rtype) if ( ltype!= rtype)
error("Type mismatch"); error("Type mismatch");
@ -287,9 +278,9 @@ int ltype, rtype;
/* input/output handling */ /* input/output handling */
setchannel(val) void setchannel(int val)
int val; {
{ /* obtain file descroption */ /* obtain file descroption */
C_loc((arith)val); C_loc((arith)val);
C_cal("_setchan"); C_cal("_setchan");
C_asp((arith)BEMINTSIZE); C_asp((arith)BEMINTSIZE);
@ -298,8 +289,7 @@ int val;
/* The if-then-else statements */ /* The if-then-else statements */
ifstmt(type) int ifstmt(int type)
int type;
{ {
/* This BASIC follows the True= -1 rule */ /* This BASIC follows the True= -1 rule */
int nr; int nr;
@ -322,8 +312,7 @@ int type;
thenpart( elselab) int thenpart(int elselab)
int elselab;
{ {
int nr; int nr;
@ -335,7 +324,7 @@ int elselab;
elsepart(lab)int lab; void elsepart(int lab)
{ {
C_df_ilb((label)lab); C_df_ilb((label)lab);
} }
@ -359,8 +348,7 @@ int forcnt= -1;
forinit(s) void forinit(Symbol *s)
Symbol *s;
{ {
int type; int type;
struct FORSTRUCT *f; struct FORSTRUCT *f;
@ -388,8 +376,7 @@ Symbol *s;
forexpr(type) void forexpr(int type)
int type;
{ {
/* save start value of loop variable in a save place*/ /* save start value of loop variable in a save place*/
/* to avoid clashing with final value and step expression */ /* to avoid clashing with final value and step expression */
@ -402,8 +389,7 @@ int type;
forlimit(type) void forlimit(int type)
int type;
{ {
/* save the limit value too*/ /* save the limit value too*/
int result; int result;
@ -415,8 +401,7 @@ int type;
forskipped(f) void forskipped(struct FORSTRUCT *f)
struct FORSTRUCT *f;
{ {
int type; int type;
@ -452,8 +437,7 @@ struct FORSTRUCT *f;
forstep(type) void forstep(int type)
int type;
{ {
int result; int result;
int varaddress; int varaddress;
@ -522,8 +506,7 @@ int type;
nextstmt(s) void nextstmt(Symbol *s)
Symbol *s;
{ {
if (forcnt>MAXFORDEPTH || forcnt<0 || if (forcnt>MAXFORDEPTH || forcnt<0 ||
(s && s!= fortable[forcnt].loopvar)) (s && s!= fortable[forcnt].loopvar))
@ -538,8 +521,7 @@ Symbol *s;
pokestmt(type1,type2) void pokestmt(int type1,int type2)
int type1,type2;
{ {
conversion(type1,INTTYPE); conversion(type1,INTTYPE);
conversion(type2,INTTYPE); conversion(type2,INTTYPE);
@ -553,7 +535,7 @@ int type1,type2;
int whilecnt, whilelabels[MAXDEPTH][2]; /*0=head,1=out */ int whilecnt, whilelabels[MAXDEPTH][2]; /*0=head,1=out */
whilestart() void whilestart(void)
{ {
whilecnt++; whilecnt++;
if ( whilecnt==MAXDEPTH) if ( whilecnt==MAXDEPTH)
@ -567,8 +549,7 @@ whilestart()
whiletst(exprtype) void whiletst(int exprtype)
int exprtype;
{ {
/* test expression type */ /* test expression type */
conversion(exprtype,INTTYPE); conversion(exprtype,INTTYPE);
@ -577,7 +558,7 @@ int exprtype;
wend() void wend(void)
{ {
if ( whilecnt<1) if ( whilecnt<1)
error("not part of while statement"); error("not part of while statement");
@ -591,7 +572,7 @@ wend()
/* generate code for the final version */ /* generate code for the final version */
prologcode() void prologcode(void)
{ {
/* generate the EM prolog code */ /* generate the EM prolog code */
C_df_dnam("fltnull"); C_df_dnam("fltnull");
@ -623,7 +604,7 @@ prologcode()
prolog2() void prolog2(void)
{ {
int result; int result;
label l = genlabel(), l2; label l = genlabel(), l2;
@ -659,7 +640,7 @@ prolog2()
/* NEW */ /* NEW */
gendata() void gendata(void)
{ {
C_loc((arith)0); C_loc((arith)0);
C_cal("_setchan"); C_cal("_setchan");
@ -685,7 +666,7 @@ gendata()
epilogcode() void epilogcode(void)
{ {
/* finalization code */ /* finalization code */
int nr; int nr;

64
lang/basic/src/gencode.h Normal file
View file

@ -0,0 +1,64 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
*/
#ifndef __GENCODE_H_INCLUDED__
#define __GENCODE_H_INCLUDED__
#include "symbols.h"
/*--------------------------- Utilities -----------------------*/
/** Return a global value identifier used for code generation */
extern int genlabel(void);
/*-------------------------- Code generation ---------------------*/
/** Emit a label definition and return the label identifier generated. */
extern int genemlabel(void);
void newemblock(int nr);
void newblock(int nr);
void datastmt(void);
void datatable(void);
/* ERROR and exception handling */
void exceptstmt(int lab);
void errorstmt(int exprtype);
/* BASIC IO */
void openstmt(int recsize);
void printstmt(int exprtype);
void zone(int i);
void writestmt(int exprtype, int comma);
void restore(int lab);
void prompt(int qst);
void linestmt(int type);
void readelm(int type);
/* Swap exchanges the variable values */
void swapstmt(int ltype,int rtype);
void setchannel(int val);
int ifstmt(int type);
int thenpart(int elselab);
void elsepart(int lab);
void forinit(Symbol *s);
void forexpr(int type);
void forlimit(int type);
void forstep(int type);
void nextstmt(Symbol *s);
void pokestmt(int type1,int type2);
void whilestart(void);
void whiletst(int exprtype);
void wend(void);
/* generate code for the final version */
void prologcode(void);
void prolog2(void);
void gendata(void);
void epilogcode(void);
void setchannel(int val);
void gendata(void);
#endif /* __GENCODE_H_INCLUDED__ */

42
lang/basic/src/graph.c
View file

@ -4,8 +4,11 @@
*/ */
#include "bem.h" #include "bem.h"
#include "util.h"
#include "eval.h"
#include "gencode.h"
#ifndef NORSCID #ifndef NORCSID
static char rcs_id[] = "$Id$" ; static char rcs_id[] = "$Id$" ;
#endif #endif
@ -18,7 +21,7 @@ Linerecord *firstline,
List *newlist() List *newlist(void)
{ {
List *l; List *l;
@ -29,8 +32,7 @@ List *newlist()
/* Line management is handled here */ /* Line management is handled here */
Linerecord *srchline(nr) Linerecord *srchline(int nr)
int nr;
{ {
Linerecord *l; Linerecord *l;
@ -41,8 +43,7 @@ int nr;
List *srchforward(nr) List *srchforward(int nr)
int nr;
{ {
List *l; List *l;
@ -53,7 +54,7 @@ int nr;
linewarnings() void linewarnings(void)
{ {
List *l; List *l;
extern int errorcnt; extern int errorcnt;
@ -72,8 +73,7 @@ linewarnings()
newblock(nr) void newblock(int nr)
int nr;
{ {
Linerecord *l; Linerecord *l;
List *frwrd; List *frwrd;
@ -111,8 +111,7 @@ int nr;
gotolabel(nr) int gotolabel(int nr)
int nr;
{ {
/* simulate a goto statement in the line record table */ /* simulate a goto statement in the line record table */
Linerecord *l1; Linerecord *l1;
@ -146,8 +145,7 @@ int nr;
gotostmt(nr) void gotostmt(int nr)
int nr;
{ {
C_bra((label) gotolabel(nr)); C_bra((label) gotolabel(nr));
} }
@ -160,7 +158,7 @@ int gosubcnt=1;
List *gosublabel() List *gosublabel(void)
{ {
List *l; List *l;
@ -177,8 +175,7 @@ List *gosublabel()
gosubstmt(lab) void gosubstmt(int lab)
int lab;
{ {
List *l; List *l;
int nr,n; int nr,n;
@ -197,7 +194,7 @@ int lab;
genreturns() void genreturns(void)
{ {
int count; int count;
int nr; int nr;
@ -227,7 +224,7 @@ genreturns()
returnstmt() void returnstmt(void)
{ {
C_cal("_retstmt"); C_cal("_retstmt");
C_lfr((arith) BEMINTSIZE); C_lfr((arith) BEMINTSIZE);
@ -242,8 +239,7 @@ List *jumphead,*jumptail;
int jumpcnt; int jumpcnt;
jumpelm(nr) void jumpelm(int nr)
int nr;
{ {
List *l; List *l;
@ -260,8 +256,7 @@ int nr;
ongotostmt(type) void ongotostmt(int type)
int type;
{ {
/* generate the code itself, index in on top of the stack */ /* generate the code itself, index in on top of the stack */
/* blurh, store the number of entries in the descriptor */ /* blurh, store the number of entries in the descriptor */
@ -294,8 +289,7 @@ int type;
ongosubstmt(type) void ongosubstmt(int type)
int type;
{ {
List *l; List *l;
int firstlabel; int firstlabel;

18
lang/basic/src/graph.h
View file

@ -3,6 +3,9 @@
* See the copyright notice in the ACK home directory, in the file "Copyright". * See the copyright notice in the ACK home directory, in the file "Copyright".
*/ */
#ifndef __GRAPH_H_INCLUDED__
#define __GRAPH_H_INCLUDED__
#ifndef NORCSID #ifndef NORCSID
# define RCS_GRAPH "$Id$" # define RCS_GRAPH "$Id$"
#endif #endif
@ -35,3 +38,18 @@ extern Linerecord *firstline,
extern List *forwardlabel; extern List *forwardlabel;
extern List *gosublabel(); extern List *gosublabel();
extern void jumpelm(int nr);
extern int gotolabel(int nr);
extern void linewarnings(void);
/*-------------------------- Code generation ---------------------*/
extern void genreturns(void);
extern void gosubstmt(int lab);
extern void gotostmt(int nr);
extern void returnstmt(void);
extern void ongosubstmt(int type);
extern void ongotostmt(int type);
#endif

10
lang/basic/src/initialize.c
View file

@ -3,9 +3,11 @@
* See the copyright notice in the ACK home directory, in the file "Copyright". * See the copyright notice in the ACK home directory, in the file "Copyright".
*/ */
#include <stdio.h>
#include "bem.h" #include "bem.h"
#include "util.h"
#ifndef NORSCID #ifndef NORCSID
static char rcs_id[] = "$Id$"; static char rcs_id[] = "$Id$";
#endif #endif
@ -13,9 +15,9 @@ static char rcs_id[] = "$Id$";
File *datfile; File *datfile;
extern void fillkex(void);
void initialize(void)
initialize()
{ {
register char *cindex, *cptr; register char *cindex, *cptr;
int result1, result2; int result1, result2;
@ -33,7 +35,7 @@ initialize()
} }
} }
cptr=datfname; cptr=datfname;
while ( *cptr++ = *cindex++ ); while ( (*cptr++ = *cindex++) !=0 );
/* Strip trailing suffix */ /* Strip trailing suffix */
if ( cptr>datfname+3 && cptr[-3]=='.' ) cptr[-3]=0; if ( cptr>datfname+3 && cptr[-3]=='.' ) cptr[-3]=0;
strcat(datfname,".d"); strcat(datfname,".d");

14
lang/basic/src/llmess.h
View file

@ -3,16 +3,17 @@
* See the copyright notice in the ACK home directory, in the file "Copyright". * See the copyright notice in the ACK home directory, in the file "Copyright".
*/ */
#include <stdio.h>
#include "tokentab.h" #include "tokentab.h"
#include "system.h"
#include "print.h"
/* Mod van gertjan */ /* Mod van gertjan */
extern int LLsymb; extern int LLsymb;
extern int toknum; extern int toknum;
error_char(format,ch) void error_char(char *format,char ch)
char *format;
char ch;
{ {
extern int listing,errorcnt; extern int listing,errorcnt;
extern int basicline; extern int basicline;
@ -24,9 +25,7 @@ char ch;
error_string(format,str) void error_string(char* format,char* str)
char *format;
char *str;
{ {
extern int listing,errorcnt; extern int listing,errorcnt;
extern int basicline; extern int basicline;
@ -38,8 +37,7 @@ char *str;
LLmessage( insertedtok ) void LLmessage(int insertedtok )
int insertedtok;
{ {
if ( insertedtok < 0 ) { if ( insertedtok < 0 ) {
error("Fatal stack overflow\n"); error("Fatal stack overflow\n");

11
lang/basic/src/options Normal file
View file

@ -0,0 +1,11 @@
User options:
D parser debugging
t line tracing
d debug information
E generate full listing
L don't generate linenumbers and filename indications
w suppress warning diagnostics
VwN set word size to N bytes
VpN set pointer size to N bytes
VfN set real size to N bytes

12
lang/basic/src/parsepar.c
View file

@ -3,9 +3,15 @@
* See the copyright notice in the ACK home directory, in the file "Copyright". * See the copyright notice in the ACK home directory, in the file "Copyright".
*/ */
#include "parsepar.h"
#include "bem.h" #include "bem.h"
#include <stdio.h>
#include "print.h"
#include "system.h"
#include "util.h"
#ifndef NORSCID
#ifndef NORCSID
static char rcs_id[] = "$Id$" ; static char rcs_id[] = "$Id$" ;
#endif #endif
@ -18,9 +24,7 @@ int nolins=0; /* generate no LIN statements */
parseparams(argc,argv) void parseparams(int argc,char **argv)
int argc;
char **argv;
{ {
int files=0 ; int files=0 ;
int i; int i;

23
lang/basic/src/parsepar.h Normal file
View file

@ -0,0 +1,23 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
*/
#ifndef __PARSEPAR_H_INCLUDED__
#define __PARSEPAR_H_INCLUDED__
/** -l listing required */
extern int listing;
/** -d compiler debugging */
extern int debug;
/** -w warning flags */
extern int wflag;
/** generate line tracing code. */
extern int traceflag;
/** generate LIN statements */
extern int nolins;
void parseparams(int argc,char **argv);
#endif /* __PARSEPAR_H_INCLUDED__ */

65
lang/basic/src/symbols.c
View file

@ -3,9 +3,18 @@
* See the copyright notice in the ACK home directory, in the file "Copyright". * See the copyright notice in the ACK home directory, in the file "Copyright".
*/ */
#include "symbols.h"
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "bem.h" #include "bem.h"
#include "eval.h"
#include "gencode.h"
#include "util.h"
#ifndef NORSCID
#ifndef NORCSID
static char rcs_id[] = "$Id$" ; static char rcs_id[] = "$Id$" ;
#endif #endif
@ -15,7 +24,11 @@ int deftype[128]; /* default type declarer */
/* which may be set by OPTION BASE */ /* which may be set by OPTION BASE */
initdeftype() /* Local declarations */
static void get_space(int type,int size);
void initdeftype(void)
{ {
int i; int i;
@ -31,8 +44,7 @@ Symbol *alternate = NIL;
Symbol *srchsymbol(str) Symbol *srchsymbol(char* str)
char *str;
{ {
Symbol *s; Symbol *s;
@ -68,9 +80,7 @@ char *str;
void void dcltype(Symbol *s)
dcltype(s)
Symbol *s;
{ {
/* type declarer */ /* type declarer */
int type; int type;
@ -79,7 +89,7 @@ Symbol *s;
type=s->symtype; type=s->symtype;
if (type==DEFAULTTYPE) if (type==DEFAULTTYPE)
/* use the default rule */ /* use the default rule */
type= deftype[*s->symname]; type= deftype[(int)(*s->symname)];
/* generate the emlabel too */ /* generate the emlabel too */
if ( s->symalias==0) if ( s->symalias==0)
s->symalias= dclspace(type); s->symalias= dclspace(type);
@ -89,8 +99,7 @@ Symbol *s;
dclarray(s) void dclarray(Symbol *s)
Symbol *s;
{ {
int i; int size; int i; int size;
@ -122,8 +131,7 @@ Symbol *s;
get_space(type,size) static void get_space(int type,int size)
int type,size;
{ {
switch ( type ) { switch ( type ) {
@ -153,8 +161,7 @@ int type,size;
defarray(s) void defarray(Symbol *s)
Symbol *s;
{ {
/* array is used without dim statement, set default limits */ /* array is used without dim statement, set default limits */
int i; int i;
@ -164,7 +171,7 @@ Symbol *s;
dclspace(type) int dclspace(int type)
{ {
int nr; int nr;
@ -189,8 +196,7 @@ dclspace(type)
/* SOME COMPILE TIME OPTIONS */ /* SOME COMPILE TIME OPTIONS */
optionbase(ival) void optionbase(int ival)
int ival;
{ {
if ( ival<0 || ival>1) if ( ival<0 || ival>1)
error("illegal option base value"); error("illegal option base value");
@ -199,8 +205,7 @@ int ival;
setdefaulttype(type) void setdefaulttype(int type)
int type;
{ {
extern char *cptr; extern char *cptr;
char first,last,i; char first,last,i;
@ -233,8 +238,7 @@ Symbol *fcn;
newscope(s) void newscope(Symbol *s)
Symbol *s;
{ {
if (debug) print("new scope for %s\n",s->symname); if (debug) print("new scope for %s\n",s->symname);
alternate= firstsym; alternate= firstsym;
@ -253,7 +257,7 @@ Symbol *s;
heading( ) void heading(void)
{ {
char procname[50]; char procname[50];
@ -265,7 +269,7 @@ heading( )
int fcnsize() static int fcnsize(void)
{ {
/* generate portable function size */ /* generate portable function size */
int i,sum; /* sum is NEW */ int i,sum; /* sum is NEW */
@ -278,8 +282,7 @@ int fcnsize()
endscope(type) void endscope(int type)
int type;
{ {
Symbol *s; Symbol *s;
@ -304,8 +307,7 @@ int type;
dclparm(s) void dclparm(Symbol *s)
Symbol *s;
{ {
int size=0; int size=0;
@ -327,8 +329,7 @@ int fcnindex= -1;
fcncall(s) int fcncall(Symbol *s)
Symbol *s;
{ {
if ( !s->isfunction) if ( !s->isfunction)
error("Function not declared"); error("Function not declared");
@ -342,8 +343,7 @@ Symbol *s;
fcnend(parmcount) int fcnend(int parmcount)
int parmcount;
{ {
int type; int type;
static char concatbuf[50]; /* NEW */ static char concatbuf[50]; /* NEW */
@ -366,8 +366,7 @@ int parmcount;
callparm(ind,type) void callparm(int ind,int type)
int ind,type;
{ {
if ( fcnindex<0) error("unexpected parameter"); if ( fcnindex<0) error("unexpected parameter");
if ( ind >= fcn->dimensions) if ( ind >= fcn->dimensions)

22
lang/basic/src/symbols.h
View file

@ -3,6 +3,9 @@
* See the copyright notice in the ACK home directory, in the file "Copyright". * See the copyright notice in the ACK home directory, in the file "Copyright".
*/ */
#ifndef __SYMBOLS_H_INCLUDED__
#define __SYMBOLS_H_INCLUDED__
#ifndef NORCSID #ifndef NORCSID
# define RCS_SYMB "$Id$" # define RCS_SYMB "$Id$"
#endif #endif
@ -85,4 +88,21 @@ typedef struct SYMBOL{
int isparam; int isparam;
} Symbol; } Symbol;
extern Symbol *srchsymbol(); void initdeftype(void);
Symbol *srchsymbol(char* str);
void dcltype(Symbol *s);
void dclarray(Symbol *s);
void defarray(Symbol *s);
int dclspace(int type);
void optionbase(int ival);
void setdefaulttype(int type);
void newscope(Symbol *s);
void heading(void);
void endscope(int type);
void dclparm(Symbol *s);
int fcncall(Symbol *s);
int fcnend(int parmcount);
void callparm(int ind,int type);
#endif /* __SYMBOLS_H_INCLUDED__ */

57
lang/basic/src/util.c
View file

@ -3,9 +3,12 @@
* See the copyright notice in the ACK home directory, in the file "Copyright". * See the copyright notice in the ACK home directory, in the file "Copyright".
*/ */
#include "system.h"
#include "util.h"
#include "bem.h" #include "bem.h"
#ifndef NORSCID
#ifndef NORCSID
static char rcs_id[] = "$Id$" ; static char rcs_id[] = "$Id$" ;
#endif #endif
@ -16,25 +19,8 @@ int errorcnt;
void
warning(str)
char *str;
{
if (wflag) return;
Xerror("WARNING", str);
}
static void Xerror(char *type, char *str)
error(str)
char *str;
{
Xerror("ERROR", str);
errorcnt++;
}
Xerror(type, str)
char *str;
char *type;
{ {
extern int listing; extern int listing;
extern int basicline; extern int basicline;
@ -45,8 +31,23 @@ char *type;
fatal(str)
char *str; void warning(char* str)
{
if (wflag) return;
Xerror("WARNING", str);
}
void error(char* str)
{
Xerror("ERROR", str);
errorcnt++;
}
void fatal(char* str)
{ {
Xerror("FATAL",str); Xerror("FATAL",str);
C_close(); C_close();
@ -55,22 +56,21 @@ char *str;
notyetimpl() void notyetimpl(void)
{ {
warning("not yet implemented"); warning("not yet implemented");
} }
illegalcmd() void illegalcmd(void)
{ {
warning("illegal command"); warning("illegal command");
} }
char *myitoa(i) char *myitoa(int i)
int i;
{ {
static char buf[30]; static char buf[30];
@ -79,12 +79,7 @@ int i;
} }
char *salloc(unsigned int length)
char *salloc(length)
unsigned length;
{ {
char *s,*c; char *s,*c;

32
lang/basic/src/util.h Normal file
View file

@ -0,0 +1,32 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
*/
#ifndef __UTIL_H_INCLUDED__
#define __UTIL_H_INCLUDED__
/** Raises a warning with the specified message. */
void warning(char* str);
/** Raises a non fatal error with the specified message. */
void error(char* str);
/** Raises a fatal error with the specified message and
quits the application. */
void fatal(char* str);
/** Error management to raise a warning on an unimplemented
* feature. */
void notyetimpl(void);
/** Error management to raise a warning on an illegal command
line option. */
void illegalcmd(void);
char *myitoa(int i);
/** Tries to allocates a memory block of the specified number of bytes, and exits
* with a fatal error upon a failure. Upon allocation success, fills the allocated
* memory block with binary 0.
*/
char *salloc(unsigned int length);
#endif /* __UTIL_H_INCLUDED__ */

4
lang/basic/src/yylexp.h
View file

@ -5,7 +5,9 @@
int toknum; int toknum;
yylexp() extern int yylex(void);
int yylexp(void)
{ {
/* als toknum != 0 dan bevat toknum een door LLmessage back-ge-pushed token */ /* als toknum != 0 dan bevat toknum een door LLmessage back-ge-pushed token */

34
lang/cem/cpp.ansi/LLlex.c
View file

@ -15,7 +15,9 @@
#include "idf.h" #include "idf.h"
#include "LLlex.h" #include "LLlex.h"
#include "Lpars.h" #include "Lpars.h"
#include "replace.h"
#include "class.h" #include "class.h"
#include "error.h"
#include "bits.h" #include "bits.h"
#define BUFSIZ 1024 #define BUFSIZ 1024
@ -30,20 +32,26 @@ int AccFileSpecifier = 0; /* return filespecifier <...> */
int LexSave = 0; /* last character read by GetChar */ int LexSave = 0; /* last character read by GetChar */
extern int InputLevel; /* # of current macro expansions */ extern int InputLevel; /* # of current macro expansions */
extern char* string_token();
extern arith char_constant();
#define FLG_ESEEN 0x01 /* possibly a floating point number */ #define FLG_ESEEN 0x01 /* possibly a floating point number */
#define FLG_DOTSEEN 0x02 /* certainly a floating point number */ #define FLG_DOTSEEN 0x02 /* certainly a floating point number */
void skipcomment();
void skiplinecomment(void);
int LLlex() /* Private forward definitions */
static arith char_constant(char*);
static char* string_token(char *, int);
static int quoted(register int);
static int val_in_base(register int, int);
static int trigraph(void);
int LLlex(void)
{ {
return (DOT != EOF) ? GetToken(&dot) : EOF; return (DOT != EOF) ? GetToken(&dot) : EOF;
} }
int GetToken(ptok) register struct token* ptok; int GetToken(register struct token* ptok)
{ {
/* GetToken() is the actual token recognizer. It calls the /* GetToken() is the actual token recognizer. It calls the
control line interpreter if it encounters a "\n{w}*#" control line interpreter if it encounters a "\n{w}*#"
@ -385,7 +393,7 @@ again: /* rescan the input after an error or replacement */
/*NOTREACHED*/ /*NOTREACHED*/
} }
void skipcomment() void skipcomment(void)
{ {
/* The last character read has been the '*' of '/_*'. The /* The last character read has been the '*' of '/_*'. The
characters, except NL and EOI, between '/_*' and the first characters, except NL and EOI, between '/_*' and the first
@ -437,7 +445,7 @@ void skiplinecomment(void)
} }
} }
arith char_constant(nm) char* nm; static arith char_constant(char* nm)
{ {
register arith val = 0; register arith val = 0;
register int ch; register int ch;
@ -471,7 +479,7 @@ arith char_constant(nm) char* nm;
return val; return val;
} }
char* string_token(nm, stop_char) char* nm; static char* string_token(char *nm, int stop_char)
{ {
register int ch; register int ch;
register int str_size; register int str_size;
@ -504,7 +512,7 @@ char* string_token(nm, stop_char) char* nm;
return str; return str;
} }
int quoted(ch) register int ch; static int quoted(register int ch)
{ {
/* quoted() replaces an escaped character sequence by the /* quoted() replaces an escaped character sequence by the
character meant. character meant.
@ -567,7 +575,7 @@ int quoted(ch) register int ch;
return ch & 0377; return ch & 0377;
} }
int val_in_base(ch, base) register int ch; static int val_in_base(register int ch, int base)
{ {
switch (base) switch (base)
{ {
@ -583,7 +591,7 @@ int val_in_base(ch, base) register int ch;
} }
} }
int GetChar() int GetChar(void)
{ {
/* The routines GetChar and trigraph parses the trigraph /* The routines GetChar and trigraph parses the trigraph
sequences and removes occurences of \\\n. sequences and removes occurences of \\\n.
@ -612,7 +620,7 @@ again:
return (LexSave = ch); return (LexSave = ch);
} }
int trigraph() static int trigraph(void)
{ {
register int ch; register int ch;

13
lang/cem/cpp.ansi/LLlex.h
View file

@ -4,6 +4,8 @@
*/ */
/* $Id$ */ /* $Id$ */
/* D E F I N I T I O N S F O R T H E L E X I C A L A N A L Y Z E R */ /* D E F I N I T I O N S F O R T H E L E X I C A L A N A L Y Z E R */
#ifndef LLLEX_H_
#define LLLEX_H_
/* A token from the input stream is represented by an integer, /* A token from the input stream is represented by an integer,
called a "symbol", but it may have other information associated called a "symbol", but it may have other information associated
@ -44,3 +46,14 @@ extern int err_occurred; /* "error.c" */
#define DOT dot.tk_symb #define DOT dot.tk_symb
#define EOF (-1) #define EOF (-1)
/* Public function declarations */
int LLlex(void);
int GetToken(register struct token* ptok);
void skipcomment(void);
void skiplinecomment(void);
/* Get next character input, with trigraph parsing and newline */
int GetChar(void);
#endif /* LLLLEX_H_ */

11
lang/cem/cpp.ansi/LLmessage.c
View file

@ -8,15 +8,20 @@
#include "arith.h" #include "arith.h"
#include "LLlex.h" #include "LLlex.h"
#include "Lpars.h" #include "Lpars.h"
#include "skip.h"
#include "error.h"
extern char *symbol2str(); extern char *symbol2str();
LLmessage(tk) { void LLmessage(int tk)
{
if (tk < 0) if (tk < 0)
error("garbage at end of line"); error("garbage at end of line");
else if (tk) { else if (tk)
{
error("%s missing", symbol2str(tk)); error("%s missing", symbol2str(tk));
if (DOT != EOF) SkipToNewLine(); if (DOT != EOF)
SkipToNewLine();
DOT = EOF; DOT = EOF;
} }
else else

7
lang/cem/cpp.ansi/ch3bin.c
View file

@ -7,10 +7,11 @@
#include "Lpars.h" #include "Lpars.h"
#include "arith.h" #include "arith.h"
#include "ch3bin.h"
#include "skip.h"
#include "error.h"
ch3bin(pval, pis_uns, oper, val, is_uns) void ch3bin(register arith *pval, int *pis_uns, int oper, register arith val, int is_uns)
register arith *pval, val;
int oper, is_uns, *pis_uns;
{ {
if (is_uns) *pis_uns = 1; if (is_uns) *pis_uns = 1;
switch (oper) { switch (oper) {

5
lang/cem/cpp.ansi/ch3mon.c
View file

@ -5,13 +5,12 @@
/* $Id$ */ /* $Id$ */
/* EVALUATION OF MONADIC OPERATORS */ /* EVALUATION OF MONADIC OPERATORS */
#include "ch3mon.h"
#include "Lpars.h" #include "Lpars.h"
#include "arith.h" #include "arith.h"
/*ARGSUSED2*/ /*ARGSUSED2*/
ch3mon(oper, pval, puns) void ch3mon(int oper, register arith *pval, int *puns)
register arith *pval;
int *puns;
{ {
switch (oper) { switch (oper) {
case '~': case '~':

12
lang/cem/cpp.ansi/class.h
View file

@ -10,7 +10,7 @@
At present such a class number is supposed to fit in 4 bits. At present such a class number is supposed to fit in 4 bits.
*/ */
#define class(ch) ((tkclass)[ch]) #define class(ch) ((tkclass)[(unsigned int)ch])
/* Being the start of a token is, fortunately, a mutual exclusive /* Being the start of a token is, fortunately, a mutual exclusive
property, so, as there are less than 16 classes they can be property, so, as there are less than 16 classes they can be
@ -37,11 +37,11 @@
class. This is implemented as a collection of tables to speed up class. This is implemented as a collection of tables to speed up
the decision whether a character has a special meaning. the decision whether a character has a special meaning.
*/ */
#define in_idf(ch) (inidf[ch]) #define in_idf(ch) (inidf[(unsigned int)ch])
#define is_oct(ch) (isoct[ch]) #define is_oct(ch) (isoct[(unsigned int)ch])
#define is_dig(ch) (isdig[ch]) #define is_dig(ch) (isdig[(unsigned int)ch])
#define is_hex(ch) (ishex[ch]) #define is_hex(ch) (ishex[(unsigned int)ch])
#define is_wsp(ch) (iswsp[ch]) #define is_wsp(ch) (iswsp[(unsigned int)ch])
extern char tkclass[]; extern char tkclass[];
extern char inidf[], isoct[], isdig[], ishex[], iswsp[]; extern char inidf[], isoct[], isdig[], ishex[], iswsp[];

93
lang/cem/cpp.ansi/domacro.c
View file

@ -8,22 +8,26 @@
#include <assert.h> #include <assert.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include "domacro.h"
#include "arith.h" #include "arith.h"
#include "LLlex.h" #include "LLlex.h"
#include "Lpars.h" #include "Lpars.h"
#include "idf.h" #include "idf.h"
#include "input.h" #include "input.h"
#include "error.h"
#include "parameters.h" #include "parameters.h"
#include "preprocess.h"
#include <alloc.h> #include <alloc.h>
#include "class.h" #include "class.h"
#include "macro.h" #include "macro.h"
#include "LLlex.h"
#include "bits.h" #include "bits.h"
#include "skip.h"
#include "replace.h" #include "replace.h"
extern char options[]; extern char options[];
extern char** inctable; /* list of include directories */ extern char** inctable; /* list of include directories */
extern char* getwdir();
char ifstack[IFDEPTH]; /* if-stack: the content of an entry is */ char ifstack[IFDEPTH]; /* if-stack: the content of an entry is */
/* 1 if a corresponding ELSE has been */ /* 1 if a corresponding ELSE has been */
/* encountered. */ /* encountered. */
@ -33,10 +37,33 @@ int svnestlevel[30] = { -1 };
int nestcount; int nestcount;
extern int do_preprocess; extern int do_preprocess;
void macro_def(); /* Internal declarations */
void do_define();
char* GetIdentifier(skiponerr) int skiponerr; /* skip the rest of the line on error */
static void do_define(void);
static void do_elif(void);
static void do_else(void);
static void push_if(void);
static void do_endif(void);
static void do_if(void);
static void do_ifdef(int);
static void do_include(void);
static void do_line(unsigned int);
static int find_name(char* , char* []);
static char* get_text(char* [], int* );
static int getparams(char* [], char []);
static int ifexpr(void);
static int macroeq(register char*, register char *);
static void skip_block(int);
static void do_error(void);
/* External dependencies to C files with no include files */
extern void If_expr(void);
extern void add_dependency(char *);
char* GetIdentifier(int skiponerr /* skip the rest of the line on error */
)
{ {
/* Returns a pointer to the identifier that is read from the /* Returns a pointer to the identifier that is read from the
input stream. When the input does not contain an input stream. When the input does not contain an
@ -62,16 +89,8 @@ char* GetIdentifier(skiponerr) int skiponerr; /* skip the rest of the line on er
return tk.tk_str; return tk.tk_str;
} }
/* domacro() is the control line interpreter. The '#' has already
been read by the lexical analyzer by which domacro() is called. void domacro(void)
The token appearing directly after the '#' is obtained by calling
the basic lexical analyzing function GetToken() and is interpreted
to perform the action belonging to that token.
An error message is produced when the token is not recognized.
Pragma's are handled by do_pragma(). They are passed on to the
compiler.
*/
domacro()
{ {
struct token tk; /* the token itself */ struct token tk; /* the token itself */
register struct idf* id; register struct idf* id;
@ -156,7 +175,7 @@ domacro()
} }
} }
void skip_block(to_endif) int to_endif; static void skip_block(int to_endif)
{ {
/* skip_block() skips the input from /* skip_block() skips the input from
1) a false #if, #ifdef, #ifndef or #elif until the 1) a false #if, #ifdef, #ifndef or #elif until the
@ -303,9 +322,9 @@ void skip_block(to_endif) int to_endif;
} }
} }
ifexpr() static int ifexpr(void)
{ {
/* ifexpr() returns whether the restricted constant /* Returns whether the restricted constant
expression following #if or #elif evaluates to true. This expression following #if or #elif evaluates to true. This
is done by calling the LLgen generated subparser for is done by calling the LLgen generated subparser for
constant expressions. The result of this expression will constant expressions. The result of this expression will
@ -324,7 +343,7 @@ ifexpr()
return (errors == err_occurred) && (ifval != (arith)0); return (errors == err_occurred) && (ifval != (arith)0);
} }
do_include() static void do_include(void)
{ {
/* do_include() performs the inclusion of a file. /* do_include() performs the inclusion of a file.
*/ */
@ -368,7 +387,7 @@ do_include()
} }
} }
void do_define() static void do_define(void)
{ {
/* do_define() interprets a #define control line. /* do_define() interprets a #define control line.
*/ */
@ -378,8 +397,7 @@ void do_define()
char parbuf[PARBUFSIZE]; /* names of formals */ char parbuf[PARBUFSIZE]; /* names of formals */
char* repl_text; /* start of the replacement text */ char* repl_text; /* start of the replacement text */
int length; /* length of the replacement text */ int length; /* length of the replacement text */
register ch; register int ch;
char* get_text();
/* read the #defined macro's name */ /* read the #defined macro's name */
if (!(str = GetIdentifier(1))) if (!(str = GetIdentifier(1)))
@ -411,7 +429,7 @@ void do_define()
LineNumber++; LineNumber++;
} }
push_if() static void push_if(void)
{ {
if (nestlevel >= IFDEPTH) if (nestlevel >= IFDEPTH)
fatal("too many nested #if/#ifdef/#ifndef"); fatal("too many nested #if/#ifdef/#ifndef");
@ -419,7 +437,7 @@ push_if()
ifstack[++nestlevel] = 0; ifstack[++nestlevel] = 0;
} }
do_elif() static void do_elif(void)
{ {
if (nestlevel <= svnestlevel[nestcount]) if (nestlevel <= svnestlevel[nestcount])
{ {
@ -439,7 +457,7 @@ do_elif()
} }
} }
do_else() static void do_else(void)
{ {
if (SkipToNewLine()) if (SkipToNewLine())
{ {
@ -459,7 +477,7 @@ do_else()
} }
} }
do_endif() static void do_endif(void)
{ {
if (SkipToNewLine()) if (SkipToNewLine())
{ {
@ -474,14 +492,14 @@ do_endif()
nestlevel--; nestlevel--;
} }
do_if() static void do_if(void)
{ {
push_if(); push_if();
if (!ifexpr()) /* a false #if/#elif expression */ if (!ifexpr()) /* a false #if/#elif expression */
skip_block(0); skip_block(0);
} }
do_ifdef(how) static void do_ifdef(int how)
{ {
register struct idf* id; register struct idf* id;
register char* str; register char* str;
@ -513,7 +531,7 @@ do_ifdef(how)
} }
/* argstr != NULL when the undef came from a -U option */ /* argstr != NULL when the undef came from a -U option */
do_undef(argstr) char* argstr; void do_undef(char* argstr)
{ {
register struct idf* id; register struct idf* id;
register char* str = argstr; register char* str = argstr;
@ -548,7 +566,7 @@ do_undef(argstr) char* argstr;
error("illegal #undef construction"); error("illegal #undef construction");
} }
do_error() static void do_error(void)
{ {
int len; int len;
char* get_text(); char* get_text();
@ -559,8 +577,7 @@ do_error()
LineNumber++; LineNumber++;
} }
int getparams(buf, parbuf) char* buf[]; static int getparams(char* buf[], char parbuf[])
char parbuf[];
{ {
/* getparams() reads the formal parameter list of a macro /* getparams() reads the formal parameter list of a macro
definition. definition.
@ -633,8 +650,7 @@ char parbuf[];
/*NOTREACHED*/ /*NOTREACHED*/
} }
void macro_def(id, text, nformals, length, flags) register struct idf* id; void macro_def(register struct idf* id, char* text, int nformals, int length, int flags)
char* text;
{ {
register struct macro* newdef = id->id_macro; register struct macro* newdef = id->id_macro;
@ -681,7 +697,7 @@ char* text;
newdef->mc_flag = flags; /* special flags */ newdef->mc_flag = flags; /* special flags */
} }
int find_name(nm, index) char *nm, *index[]; static int find_name(char* nm, char *index[])
{ {
/* find_name() returns the index of "nm" in the namelist /* find_name() returns the index of "nm" in the namelist
"index" if it can be found there. 0 is returned if it is "index" if it can be found there. 0 is returned if it is
@ -698,8 +714,7 @@ int find_name(nm, index) char *nm, *index[];
#define BLANK(ch) ((ch == ' ') || (ch == '\t')) #define BLANK(ch) ((ch == ' ') || (ch == '\t'))
char* get_text(formals, length) char* formals[]; static char* get_text(char* formals[], int* length)
int* length;
{ {
/* get_text() copies the replacement text of a macro /* get_text() copies the replacement text of a macro
definition with zero, one or more parameters, thereby definition with zero, one or more parameters, thereby
@ -811,7 +826,7 @@ int* length;
add2repl(repl, ' '); add2repl(repl, ' ');
} }
/* construct the formal parameter mark or identifier */ /* construct the formal parameter mark or identifier */
if (n = find_name(id_buf, formals)) if ((n = find_name(id_buf, formals)))
add2repl(repl, FORMALP | (char)n); add2repl(repl, FORMALP | (char)n);
else else
{ {
@ -873,7 +888,7 @@ int* length;
as strings, without taking care of the leading and trailing as strings, without taking care of the leading and trailing
blanks (spaces and tabs). blanks (spaces and tabs).
*/ */
macroeq(s, t) register char* s, *t; static int macroeq(register char* s, register char *t)
{ {
/* skip leading spaces */ /* skip leading spaces */
@ -902,7 +917,7 @@ macroeq(s, t) register char* s, *t;
} }
} }
do_line(l) unsigned int l; static void do_line(unsigned int l)
{ {
struct token tk; struct token tk;
int t = GetToken(&tk); int t = GetToken(&tk);

24
lang/cem/cpp.ansi/error.c
View file

@ -14,6 +14,7 @@
#include "parameters.h" #include "parameters.h"
#include "arith.h" #include "arith.h"
#include "print.h"
#include "LLlex.h" #include "LLlex.h"
/* This file contains the (non-portable) error-message and diagnostic /* This file contains the (non-portable) error-message and diagnostic
@ -23,8 +24,7 @@
int err_occurred; int err_occurred;
err_hdr(s) static void err_hdr(char *s)
char *s;
{ {
if (FileName) { if (FileName) {
fprint(ERROUT, "\"%s\", line %d: %s", FileName, (int)LineNumber, s); fprint(ERROUT, "\"%s\", line %d: %s", FileName, (int)LineNumber, s);
@ -34,7 +34,7 @@ err_hdr(s)
#if __STDC__ #if __STDC__
/*VARARGS*/ /*VARARGS*/
error(char *fmt, ...) void error(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -47,7 +47,7 @@ error(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
warning(char *fmt, ...) void warning(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -59,7 +59,7 @@ warning(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
strict(char *fmt, ...) void strict(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -71,7 +71,7 @@ strict(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
crash(char *fmt, ...) void crash(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -84,7 +84,7 @@ crash(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
fatal(char *fmt, ...) void fatal(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -97,7 +97,7 @@ fatal(char *fmt, ...)
} }
#else #else
/*VARARGS*/ /*VARARGS*/
error(va_alist) void error(va_alist)
va_dcl va_dcl
{ {
char *fmt; char *fmt;
@ -113,7 +113,7 @@ error(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
warning(va_alist) void warning(va_alist)
va_dcl va_dcl
{ {
char *fmt; char *fmt;
@ -128,7 +128,7 @@ warning(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
strict(va_alist) void strict(va_alist)
va_dcl va_dcl
{ {
char *fmt; char *fmt;
@ -143,7 +143,7 @@ strict(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
crash(va_alist) void crash(va_alist)
va_dcl va_dcl
{ {
char *fmt; char *fmt;
@ -159,7 +159,7 @@ crash(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
fatal(va_alist) void fatal(va_alist)
va_dcl va_dcl
{ {
char *fmt; char *fmt;

5
lang/cem/cpp.ansi/expr.c
View file

@ -5,11 +5,10 @@
/* $Id$ */ /* $Id$ */
/* OPERATOR HANDLING */ /* OPERATOR HANDLING */
#include "expr.h"
#include "Lpars.h" #include "Lpars.h"
int int rank_of(int oper)
rank_of(oper)
int oper;
{ {
/* The rank of the operator oper is returned. /* The rank of the operator oper is returned.
*/ */

3
lang/cem/cpp.ansi/expression.g
View file

@ -10,6 +10,9 @@
{ {
#include "arith.h" #include "arith.h"
#include "LLlex.h" #include "LLlex.h"
#include "ch3mon.h"
#include "ch3bin.h"
#include "expr.h"
extern arith ifval; extern arith ifval;
} }

8
lang/cem/cpp.ansi/init.c
View file

@ -13,7 +13,10 @@
#include "time.h" #include "time.h"
#include "class.h" #include "class.h"
#include "macro.h" #include "macro.h"
#include "print.h"
#include "error.h"
#include "idf.h" #include "idf.h"
#include "domacro.h"
struct mkey { struct mkey {
char *mk_reserved; char *mk_reserved;
@ -34,9 +37,8 @@ struct mkey {
{0, K_UNKNOWN} {0, K_UNKNOWN}
}; };
char *sprint();
init_pp() void init_pp(void)
{ {
static char *months[12] = { static char *months[12] = {
"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jan", "Feb", "Mar", "Apr", "May", "Jun",
@ -74,7 +76,7 @@ init_pp()
/* __DATE__ */ /* __DATE__ */
sprint(dbuf, "\"%s %2d %d\"", months[tp->tm_mon], sprint(dbuf, "\"%s %2d %d\"", months[tp->tm_mon],
tp->tm_mday, tp->tm_year+1900); tp->tm_mday, tp->tm_year+1900);
/* if (tp->tm_mday < 10) dbuf[5] = ' '; /* hack */ /* if (tp->tm_mday < 10) dbuf[5] = ' '; */ /* hack */
macro_def(str2idf("__DATE__", 0), dbuf, -1, strlen(dbuf), NOUNDEF); macro_def(str2idf("__DATE__", 0), dbuf, -1, strlen(dbuf), NOUNDEF);
/* __TIME__ */ /* __TIME__ */

10
lang/cem/cpp.ansi/input.c
View file

@ -9,6 +9,8 @@
#include <string.h> #include <string.h>
#include "file_info.h" #include "file_info.h"
#include "input.h" #include "input.h"
#include "error.h"
#include "replace.h"
#define INP_PUSHBACK 3 #define INP_PUSHBACK 3
#define INP_TYPE struct file_info #define INP_TYPE struct file_info
@ -17,9 +19,7 @@ struct file_info finfo;
#include <inp_pkg.body> #include <inp_pkg.body>
#include <alloc.h> #include <alloc.h>
char * char *getwdir(register char *fn)
getwdir(fn)
register char *fn;
{ {
register char *p; register char *p;
char *strrchr(); char *strrchr();
@ -44,7 +44,7 @@ getwdir(fn)
int NoUnstack; int NoUnstack;
int InputLevel; int InputLevel;
AtEoIT() int AtEoIT(void)
{ {
InputLevel--; InputLevel--;
/* if (NoUnstack) warning("unexpected EOF"); ??? */ /* if (NoUnstack) warning("unexpected EOF"); ??? */
@ -52,7 +52,7 @@ AtEoIT()
return 0; return 0;
} }
AtEoIF() int AtEoIF(void)
{ {
extern int nestlevel; extern int nestlevel;
extern int nestcount; extern int nestcount;

9
lang/cem/cpp.ansi/input.h
View file

@ -11,4 +11,11 @@
#define UnGetChar() ((LexSave != EOI) ? ChPushBack(LexSave) : 0) #define UnGetChar() ((LexSave != EOI) ? ChPushBack(LexSave) : 0)
extern int LexSave; /* last character read by GetChar */ extern int LexSave; /* last character read by GetChar */
extern int GetChar(); /* character input, with trigraph parsing */
/* Returns the working directory from a complete path+filename specification.
* If there is just a filename and no path, it returns DOT e.g the current
* directory.
*/
char *getwdir(register char *fn);

40
lang/cem/cpp.ansi/main.c
View file

@ -15,7 +15,14 @@
#include "arith.h" #include "arith.h"
#include "file_info.h" #include "file_info.h"
#include "idf.h" #include "idf.h"
#include "init.h"
#include "print.h"
#include "options.h"
#include "error.h"
#include "input.h"
#include "macro.h" #include "macro.h"
#include "preprocess.h"
extern char *symbol2str(); extern char *symbol2str();
extern char *getwdir(); extern char *getwdir();
@ -24,7 +31,7 @@ extern int do_dependencies;
extern char *dep_file; extern char *dep_file;
int idfsize = IDFSIZE; int idfsize = IDFSIZE;
extern char options[]; extern char options[];
static File *dep_fd = STDOUT; static File *dep_fd;
arith ifval; arith ifval;
@ -33,13 +40,18 @@ char *prog_name;
extern char **inctable; extern char **inctable;
extern int inc_max, inc_total; extern int inc_max, inc_total;
void dependency(); /* Forward declarations */
void compile(int argc, char *argv[]);
void add_dependency(char *);
static void list_dependencies(char *);
static void dependency(char *, char *);
main(argc, argv)
char *argv[]; int main(int argc, char *argv[])
{ {
/* parse and interpret the command line options */ /* parse and interpret the command line options */
prog_name = argv[0]; prog_name = argv[0];
dep_fd = STDOUT;
init_idf(); init_idf();
@ -67,8 +79,7 @@ main(argc, argv)
/*NOTREACHED*/ /*NOTREACHED*/
} }
compile(argc, argv) void compile(int argc, char *argv[])
char *argv[];
{ {
register char *source = 0; register char *source = 0;
char *dummy; char *dummy;
@ -97,10 +108,9 @@ compile(argc, argv)
} }
struct idf *file_head; struct idf *file_head;
extern char *strrchr();
list_dependencies(source)
char *source; static void list_dependencies(char *source)
{ {
register struct idf *p = file_head; register struct idf *p = file_head;
@ -115,7 +125,7 @@ list_dependencies(source)
* object generated, so don't include the pathname * object generated, so don't include the pathname
* leading to it. * leading to it.
*/ */
if (s = strrchr(source, '/')) { if ((s = strrchr(source, '/'))) {
source = s + 1; source = s + 1;
} }
} }
@ -131,8 +141,7 @@ list_dependencies(source)
} }
} }
add_dependency(s) void add_dependency(char *s)
char *s;
{ {
register struct idf *p = str2idf(s, 0); register struct idf *p = str2idf(s, 0);
@ -143,9 +152,7 @@ add_dependency(s)
} }
} }
void static void dependency(char *s, char *source)
dependency(s, source)
char *s, *source;
{ {
if (options['i'] && !strncmp(s, "/usr/include/", 13)) { if (options['i'] && !strncmp(s, "/usr/include/", 13)) {
return; return;
@ -156,8 +163,7 @@ dependency(s, source)
else fprint(dep_fd, "%s\n", s); else fprint(dep_fd, "%s\n", s);
} }
void void No_Mem(void) /* called by alloc package */
No_Mem() /* called by alloc package */
{ {
fatal("out of memory"); fatal("out of memory");
} }

12
lang/cem/cpp.ansi/options.c
View file

@ -11,7 +11,9 @@
#include "parameters.h" #include "parameters.h"
#include "class.h" #include "class.h"
#include "macro.h" #include "macro.h"
#include "domacro.h"
#include "idf.h" #include "idf.h"
#include "error.h"
char options[128]; /* one for every char */ char options[128]; /* one for every char */
int inc_pos = 1; /* place where next -I goes */ int inc_pos = 1; /* place where next -I goes */
@ -23,10 +25,10 @@ char **inctable;
char *dep_file = 0; char *dep_file = 0;
extern int idfsize; extern int idfsize;
int txt2int();
do_option(text) static int txt2int(char **tp);
char *text;
void do_option(char *text)
{ {
switch(*text++) { switch(*text++) {
case '-': case '-':
@ -127,9 +129,7 @@ do_option(text)
} }
} }
int static int txt2int(char **tp)
txt2int(tp)
char **tp;
{ {
/* the integer pointed to by *tp is read, while increasing /* the integer pointed to by *tp is read, while increasing
*tp; the resulting value is yielded. *tp; the resulting value is yielded.

14
lang/cem/cpp.ansi/preprocess.c
View file

@ -9,14 +9,19 @@
#include <stdio.h> #include <stdio.h>
#include <system.h> #include <system.h>
#include <alloc.h> #include <alloc.h>
#include "preprocess.h"
#include "input.h" #include "input.h"
#include "parameters.h" #include "parameters.h"
#include "arith.h" #include "arith.h"
#include "LLlex.h" #include "LLlex.h"
#include "class.h" #include "class.h"
#include "macro.h" #include "macro.h"
#include "domacro.h"
#include "replace.h"
#include "idf.h" #include "idf.h"
#include "error.h"
#include "bits.h" #include "bits.h"
#include "skip.h"
char _obuf[OBUFSIZE]; char _obuf[OBUFSIZE];
#ifdef DOBITS #ifdef DOBITS
@ -26,7 +31,7 @@ extern int InputLevel;
extern char* sprint(); extern char* sprint();
Xflush() void Xflush(void)
{ {
sys_write(STDOUT, _obuf, OBUFSIZE); sys_write(STDOUT, _obuf, OBUFSIZE);
} }
@ -45,7 +50,7 @@ struct prag_info
static struct prag_info* pragma_tab; static struct prag_info* pragma_tab;
static int pragma_nr; static int pragma_nr;
do_pragma() void do_pragma(void)
{ {
register int size = ITEXTSIZE; register int size = ITEXTSIZE;
char* cur_line = Malloc((unsigned)size); char* cur_line = Malloc((unsigned)size);
@ -123,7 +128,7 @@ do_pragma()
char Xbuf[256]; char Xbuf[256];
void preprocess(fn) char* fn; void preprocess(char *fn)
{ {
register int c; register int c;
register char* op = _obuf; register char* op = _obuf;
@ -535,8 +540,7 @@ void preprocess(fn) char* fn;
/*NOTREACHED*/ /*NOTREACHED*/
} }
static char* SkipComment(op, lineno) char* op; static char* SkipComment(char *op, int *lineno)
int* lineno;
{ {
char* ob = &_obuf[OBUFSIZE]; char* ob = &_obuf[OBUFSIZE];
register int c, oldc = '\0'; register int c, oldc = '\0';

82
lang/cem/cpp.ansi/replace.c
View file

@ -19,19 +19,25 @@
#include "arith.h" #include "arith.h"
#include "LLlex.h" #include "LLlex.h"
#include "class.h" #include "class.h"
#include "skip.h"
#include "domacro.h"
#include "replace.h" #include "replace.h"
#include "error.h"
extern char *GetIdentifier(); ;
extern int InputLevel; extern int InputLevel;
struct repl *ReplaceList; /* list of currently active macros */ struct repl *ReplaceList; /* list of currently active macros */
void expand_defined(); static int expand_macro(register struct repl *, register struct idf *);
void getactuals(); static void expand_defined(register struct repl *);
void macro2buffer(); static void getactuals(struct repl *, register struct idf *);
static int actual(struct repl *);
static void macro_func(register struct idf *);
static void macro2buffer(register struct repl *, register struct idf *, register struct args *);
static char *stringify( register struct repl *, register char *, register struct args *);
static void stash(struct repl *, register int ch, int );
int int replace(register struct idf *idf)
replace(idf)
register struct idf *idf;
{ {
/* replace is called by the lexical analyzer to perform /* replace is called by the lexical analyzer to perform
macro replacement. The routine actualy functions as a macro replacement. The routine actualy functions as a
@ -57,13 +63,12 @@ replace(idf)
return 1; return 1;
} }
unstackrepl() void unstackrepl(void)
{ {
Unstacked++; Unstacked++;
} }
freeargs(args) static void freeargs(struct args *args)
struct args *args;
{ {
register int i; register int i;
@ -81,7 +86,7 @@ freeargs(args)
free_args(args); free_args(args);
} }
EnableMacros() void EnableMacros(void)
{ {
register struct repl *r = ReplaceList, *prev = 0; register struct repl *r = ReplaceList, *prev = 0;
@ -103,9 +108,9 @@ EnableMacros()
Unstacked = 0; Unstacked = 0;
} }
expand_macro(repl, idf) static int expand_macro(
register struct repl *repl; register struct repl *repl,
register struct idf *idf; register struct idf *idf)
{ {
/* expand_macro() does the actual macro replacement. /* expand_macro() does the actual macro replacement.
"idf" is a description of the identifier which "idf" is a description of the identifier which
@ -168,9 +173,7 @@ expand_macro(repl, idf)
return 1; return 1;
} }
void static void expand_defined(register struct repl *repl)
expand_defined(repl)
register struct repl *repl;
{ {
register int ch = GetChar(); register int ch = GetChar();
struct idf *id; struct idf *id;
@ -205,17 +208,13 @@ expand_defined(repl)
add2repl(repl, ' '); add2repl(repl, ' ');
} }
newarg(args) static void newarg(struct args *args)
struct args *args;
{ {
args->a_expptr = args->a_expbuf = Malloc((unsigned)(args->a_expsize = ARGBUF)); args->a_expptr = args->a_expbuf = Malloc((unsigned)(args->a_expsize = ARGBUF));
args->a_rawptr = args->a_rawbuf = Malloc((unsigned)(args->a_rawsize = ARGBUF)); args->a_rawptr = args->a_rawbuf = Malloc((unsigned)(args->a_rawsize = ARGBUF));
} }
void static void getactuals(struct repl *repl, register struct idf *idf)
getactuals(repl, idf)
struct repl *repl;
register struct idf *idf;
{ {
/* Get the actual parameters from the input stream. /* Get the actual parameters from the input stream.
The hard part is done by actual(), only comma's and The hard part is done by actual(), only comma's and
@ -256,8 +255,7 @@ getactuals(repl, idf)
error("too many macro arguments"); error("too many macro arguments");
} }
saveraw(repl) static void saveraw(struct repl *repl)
struct repl *repl;
{ {
register struct repl *nrepl = ReplaceList; register struct repl *nrepl = ReplaceList;
register struct args *ap = nrepl->r_args; register struct args *ap = nrepl->r_args;
@ -294,9 +292,7 @@ struct repl *repl;
} }
} }
int static int actual(struct repl *repl)
actual(repl)
struct repl *repl;
{ {
/* This routine deals with the scanning of an actual parameter. /* This routine deals with the scanning of an actual parameter.
It keeps in account the opening and closing brackets, It keeps in account the opening and closing brackets,
@ -497,8 +493,7 @@ a_new_line: ch = GetChar();
} }
} }
macro_func(idef) static void macro_func(register struct idf *idef)
register struct idf *idef;
{ {
/* macro_func() performs the special actions needed with some /* macro_func() performs the special actions needed with some
macros. These macros are __FILE__ and __LINE__ which macros. These macros are __FILE__ and __LINE__ which
@ -526,11 +521,10 @@ macro_func(idef)
} }
} }
void static void macro2buffer(
macro2buffer(repl, idf, args) register struct repl *repl,
register struct repl *repl; register struct idf *idf,
register struct idf *idf; register struct args *args)
register struct args *args;
{ {
/* macro2buffer expands the replacement list and places the /* macro2buffer expands the replacement list and places the
result onto the replacement buffer. It deals with the # result onto the replacement buffer. It deals with the #
@ -680,11 +674,10 @@ macro2buffer(repl, idf, args)
error("illegal use of ## operator"); error("illegal use of ## operator");
} }
char * static char *stringify(
stringify(repl, ptr, args) register struct repl *repl,
register struct repl *repl; register char *ptr,
register char *ptr; register struct args *args)
register struct args *args;
{ {
/* If a parameter is immediately preceded by a # token /* If a parameter is immediately preceded by a # token
both are replaced by a single string literal that both are replaced by a single string literal that
@ -747,9 +740,7 @@ stringify(repl, ptr, args)
/* The following routine is also called from domacro.c. /* The following routine is also called from domacro.c.
*/ */
add2repl(repl, ch) void add2repl(register struct repl *repl, int ch)
register struct repl *repl;
int ch;
{ {
register int index = repl->r_ptr - repl->r_text; register int index = repl->r_ptr - repl->r_text;
@ -766,10 +757,7 @@ add2repl(repl, ch)
* buffer. If the variable is zero, we must only stash into the expanded * buffer. If the variable is zero, we must only stash into the expanded
* buffer. Otherwise, we must use both buffers. * buffer. Otherwise, we must use both buffers.
*/ */
stash(repl, ch, stashraw) static void stash(struct repl *repl, register int ch, int stashraw)
struct repl *repl;
register int ch;
int stashraw;
{ {
/* Stash characters into the macro expansion buffer. /* Stash characters into the macro expansion buffer.
*/ */

13
lang/cem/cpp.ansi/replace.str
View file

@ -4,6 +4,10 @@
*/ */
/* $Id$ */ /* $Id$ */
/* DEFINITIONS FOR THE MACRO REPLACEMENT ROUTINES */ /* DEFINITIONS FOR THE MACRO REPLACEMENT ROUTINES */
#ifndef _REPLACE_H_
#define _REPLACE_H_
#include "parameters.h"
struct repl { struct repl {
struct repl *next; struct repl *next;
@ -48,3 +52,12 @@ struct args {
/* ALLOCDEF "args" 2 */ /* ALLOCDEF "args" 2 */
#define NO_ARGS (struct args *)0 #define NO_ARGS (struct args *)0
struct idf;
void unstackrepl(void);
int replace(register struct idf *idf);
void EnableMacros(void);
void add2repl(register struct repl *repl, int ch);
#endif /* REPLACE_H_ */

11
lang/cem/cpp.ansi/skip.c
View file

@ -9,14 +9,13 @@
#include "LLlex.h" #include "LLlex.h"
#include "class.h" #include "class.h"
#include "input.h" #include "input.h"
#include "domacro.h"
#include "error.h"
extern int InputLevel; extern int InputLevel;
int skipspaces(ch, skipnl) register int ch; int skipspaces(register int ch, int skipnl)
{ {
/* skipspaces() skips any white space and returns the first
non-space character.
*/
register int nlseen = 0; register int nlseen = 0;
for (;;) for (;;)
@ -65,9 +64,11 @@ int skipspaces(ch, skipnl) register int ch;
else else
return ch; return ch;
} }
/* garbage */
return 0;
} }
SkipToNewLine() int SkipToNewLine(void)
{ {
register int ch; register int ch;
register int garbage = 0; register int garbage = 0;

10
lang/m2/comp/BigPars
View file

@ -45,7 +45,7 @@
!File: debugcst.h !File: debugcst.h
/*#define DEBUG 1 /* perform various self-tests */ /*#define DEBUG 1 *//* perform various self-tests */
#define NDEBUG 1 /* disable assertions */ #define NDEBUG 1 /* disable assertions */
!File: inputtype.h !File: inputtype.h
@ -57,22 +57,22 @@
!File: squeeze.h !File: squeeze.h
/*#define SQUEEZE 1 /* define on "small" machines */ /*#define SQUEEZE 1 *//* define on "small" machines */
!File: strict3rd.h !File: strict3rd.h
/*#define STRICT_3RD_ED 1 /* define on "small" machines, and if you want /*#define STRICT_3RD_ED 1 *//* define on "small" machines, and if you want
a compiler that only implements "3rd edition" a compiler that only implements "3rd edition"
Modula-2 Modula-2
*/ */
!File: nocross.h !File: nocross.h
/*#define NOCROSS 1 /* define when cross-compiler not needed */ /*#define NOCROSS 1 *//* define when cross-compiler not needed */
!File: nostrict.h !File: nostrict.h
/*#define NOSTRICT 1 /* define when STRICT warnings disabled /*#define NOSTRICT 1 *//* define when STRICT warnings disabled
(yet another squeezing method) (yet another squeezing method)
*/ */

19
lang/m2/comp/LLlex.c
View file

@ -26,6 +26,7 @@
#include "f_info.h" #include "f_info.h"
#include "Lpars.h" #include "Lpars.h"
#include "class.h" #include "class.h"
#include "error.h"
#include "idf.h" #include "idf.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
@ -48,8 +49,7 @@ int tk_nmb_at_last_syn_err = -ERR_SHADOW;
extern char options[]; extern char options[];
extern int flt_status; extern int flt_status;
STATIC static void SkipComment(void)
SkipComment()
{ {
/* Skip Modula-2 comments (* ... *). /* Skip Modula-2 comments (* ... *).
Note that comments may be nested (par. 3.5). Note that comments may be nested (par. 3.5).
@ -122,8 +122,7 @@ SkipComment()
} }
} }
STATIC struct string * static struct string *GetString(int upto)
GetString(upto)
{ {
/* Read a Modula-2 string, delimited by the character "upto". /* Read a Modula-2 string, delimited by the character "upto".
*/ */
@ -169,8 +168,7 @@ GetString(upto)
static char *s_error = "illegal line directive"; static char *s_error = "illegal line directive";
STATIC int static int getch(void)
getch()
{ {
register int ch; register int ch;
@ -180,8 +178,7 @@ getch()
return ch; return ch;
} }
void void CheckForLineDirective(void)
CheckForLineDirective()
{ {
register int ch = getch(); register int ch = getch();
register int i = 0; register int i = 0;
@ -242,8 +239,7 @@ CheckForLineDirective()
} }
} }
STATIC static void CheckForLet()
CheckForLet()
{ {
register int ch; register int ch;
@ -256,8 +252,7 @@ CheckForLet()
} }
} }
int int LLlex(void)
LLlex()
{ {
/* LLlex() is the Lexical Analyzer. /* LLlex() is the Lexical Analyzer.
The putting aside of tokens is taken into account. The putting aside of tokens is taken into account.

2
lang/m2/comp/LLlex.h
View file

@ -68,3 +68,5 @@ extern struct type *toktype;
extern int token_nmb; extern int token_nmb;
extern int tk_nmb_at_last_syn_err; extern int tk_nmb_at_last_syn_err;
void CheckForLineDirective(void);

9
lang/m2/comp/LLmessage.c
View file

@ -19,16 +19,17 @@
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include "parameters.h" #include "parameters.h"
#include "idf.h" #include "idf.h"
#include "error.h"
#include "LLlex.h" #include "LLlex.h"
#include "Lpars.h" #include "Lpars.h"
#include "misc.h"
extern char *symbol2str(); extern char *symbol2str();
extern t_idf *gen_anon_idf();
LLmessage(tk)
register int tk; void LLmessage(register int tk)
{ {
if (tk > 0) { if (tk > 0) {
/* if (tk > 0), it represents the token to be inserted. /* if (tk > 0), it represents the token to be inserted.

0
lang/m2/comp/SYSTEM.h → lang/m2/comp/SYSTEMM2.h
View file

401
lang/m2/comp/casestat.xc
View file

@ -16,21 +16,25 @@
cases themselves. cases themselves.
*/ */
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <em_label.h>
#include <em_arith.h>
#include <em_code.h>
#include <alloc.h>
#include <assert.h> #include <assert.h>
#include "em_label.h"
#include "em_arith.h"
#include "em_code.h"
#include "alloc.h"
#include "Lpars.h" #include "Lpars.h"
#include "type.h" #include "type.h"
#include "error.h"
#include "LLlex.h" #include "LLlex.h"
#include "node.h" #include "node.h"
#include "desig.h" #include "desig.h"
#include "walk.h" #include "walk.h"
#include "code.h"
#include "typequiv.h"
#include "chk_expr.h" #include "chk_expr.h"
#include "def.h" #include "def.h"
@ -54,11 +58,12 @@ struct case_entry {
arith ce_low, ce_up; /* lower and upper bound of range */ arith ce_low, ce_up; /* lower and upper bound of range */
}; };
void AddCases();
void AddOneCase();
/* STATICALLOCDEF "case_entry" 20 */ /* STATICALLOCDEF "case_entry" 20 */
/* The constant DENSITY determines when CSA and when CSB instructions /* The constant DENSITY determines when CSA and when CSB instructions
are generated. Reasonable values are: 2, 3, 4. are generated. Reasonable values are: 2, 3, 4.
On machines that have lots of address space and memory, higher values On machines that have lots of address space and memory, higher values
@ -66,8 +71,7 @@ void AddOneCase();
may be lower. may be lower.
*/ */
compact(nr, low, up) static int compact(int nr, arith low, arith up)
arith low, up;
{ {
/* Careful! up - low might not fit in an arith. And then, /* Careful! up - low might not fit in an arith. And then,
the test "up-low < 0" might also not work to detect this the test "up-low < 0" might also not work to detect this
@ -80,199 +84,7 @@ compact(nr, low, up)
} }
#define nd_lab nd_symb #define nd_lab nd_symb
int static void AddOneCase(struct switch_hdr *sh, t_node *lnode, t_node *rnode, label lbl)
CaseCode(nd, exitlabel, end_reached)
t_node *nd;
label exitlabel;
{
/* Check the expression, stack a new case header and
fill in the necessary fields.
"exitlabel" is the exit-label of the closest enclosing
LOOP-statement, or 0.
*/
register struct switch_hdr *sh = new_switch_hdr();
register t_node *pnode = nd;
register struct case_entry *ce;
register arith val;
label CaseDescrLab;
int rval;
assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
if (ChkExpression(&(pnode->nd_LEFT))) {
MkCoercion(&(pnode->nd_LEFT),BaseType(pnode->nd_LEFT->nd_type));
CodePExpr(pnode->nd_LEFT);
}
sh->sh_type = pnode->nd_LEFT->nd_type;
sh->sh_break = ++text_label;
/* Now, create case label list
*/
while (pnode = pnode->nd_RIGHT) {
if (pnode->nd_class == Link && pnode->nd_symb == '|') {
if (pnode->nd_LEFT) {
/* non-empty case
*/
pnode->nd_LEFT->nd_lab = ++text_label;
AddCases(sh, /* to descriptor */
pnode->nd_LEFT->nd_LEFT,
/* of case labels */
(label) pnode->nd_LEFT->nd_lab
/* and code label */
);
}
}
else {
/* Else part
*/
sh->sh_default = ++text_label;
break;
}
}
if (!sh->sh_nrofentries) {
/* There were no cases, so we have to check the case-expression
here
*/
if (! (sh->sh_type->tp_fund & T_DISCRETE)) {
node_error(nd, "illegal type in CASE-expression");
}
}
/* Now generate code for the switch itself
First the part that CSA and CSB descriptions have in common.
*/
CaseDescrLab = ++data_label; /* the rom must have a label */
C_df_dlb(CaseDescrLab);
if (sh->sh_default) C_rom_ilb(sh->sh_default);
else C_rom_ucon("0", pointer_size);
if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) {
/* CSA
*/
int gen = 1;
ce = sh->sh_entries;
while (! ce->ce_label) ce = ce->ce_next;
C_rom_cst((arith) 0);
C_rom_cst(sh->sh_upperbd - sh->sh_lowerbd);
for (val = sh->sh_lowerbd; val <= sh->sh_upperbd; val++) {
assert(ce);
if (gen || val == ce->ce_low) {
gen = 1;
C_rom_ilb(ce->ce_label);
if (val == ce->ce_up) {
gen = 0;
ce = ce->ce_next;
while (ce && ! ce->ce_label) ce = ce->ce_next;
}
}
else if (sh->sh_default) C_rom_ilb(sh->sh_default);
else C_rom_ucon("0", pointer_size);
}
C_loc(sh->sh_lowerbd);
C_sbu(word_size);
c_lae_dlb(CaseDescrLab); /* perform the switch */
C_csa(word_size);
}
else {
/* CSB
*/
C_rom_cst((arith)sh->sh_nrofentries);
for (ce = sh->sh_entries; ce; ce = ce->ce_next) {
/* generate the entries: value + prog.label
*/
if (! ce->ce_label) continue;
val = ce->ce_low;
do {
C_rom_cst(val);
C_rom_ilb(ce->ce_label);
} while (val++ != ce->ce_up);
}
c_lae_dlb(CaseDescrLab); /* perform the switch */
C_csb(word_size);
}
/* Now generate code for the cases
*/
pnode = nd;
rval = 0;
while (pnode = pnode->nd_RIGHT) {
if (pnode->nd_class == Link && pnode->nd_symb == '|') {
if (pnode->nd_LEFT) {
rval |= LblWalkNode((label) pnode->nd_LEFT->nd_lab,
pnode->nd_LEFT->nd_RIGHT,
exitlabel, end_reached);
c_bra(sh->sh_break);
}
}
else {
/* Else part
*/
assert(sh->sh_default != 0);
rval |= LblWalkNode(sh->sh_default,
pnode, exitlabel, end_reached);
break;
}
}
def_ilb(sh->sh_break);
FreeSh(sh);
return rval;
}
FreeSh(sh)
register struct switch_hdr *sh;
{
/* free the allocated switch structure
*/
register struct case_entry *ce;
ce = sh->sh_entries;
while (ce) {
struct case_entry *tmp = ce->ce_next;
free_case_entry(ce);
ce = tmp;
}
free_switch_hdr(sh);
}
void
AddCases(sh, node, lbl)
struct switch_hdr *sh;
register t_node *node;
label lbl;
{
/* Add case labels to the case label list
*/
if (node->nd_class == Link) {
if (node->nd_symb == UPTO) {
assert(node->nd_LEFT->nd_class == Value);
assert(node->nd_RIGHT->nd_class == Value);
AddOneCase(sh, node->nd_LEFT, node->nd_RIGHT, lbl);
return;
}
assert(node->nd_symb == ',');
AddCases(sh, node->nd_LEFT, lbl);
AddCases(sh, node->nd_RIGHT, lbl);
return;
}
assert(node->nd_class == Value);
AddOneCase(sh, node, node, lbl);
}
void
AddOneCase(sh, lnode, rnode, lbl)
register struct switch_hdr *sh;
t_node *lnode, *rnode;
label lbl;
{ {
register struct case_entry *ce = new_case_entry(); register struct case_entry *ce = new_case_entry();
register struct case_entry *c1 = sh->sh_entries, *c2 = 0; register struct case_entry *c1 = sh->sh_entries, *c2 = 0;
@ -387,3 +199,188 @@ node_error(rnode, "multiple case entry for value %ld", (long)(ce->ce_up));
} }
if (ce->ce_label) sh->sh_nrofentries += ce->ce_up - ce->ce_low + 1; if (ce->ce_label) sh->sh_nrofentries += ce->ce_up - ce->ce_low + 1;
} }
static void AddCases(struct switch_hdr *sh, register t_node *node, label lbl)
{
/* Add case labels to the case label list
*/
if (node->nd_class == Link) {
if (node->nd_symb == UPTO) {
assert(node->nd_LEFT->nd_class == Value);
assert(node->nd_RIGHT->nd_class == Value);
AddOneCase(sh, node->nd_LEFT, node->nd_RIGHT, lbl);
return;
}
assert(node->nd_symb == ',');
AddCases(sh, node->nd_LEFT, lbl);
AddCases(sh, node->nd_RIGHT, lbl);
return;
}
assert(node->nd_class == Value);
AddOneCase(sh, node, node, lbl);
}
static void FreeSh(struct switch_hdr *sh)
{
/* free the allocated switch structure
*/
register struct case_entry *ce;
ce = sh->sh_entries;
while (ce) {
struct case_entry *tmp = ce->ce_next;
free_case_entry(ce);
ce = tmp;
}
free_switch_hdr(sh);
}
int CaseCode(t_node *nd, label exitlabel, int end_reached)
{
/* Check the expression, stack a new case header and
fill in the necessary fields.
"exitlabel" is the exit-label of the closest enclosing
LOOP-statement, or 0.
*/
register struct switch_hdr *sh = new_switch_hdr();
register t_node *pnode = nd;
register struct case_entry *ce;
register arith val;
label CaseDescrLab;
int rval;
assert(pnode->nd_class == Stat && pnode->nd_symb == CASE);
if (ChkExpression(&(pnode->nd_LEFT))) {
MkCoercion(&(pnode->nd_LEFT),BaseType(pnode->nd_LEFT->nd_type));
CodePExpr(pnode->nd_LEFT);
}
sh->sh_type = pnode->nd_LEFT->nd_type;
sh->sh_break = ++text_label;
/* Now, create case label list
*/
while ( (pnode = pnode->nd_RIGHT) ) {
if (pnode->nd_class == Link && pnode->nd_symb == '|') {
if (pnode->nd_LEFT) {
/* non-empty case
*/
pnode->nd_LEFT->nd_lab = ++text_label;
AddCases(sh, /* to descriptor */
pnode->nd_LEFT->nd_LEFT,
/* of case labels */
(label) pnode->nd_LEFT->nd_lab
/* and code label */
);
}
}
else {
/* Else part
*/
sh->sh_default = ++text_label;
break;
}
}
if (!sh->sh_nrofentries) {
/* There were no cases, so we have to check the case-expression
here
*/
if (! (sh->sh_type->tp_fund & T_DISCRETE)) {
node_error(nd, "illegal type in CASE-expression");
}
}
/* Now generate code for the switch itself
First the part that CSA and CSB descriptions have in common.
*/
CaseDescrLab = ++data_label; /* the rom must have a label */
C_df_dlb(CaseDescrLab);
if (sh->sh_default) C_rom_ilb(sh->sh_default);
else C_rom_ucon("0", pointer_size);
if (compact(sh->sh_nrofentries, sh->sh_lowerbd, sh->sh_upperbd)) {
/* CSA
*/
int gen = 1;
ce = sh->sh_entries;
while (! ce->ce_label) ce = ce->ce_next;
C_rom_cst((arith) 0);
C_rom_cst(sh->sh_upperbd - sh->sh_lowerbd);
for (val = sh->sh_lowerbd; val <= sh->sh_upperbd; val++) {
assert(ce);
if (gen || val == ce->ce_low) {
gen = 1;
C_rom_ilb(ce->ce_label);
if (val == ce->ce_up) {
gen = 0;
ce = ce->ce_next;
while (ce && ! ce->ce_label) ce = ce->ce_next;
}
}
else if (sh->sh_default) C_rom_ilb(sh->sh_default);
else C_rom_ucon("0", pointer_size);
}
C_loc(sh->sh_lowerbd);
C_sbu(word_size);
c_lae_dlb(CaseDescrLab); /* perform the switch */
C_csa(word_size);
}
else {
/* CSB
*/
C_rom_cst((arith)sh->sh_nrofentries);
for (ce = sh->sh_entries; ce; ce = ce->ce_next) {
/* generate the entries: value + prog.label
*/
if (! ce->ce_label) continue;
val = ce->ce_low;
do {
C_rom_cst(val);
C_rom_ilb(ce->ce_label);
} while (val++ != ce->ce_up);
}
c_lae_dlb(CaseDescrLab); /* perform the switch */
C_csb(word_size);
}
/* Now generate code for the cases
*/
pnode = nd;
rval = 0;
while ( (pnode = pnode->nd_RIGHT) ) {
if (pnode->nd_class == Link && pnode->nd_symb == '|') {
if (pnode->nd_LEFT) {
rval |= LblWalkNode((label) pnode->nd_LEFT->nd_lab,
pnode->nd_LEFT->nd_RIGHT,
exitlabel, end_reached);
c_bra(sh->sh_break);
}
}
else {
/* Else part
*/
assert(sh->sh_default != 0);
rval |= LblWalkNode(sh->sh_default,
pnode, exitlabel, end_reached);
break;
}
}
def_ilb(sh->sh_break);
FreeSh(sh);
return rval;
}

167
lang/m2/comp/chk_expr.c
View file

@ -12,15 +12,17 @@
/* Check expressions, and try to evaluate them as far as possible. /* Check expressions, and try to evaluate them as far as possible.
*/ */
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include <assert.h> #include <assert.h>
#include <alloc.h> #include <alloc.h>
#include <flt_arith.h>
#include <system.h>
#include "Lpars.h" #include "Lpars.h"
#include "idf.h" #include "idf.h"
@ -29,21 +31,30 @@
#include "def.h" #include "def.h"
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "error.h"
#include "standards.h" #include "standards.h"
#include "chk_expr.h" #include "chk_expr.h"
#include "cstoper.h"
#include "typequiv.h"
#include "misc.h" #include "misc.h"
#include "lookup.h"
#include "print.h"
#include "warning.h" #include "warning.h"
#include "main.h" #include "main.h"
extern char *symbol2str(); extern char *symbol2str();
extern char *sprint();
extern arith flt_flt2arith();
STATIC /* Forward file declarations */
df_error(nd, mess, edf) static int ChkStandard(t_node **);
t_node *nd; /* node on which error occurred */ static int ChkCast(t_node **);
char *mess; /* error message */
register t_def *edf; /* do we have a name? */
static void df_error(
t_node *nd, /* node on which error occurred */
char *mess, /* error message */
register t_def *edf) /* do we have a name? */
{ {
if (edf) { if (edf) {
if (edf->df_kind != D_ERROR) { if (edf->df_kind != D_ERROR) {
@ -53,10 +64,7 @@ df_error(nd, mess, edf)
else node_error(nd, mess); else node_error(nd, mess);
} }
void void MkCoercion(t_node **pnd, register t_type *tp)
MkCoercion(pnd, tp)
t_node **pnd;
register t_type *tp;
{ {
/* Make a coercion from the node indicated by *pnd to the /* Make a coercion from the node indicated by *pnd to the
type indicated by tp. If the node indicated by *pnd type indicated by tp. If the node indicated by *pnd
@ -162,9 +170,7 @@ MkCoercion(pnd, tp)
*pnd = nd; *pnd = nd;
} }
int int ChkVariable(register t_node **expp, int flags)
ChkVariable(expp, flags)
register t_node **expp;
{ {
/* Check that "expp" indicates an item that can be /* Check that "expp" indicates an item that can be
assigned to. assigned to.
@ -182,9 +188,7 @@ ChkVariable(expp, flags)
return 1; return 1;
} }
STATIC int static int ChkArrow(t_node **expp, int flags)
ChkArrow(expp)
t_node **expp;
{ {
/* Check an application of the '^' operator. /* Check an application of the '^' operator.
The operand must be a variable of a pointer type. The operand must be a variable of a pointer type.
@ -211,9 +215,7 @@ ChkArrow(expp)
return 1; return 1;
} }
STATIC int static int ChkArr(t_node **expp, int flags)
ChkArr(expp, flags)
t_node **expp;
{ {
/* Check an array selection. /* Check an array selection.
The left hand side must be a variable of an array type, The left hand side must be a variable of an array type,
@ -255,9 +257,7 @@ ChkArr(expp, flags)
} }
/*ARGSUSED*/ /*ARGSUSED*/
STATIC int static int ChkValue(t_node **expp, int flags)
ChkValue(expp)
t_node **expp;
{ {
#ifdef DEBUG #ifdef DEBUG
switch((*expp)->nd_symb) { switch((*expp)->nd_symb) {
@ -273,9 +273,7 @@ ChkValue(expp)
return 1; return 1;
} }
STATIC int static int ChkSelOrName(t_node **expp, int flags)
ChkSelOrName(expp, flags)
t_node **expp;
{ {
/* Check either an ID or a construction of the form /* Check either an ID or a construction of the form
ID.ID [ .ID ]* ID.ID [ .ID ]*
@ -348,9 +346,7 @@ ChkSelOrName(expp, flags)
return exp->nd_def->df_kind != D_ERROR; return exp->nd_def->df_kind != D_ERROR;
} }
STATIC int static int ChkExSelOrName(t_node **expp, int flags)
ChkExSelOrName(expp)
t_node **expp;
{ {
/* Check either an ID or an ID.ID [.ID]* occurring in an /* Check either an ID or an ID.ID [.ID]* occurring in an
expression. expression.
@ -422,20 +418,13 @@ ChkExSelOrName(expp)
return 1; return 1;
} }
STATIC int static int ChkEl(register t_node **expp, t_type *tp)
ChkEl(expp, tp)
register t_node **expp;
t_type *tp;
{ {
return ChkExpression(expp) && ChkCompat(expp, tp, "set element"); return ChkExpression(expp) && ChkCompat(expp, tp, "set element");
} }
STATIC int static int ChkElement(t_node **expp, t_type *tp, arith *set)
ChkElement(expp, tp, set)
t_node **expp;
t_type *tp;
arith *set;
{ {
/* Check elements of a set. This routine may call itself /* Check elements of a set. This routine may call itself
recursively. recursively.
@ -494,9 +483,7 @@ ChkElement(expp, tp, set)
return 1; return 1;
} }
arith * arith *MkSet(unsigned int size)
MkSet(size)
unsigned size;
{ {
register arith *s, *t; register arith *s, *t;
@ -508,8 +495,7 @@ MkSet(size)
return s; return s;
} }
FreeSet(s) void FreeSet(register arith *s)
register arith *s;
{ {
dec_refcount(s); dec_refcount(s);
if (refcount(s) <= 0) { if (refcount(s) <= 0) {
@ -518,9 +504,7 @@ FreeSet(s)
} }
} }
STATIC int static int ChkSet(t_node **expp, int flags)
ChkSet(expp)
t_node **expp;
{ {
/* Check the legality of a SET aggregate, and try to evaluate it /* Check the legality of a SET aggregate, and try to evaluate it
compile time. Unfortunately this is all rather complicated. compile time. Unfortunately this is all rather complicated.
@ -586,10 +570,7 @@ ChkSet(expp)
return retval; return retval;
} }
STATIC t_node * static t_node *nextarg(t_node **argp, t_def *edf)
nextarg(argp, edf)
t_node **argp;
t_def *edf;
{ {
register t_node *arg = (*argp)->nd_RIGHT; register t_node *arg = (*argp)->nd_RIGHT;
@ -602,10 +583,7 @@ nextarg(argp, edf)
return arg; return arg;
} }
STATIC t_node * static t_node *getarg(t_node **argp, int bases, int designator, t_def *edf)
getarg(argp, bases, designator, edf)
t_node **argp;
t_def *edf;
{ {
/* This routine is used to fetch the next argument from an /* This routine is used to fetch the next argument from an
argument list. The argument list is indicated by "argp". argument list. The argument list is indicated by "argp".
@ -643,10 +621,7 @@ getarg(argp, bases, designator, edf)
return left; return left;
} }
STATIC t_node * static t_node *getname(t_node **argp, int kinds, int bases, t_def *edf)
getname(argp, kinds, bases, edf)
t_node **argp;
t_def *edf;
{ {
/* Get the next argument from argument list "argp". /* Get the next argument from argument list "argp".
The argument must indicate a definition, and the The argument must indicate a definition, and the
@ -672,9 +647,7 @@ getname(argp, kinds, bases, edf)
return left; return left;
} }
STATIC int static int ChkProcCall(register t_node *exp)
ChkProcCall(exp)
register t_node *exp;
{ {
/* Check a procedure call /* Check a procedure call
*/ */
@ -735,9 +708,7 @@ ChkProcCall(exp)
return retval; return retval;
} }
STATIC int static int ChkFunCall(register t_node **expp, int flags)
ChkFunCall(expp)
register t_node **expp;
{ {
/* Check a call that must have a result /* Check a call that must have a result
*/ */
@ -750,12 +721,9 @@ ChkFunCall(expp)
return 0; return 0;
} }
STATIC int ChkStandard();
STATIC int ChkCast();
int
ChkCall(expp) int ChkCall(t_node **expp)
t_node **expp;
{ {
/* Check something that looks like a procedure or function call. /* Check something that looks like a procedure or function call.
Of course this does not have to be a call at all, Of course this does not have to be a call at all,
@ -795,9 +763,7 @@ ChkCall(expp)
return ChkProcCall(*expp); return ChkProcCall(*expp);
} }
STATIC t_type * static t_type *ResultOfOperation(int operator, t_type *tp)
ResultOfOperation(operator, tp)
t_type *tp;
{ {
/* Return the result type of the binary operation "operator", /* Return the result type of the binary operation "operator",
with operand type "tp". with operand type "tp".
@ -819,8 +785,7 @@ ResultOfOperation(operator, tp)
#define Boolean(operator) (operator == OR || operator == AND) #define Boolean(operator) (operator == OR || operator == AND)
STATIC int static int AllowedTypes(int operator)
AllowedTypes(operator)
{ {
/* Return a bit mask indicating the allowed operand types /* Return a bit mask indicating the allowed operand types
for binary operator "operator". for binary operator "operator".
@ -854,10 +819,10 @@ AllowedTypes(operator)
/*NOTREACHED*/ /*NOTREACHED*/
} }
STATIC int static int ChkAddressOper(
ChkAddressOper(tpl, tpr, expp) register t_type *tpl,
register t_type *tpl, *tpr; register t_type *tpr,
register t_node *expp; register t_node *expp)
{ {
/* Check that either "tpl" or "tpr" are both of type /* Check that either "tpl" or "tpr" are both of type
address_type, or that one of them is, but the other is address_type, or that one of them is, but the other is
@ -901,9 +866,7 @@ ChkAddressOper(tpl, tpr, expp)
return 0; return 0;
} }
STATIC int static int ChkBinOper(t_node **expp, int flags)
ChkBinOper(expp)
t_node **expp;
{ {
/* Check a binary operation. /* Check a binary operation.
*/ */
@ -1018,9 +981,7 @@ ChkBinOper(expp)
return 1; return 1;
} }
STATIC int static int ChkUnOper(t_node **expp, int flags)
ChkUnOper(expp)
t_node **expp;
{ {
/* Check an unary operation. /* Check an unary operation.
*/ */
@ -1093,10 +1054,7 @@ ChkUnOper(expp)
return 0; return 0;
} }
STATIC t_node * static t_node *getvariable(t_node **argp, t_def *edf, int flags)
getvariable(argp, edf, flags)
t_node **argp;
t_def *edf;
{ {
/* Get the next argument from argument list "argp". /* Get the next argument from argument list "argp".
It must obey the rules of "ChkVariable". It must obey the rules of "ChkVariable".
@ -1110,9 +1068,7 @@ getvariable(argp, edf, flags)
return arg->nd_LEFT; return arg->nd_LEFT;
} }
STATIC int static int ChkStandard(t_node **expp)
ChkStandard(expp)
t_node **expp;
{ {
/* Check a call of a standard procedure or function /* Check a call of a standard procedure or function
*/ */
@ -1326,7 +1282,7 @@ ChkStandard(expp)
#endif #endif
#ifndef STRICT_3RD_ED #ifndef STRICT_3RD_ED
if (! options['3'] && edf->df_value.df_stdname == S_TSIZE) { if (! options['3'] && edf->df_value.df_stdname == S_TSIZE) {
if (arg = arglink->nd_RIGHT) { if ( (arg = arglink->nd_RIGHT) ) {
node_warning(arg, node_warning(arg,
W_OLDFASHIONED, W_OLDFASHIONED,
"TSIZE with multiple parameters, only first parameter used"); "TSIZE with multiple parameters, only first parameter used");
@ -1442,9 +1398,7 @@ ChkStandard(expp)
return 1; return 1;
} }
STATIC int static int ChkCast(t_node **expp)
ChkCast(expp)
t_node **expp;
{ {
/* Check a cast and perform it if the argument is constant. /* Check a cast and perform it if the argument is constant.
If the sizes don't match, only complain if at least one of them If the sizes don't match, only complain if at least one of them
@ -1507,9 +1461,7 @@ ChkCast(expp)
return 1; return 1;
} }
TryToString(nd, tp) void TryToString(register t_node *nd, t_type *tp)
register t_node *nd;
t_type *tp;
{ {
/* Try a coercion from character constant to string. /* Try a coercion from character constant to string.
*/ */
@ -1527,25 +1479,20 @@ TryToString(nd, tp)
} }
} }
STATIC int static int no_desig(t_node **expp, int flags)
no_desig(expp)
t_node **expp;
{ {
node_error(*expp, "designator expected"); node_error(*expp, "designator expected");
return 0; return 0;
} }
STATIC int static int add_flags(t_node **expp, int flags)
add_flags(expp, flags)
t_node **expp;
{ {
(*expp)->nd_def->df_flags |= flags; (*expp)->nd_def->df_flags |= flags;
return 1; return 1;
} }
extern int PNodeCrash();
int (*ExprChkTable[])() = { int (*ExprChkTable[])(t_node **, int) = {
ChkValue, ChkValue,
ChkArr, ChkArr,
ChkBinOper, ChkBinOper,
@ -1561,7 +1508,7 @@ int (*ExprChkTable[])() = {
PNodeCrash, PNodeCrash,
}; };
int (*DesigChkTable[])() = { int (*DesigChkTable[])(t_node **, int) = {
no_desig, no_desig,
ChkArr, ChkArr,
no_desig, no_desig,

24
lang/m2/comp/chk_expr.h
View file

@ -4,22 +4,38 @@
* *
* Author: Ceriel J.H. Jacobs * Author: Ceriel J.H. Jacobs
*/ */
#ifndef CHK_EXPR_H_
#define CHK_EXPR_H_
/* E X P R E S S I O N C H E C K I N G */ /* E X P R E S S I O N C H E C K I N G */
/* $Id$ */ /* $Id$ */
extern int (*ExprChkTable[])(); /* table of expression checking extern int (*ExprChkTable[])(t_node **, int); /* table of expression checking
functions, indexed by node class functions, indexed by node class
*/ */
extern int (*DesigChkTable[])(); /* table of designator checking extern int (*DesigChkTable[])(t_node **, int); /* table of designator checking
functions, indexed by node class functions, indexed by node class
*/ */
#define ChkExpression(expp) ((*ExprChkTable[(*expp)->nd_class])(expp,D_USED)) #define ChkExpression(expp) ((*ExprChkTable[(unsigned int)((*expp)->nd_class)])(expp,D_USED))
#define ChkDesig(expp, flags) ((*DesigChkTable[(*expp)->nd_class])(expp,flags)) #define ChkDesig(expp, flags) ((*DesigChkTable[(unsigned int)((*expp)->nd_class)])(expp,flags))
/* handle reference counts for sets */ /* handle reference counts for sets */
#define inc_refcount(s) (*((int *)(s) - 1) += 1) #define inc_refcount(s) (*((int *)(s) - 1) += 1)
#define dec_refcount(s) (*((int *)(s) - 1) -= 1) #define dec_refcount(s) (*((int *)(s) - 1) -= 1)
#define refcount(s) (*((int *)(s) - 1)) #define refcount(s) (*((int *)(s) - 1))
void MkCoercion(t_node **pnd, register t_type *tp);
int ChkVariable(register t_node **expp, int flags);
int ChkCall(t_node **expp);
void TryToString(register t_node *nd, t_type *tp);
/* Generates a set of "size" bytes and increments its reference count. */
arith *MkSet(unsigned int size);
/* Decrements the reference counter of set "s" and if reference count
* is zero, then it frees the memory associated with the set.
*/
void FreeSet(register arith *s);
#endif /* CHK_EXPR_H_ */

162
lang/m2/comp/code.c
View file

@ -12,23 +12,27 @@
/* Code generation for expressions and coercions /* Code generation for expressions and coercions
*/ */
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <em_arith.h>
#include <em_label.h>
#include <em_code.h>
#include <em_abs.h>
#include <assert.h> #include <assert.h>
#include <alloc.h> #include "em_arith.h"
#include "em_label.h"
#include "em_code.h"
#include "em_abs.h"
#include "alloc.h"
#include "code.h"
#include "type.h" #include "type.h"
#include "error.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
#include "scope.h" #include "scope.h"
#include "desig.h" #include "desig.h"
#include "chk_expr.h"
#include "node.h" #include "node.h"
#include "Lpars.h" #include "Lpars.h"
#include "tmpvar.h"
#include "standards.h" #include "standards.h"
#include "walk.h" #include "walk.h"
@ -37,17 +41,19 @@ extern char options[];
extern t_desig null_desig; extern t_desig null_desig;
int fp_used; int fp_used;
void RangeCheck(); /* Forward declarations */
void CodeParameters(); static void CodeParameters(t_param *, register t_node *);
void CodeCall(); static void CodeStd(t_node *);
static void compare(int, label);
static void truthvalue(int);
static void CodeUoper(register t_node *);
static void CodeSet(register t_node *, int);
static void CodeEl(register t_node *, register t_type *, int);
static void CodeDAddress(t_node *, int);
static void DoHIGH(register t_def *);
CodeConst(cst, size) void CodeConst(arith cst, int size)
arith cst;
int size;
{ {
/* Generate code to push constant "cst" with size "size"
*/
if (size <= (int) word_size) { if (size <= (int) word_size) {
C_loc(cst); C_loc(cst);
} }
@ -59,9 +65,7 @@ CodeConst(cst, size)
} }
} }
void void CodeString(register t_node *nd)
CodeString(nd)
register t_node *nd;
{ {
if (nd->nd_type->tp_fund != T_STRING) { if (nd->nd_type->tp_fund != T_STRING) {
/* Character constant */ /* Character constant */
@ -73,10 +77,7 @@ CodeString(nd)
c_lae_dlb(data_label); c_lae_dlb(data_label);
} }
CodeExpr(nd, ds, true_label, false_label) void CodeExpr(t_node *nd, t_desig *ds, label true_label, label false_label)
register t_node *nd;
register t_desig *ds;
label true_label, false_label;
{ {
register t_type *tp = nd->nd_type; register t_type *tp = nd->nd_type;
@ -173,8 +174,7 @@ CodeExpr(nd, ds, true_label, false_label)
} }
} }
CodeCoercion(t1, t2) void CodeCoercion(t_type *t1, t_type *t2)
t_type *t1, *t2;
{ {
int fund1, fund2; int fund1, fund2;
int sz1 = t1->tp_size; int sz1 = t1->tp_size;
@ -293,13 +293,9 @@ CodeCoercion(t1, t2)
} }
} }
void void CodeCall(t_node *nd)
CodeCall(nd)
register t_node *nd;
{ {
/* Generate code for a procedure call. Checking of parameters
and result is already done.
*/
register t_node *left = nd->nd_LEFT; register t_node *left = nd->nd_LEFT;
t_type *result_tp; t_type *result_tp;
int needs_fn; int needs_fn;
@ -361,10 +357,8 @@ CodeCall(nd)
DoLineno(nd); DoLineno(nd);
} }
void /* Generates code to setup the parameters of a procedure call. */
CodeParameters(param, arg) static void CodeParameters(t_param *param, register t_node *arg)
t_param *param;
register t_node *arg;
{ {
register t_type *tp; register t_type *tp;
register t_type *arg_type; register t_type *arg_type;
@ -445,9 +439,7 @@ CodeParameters(param, arg)
CodePExpr(arg); CodePExpr(arg);
} }
CodePString(nd, tp) void CodePString(t_node *nd, t_type *tp)
t_node *nd;
t_type *tp;
{ {
arith szarg = WA(nd->nd_type->tp_size); arith szarg = WA(nd->nd_type->tp_size);
register arith zersz = WA(tp->tp_size) - szarg; register arith zersz = WA(tp->tp_size) - szarg;
@ -461,9 +453,9 @@ CodePString(nd, tp)
C_loi(szarg); C_loi(szarg);
} }
static
subu(sz)
int sz; static void subu(int sz)
{ {
if (! options['R']) { if (! options['R']) {
C_cal(sz == (int) word_size ? "subuchk" : "subulchk"); C_cal(sz == (int) word_size ? "subuchk" : "subulchk");
@ -471,9 +463,7 @@ subu(sz)
C_sbu((arith) sz); C_sbu((arith) sz);
} }
static static void addu(int sz)
addu(sz)
int sz;
{ {
if (! options['R']) { if (! options['R']) {
C_cal(sz == (int) word_size ? "adduchk" : "addulchk"); C_cal(sz == (int) word_size ? "adduchk" : "addulchk");
@ -481,9 +471,7 @@ addu(sz)
C_adu((arith)sz); C_adu((arith)sz);
} }
static int static int complex_lhs(register t_node *nd)
complex_lhs(nd)
register t_node *nd;
{ {
switch(nd->nd_class) { switch(nd->nd_class) {
case Value: case Value:
@ -498,8 +486,8 @@ complex_lhs(nd)
} }
} }
CodeStd(nd) /* Generate code for internal procedures */
t_node *nd; static void CodeStd(t_node *nd)
{ {
register t_node *arg = nd->nd_RIGHT; register t_node *arg = nd->nd_RIGHT;
register t_node *left = 0; register t_node *left = 0;
@ -654,9 +642,7 @@ CodeStd(nd)
} }
} }
int static int needs_rangecheck(register t_type *tpl, t_type *tpr)
needs_rangecheck(tpl, tpr)
register t_type *tpl, *tpr;
{ {
arith rlo, rhi; arith rlo, rhi;
@ -679,13 +665,8 @@ needs_rangecheck(tpl, tpr)
return 0; return 0;
} }
void void RangeCheck(register t_type *tpl, t_type *tpr)
RangeCheck(tpl, tpr)
register t_type *tpl, *tpr;
{ {
/* Generate a range check if neccessary
*/
arith rlo, rhi; arith rlo, rhi;
if (options['R']) return; if (options['R']) return;
@ -709,8 +690,7 @@ RangeCheck(tpl, tpr)
} }
} }
Operands(nd) void Operands(register t_node *nd)
register t_node *nd;
{ {
CodePExpr(nd->nd_LEFT); CodePExpr(nd->nd_LEFT);
@ -718,10 +698,11 @@ Operands(nd)
DoLineno(nd); DoLineno(nd);
} }
CodeOper(expr, true_label, false_label) void CodeOper(
register t_node *expr; /* the expression tree itself */ register t_node *expr, /* the expression tree itself */
label true_label; label true_label,
label false_label; /* labels to jump to in logical expr's */ label false_label /* labels to jump to in logical expr's */
)
{ {
register t_node *leftop = expr->nd_LEFT; register t_node *leftop = expr->nd_LEFT;
register t_node *rightop = expr->nd_RIGHT; register t_node *rightop = expr->nd_RIGHT;
@ -1019,10 +1000,8 @@ CodeOper(expr, true_label, false_label)
} }
} }
/* compare() serves as an auxiliary function of CodeOper */ /* Serves as an auxiliary function of CodeOper */
compare(relop, lbl) static void compare(int relop, label lbl)
int relop;
register label lbl;
{ {
switch (relop) { switch (relop) {
case '<': case '<':
@ -1048,9 +1027,8 @@ compare(relop, lbl)
} }
} }
/* truthvalue() serves as an auxiliary function of CodeOper */ /* Serves as an auxiliary function of CodeOper */
truthvalue(relop) static void truthvalue(int relop)
int relop;
{ {
switch (relop) { switch (relop) {
case '<': case '<':
@ -1076,8 +1054,9 @@ truthvalue(relop)
} }
} }
CodeUoper(nd)
register t_node *nd; /* Generates code for an unary expression */
void CodeUoper(register t_node *nd)
{ {
register t_type *tp = nd->nd_type; register t_type *tp = nd->nd_type;
@ -1110,8 +1089,7 @@ CodeUoper(nd)
} }
} }
CodeSet(nd, null_set) static void CodeSet(register t_node *nd, int null_set)
register t_node *nd;
{ {
register t_type *tp = nd->nd_type; register t_type *tp = nd->nd_type;
@ -1128,9 +1106,7 @@ CodeSet(nd, null_set)
if (null_set) C_zer(tp->tp_size); if (null_set) C_zer(tp->tp_size);
} }
CodeEl(nd, tp, null_set) static void CodeEl(register t_node *nd, register t_type *tp, int null_set)
register t_node *nd;
register t_type *tp;
{ {
register t_type *eltype = ElementType(tp); register t_type *eltype = ElementType(tp);
@ -1155,12 +1131,9 @@ CodeEl(nd, tp, null_set)
} }
} }
CodePExpr(nd) void CodePExpr(register t_node *nd)
register t_node *nd;
{ {
/* Generate code to push the value of the expression "nd"
on the stack.
*/
t_desig designator; t_desig designator;
designator = null_desig; designator = null_desig;
@ -1168,8 +1141,7 @@ CodePExpr(nd)
CodeValue(&designator, nd->nd_type); CodeValue(&designator, nd->nd_type);
} }
CodeDAddress(nd, chk_controlvar) static void CodeDAddress(t_node *nd, int chk_controlvar)
t_node *nd;
{ {
/* Generate code to push the address of the designator "nd" /* Generate code to push the address of the designator "nd"
on the stack. on the stack.
@ -1195,12 +1167,9 @@ CodeDAddress(nd, chk_controlvar)
} }
} }
CodeDStore(nd) void CodeDStore(register t_node *nd)
register t_node *nd;
{ {
/* Generate code to store the expression on the stack into the
designator "nd".
*/
t_desig designator; t_desig designator;
@ -1210,8 +1179,7 @@ CodeDStore(nd)
CodeStore(&designator, nd->nd_type); CodeStore(&designator, nd->nd_type);
} }
DoHIGH(df) static void DoHIGH(register t_def *df)
register t_def *df;
{ {
/* Get the high index of a conformant array, indicated by "nd". /* Get the high index of a conformant array, indicated by "nd".
The high index is the second field in the descriptor of The high index is the second field in the descriptor of
@ -1235,26 +1203,22 @@ DoHIGH(df)
} }
#ifdef SQUEEZE #ifdef SQUEEZE
c_bra(l) void c_bra(label l)
label l;
{ {
C_bra((label) l); C_bra((label) l);
} }
c_loc(n) void c_loc(int n)
{ {
C_loc((arith) n); C_loc((arith) n);
} }
c_lae_dlb(l) void c_lae_dlb(label l)
label l;
{ {
C_lae_dlb(l, (arith) 0); C_lae_dlb(l, (arith) 0);
} }
CAL(name, ssp) void CAL(char *name, int ssp)
char *name;
int ssp;
{ {
C_cal(name); C_cal(name);
C_asp((arith) ssp); C_asp((arith) ssp);

53
lang/m2/comp/code.h Normal file
View file

@ -0,0 +1,53 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
* Created on: 2019-02-26
*
*/
#ifndef CODE_H_
#define CODE_H_
#include "parameters.h"
#include <em_arith.h>
#include <em_label.h>
/* Forward declarations. */
typedef struct node t_node;
typedef struct desig t_desig;
typedef struct type t_type;
/* Generate code to push constant "cst" with size "size" bytes. */
void CodeConst(arith cst, int size);
/* Generate constant character or string. */
void CodeString(register t_node *nd);
/* Generate code for an expression contained in "nd". */
void CodeExpr(t_node *nd, t_desig *ds, label true_label, label false_label);
/* Generate implicit type conversion code. */
void CodeCoercion(t_type *t1, t_type *t2);
/* Generate code for a procedure call including parameter setup. Checking of parameters
and result is already done. */
void CodeCall(t_node *nd);
void CodePString(t_node *nd, t_type *tp);
/* Generate a range check if necessary */
void RangeCheck(register t_type *tpl, t_type *tpr);
void CodeOper(register t_node *expr, label true_label, label false_label);
/* Generate code to push the value of the expression "nd"
on the stack. */
void CodePExpr(register t_node *nd);
/* Generate code to store the expression on the stack into the
designator "nd".
*/
void CodeDStore(register t_node *nd);
#ifdef SQUEEZE
void c_bra(label l);
void c_loc(int n);
void c_lae_dlb(label l);
void CAL(char *name, int ssp);
#endif
#endif /* CODE_H_ */

50
lang/m2/comp/cstoper.c
View file

@ -9,8 +9,8 @@
/* $Id$ */ /* $Id$ */
#include <stdlib.h> #include <stdlib.h>
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <em_arith.h> #include <em_arith.h>
@ -24,7 +24,10 @@
#include "node.h" #include "node.h"
#include "Lpars.h" #include "Lpars.h"
#include "standards.h" #include "standards.h"
#include "cstoper.h"
#include "chk_expr.h"
#include "warning.h" #include "warning.h"
#include "error.h"
extern char *symbol2str(); extern char *symbol2str();
@ -45,19 +48,17 @@ arith min_int[] = { 0L, -128L, -32768L, 0L, -2147483647L-1 };
extern char options[]; extern char options[];
void CutSize(); static void CutSize(register t_node *);
overflow(expp)
t_node *expp; static void overflow(t_node *expp)
{ {
if (expp->nd_type != address_type) { if (expp->nd_type != address_type) {
node_warning(expp, W_ORDINARY, "overflow in constant expression"); node_warning(expp, W_ORDINARY, "overflow in constant expression");
} }
} }
STATIC static void commonbin(t_node **expp)
commonbin(expp)
t_node **expp;
{ {
register t_node *exp = *expp; register t_node *exp = *expp;
t_type *tp = exp->nd_type; t_type *tp = exp->nd_type;
@ -69,11 +70,10 @@ commonbin(expp)
right->nd_type = tp; right->nd_type = tp;
} }
cstunary(expp) void cstunary(t_node **expp)
t_node **expp;
{ {
/* The unary operation in "expp" is performed on the constant /* The unary operation in "expp" is performed on the constant
expression below it, and the result restored in expp. expression below it, and the result stored in expp.
*/ */
register t_node *exp = *expp; register t_node *exp = *expp;
register t_node *right = exp->nd_RIGHT; register t_node *right = exp->nd_RIGHT;
@ -107,9 +107,7 @@ cstunary(expp)
CutSize(*expp); CutSize(*expp);
} }
STATIC static void divide(arith *pdiv, arith *prem)
divide(pdiv, prem)
arith *pdiv, *prem;
{ {
/* Unsigned divide *pdiv by *prem, and store result in *pdiv, /* Unsigned divide *pdiv by *prem, and store result in *pdiv,
remainder in *prem remainder in *prem
@ -121,9 +119,7 @@ divide(pdiv, prem)
*prem = (unsigned arith) o1 % (unsigned arith) o2; *prem = (unsigned arith) o1 % (unsigned arith) o2;
} }
void void cstibin(t_node **expp)
cstibin(expp)
t_node **expp;
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expp. expressions below it, and the result restored in expp.
@ -232,8 +228,7 @@ cstibin(expp)
CutSize(*expp); CutSize(*expp);
} }
cstfbin(expp) void cstfbin(t_node **expp)
t_node **expp;
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expp. expressions below it, and the result restored in expp.
@ -320,9 +315,7 @@ cstfbin(expp)
CutSize(exp); CutSize(exp);
} }
void void cstubin(t_node **expp)
cstubin(expp)
t_node **expp;
{ {
/* The binary operation in "expp" is performed on the constant /* The binary operation in "expp" is performed on the constant
expressions below it, and the result restored in expressions below it, and the result restored in
@ -427,9 +420,7 @@ cstubin(expp)
CutSize(exp); CutSize(exp);
} }
void void cstset(t_node **expp)
cstset(expp)
t_node **expp;
{ {
extern arith *MkSet(); extern arith *MkSet();
register t_node *exp = *expp; register t_node *exp = *expp;
@ -544,8 +535,7 @@ cstset(expp)
FreeNode(exp); FreeNode(exp);
} }
cstcall(expp, call) void cstcall(t_node **expp, int call)
t_node **expp;
{ {
/* a standard procedure call is found that can be evaluated /* a standard procedure call is found that can be evaluated
compile time, so do so. compile time, so do so.
@ -619,9 +609,7 @@ cstcall(expp, call)
} }
} }
void static void CutSize(register t_node *expr)
CutSize(expr)
register t_node *expr;
{ {
/* The constant value of the expression expr is made to /* The constant value of the expression expr is made to
conform to the size of the type of the expression. conform to the size of the type of the expression.
@ -640,7 +628,7 @@ CutSize(expr)
} }
} }
InitCst() void InitCst(void)
{ {
register int i = 0; register int i = 0;
#ifndef NOCROSS #ifndef NOCROSS

29
lang/m2/comp/cstoper.h Normal file
View file

@ -0,0 +1,29 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
* Created on: 2019-02-25
*
*/
#ifndef CSTOPER_H_
#define CSTOPER_H_
/* Compile time constant evaluations */
void cstunary(t_node **expp);
void cstibin(t_node **expp);
void cstfbin(t_node **expp);
void cstubin(t_node **expp);
/** Evaluates the constant set operators at compile time
* and returns the result in "expp".
*/
void cstset(t_node **expp);
/* Evaluates the result of internal procedures on constants
* at compile time, and returns the result in "expp".
*/
void cstcall(t_node **expp, int call);
/* Compile time constant evaluator system initialization. */
void InitCst(void);
#endif /* CSTOPER_H_ */

11
lang/m2/comp/declar.g
View file

@ -10,13 +10,13 @@
/* $Id$ */ /* $Id$ */
{ {
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <em_arith.h>
#include <em_label.h>
#include <alloc.h>
#include <assert.h> #include <assert.h>
#include "em_arith.h"
#include "em_label.h"
#include "alloc.h"
#include "idf.h" #include "idf.h"
#include "LLlex.h" #include "LLlex.h"
@ -24,8 +24,11 @@
#include "type.h" #include "type.h"
#include "scope.h" #include "scope.h"
#include "node.h" #include "node.h"
#include "enter.h"
#include "error.h"
#include "misc.h" #include "misc.h"
#include "main.h" #include "main.h"
#include "typequiv.h"
#include "chk_expr.h" #include "chk_expr.h"
#include "warning.h" #include "warning.h"

312
lang/m2/comp/def.c
View file

@ -11,57 +11,64 @@
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <alloc.h>
#include <em_arith.h>
#include <em_label.h>
#include <em_code.h>
#include <assert.h> #include <assert.h>
#include "alloc.h"
#include "em_arith.h"
#include "em_label.h"
#include "em_code.h"
#include "typequiv.h"
#include "LLlex.h" #include "LLlex.h"
#include "main.h" #include "main.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "idf.h" #include "idf.h"
#include "print.h"
#include "scope.h" #include "scope.h"
#include "lookup.h"
#include "node.h" #include "node.h"
#include "misc.h"
#include "Lpars.h" #include "Lpars.h"
#include "warning.h" #include "warning.h"
#include "error.h"
extern char *sprint();
STATIC
internal(c) static void internal(register char *c)
register char *c;
{ {
if (options['x']) { if (options['x'])
{
C_exp(c); C_exp(c);
} }
else C_inp(c); else
C_inp(c);
} }
STATIC static void DefInFront(register t_def *df)
DefInFront(df)
register t_def *df;
{ {
/* Put definition "df" in front of the list of definitions /* Put definition "df" in front of the list of definitions
in its scope. in its scope.
This is neccessary because in some cases the order in this This is neccessary because in some cases the order in this
list is important. list is important.
*/ */
register t_def *df1 = df->df_scope->sc_def; register t_def *df1 = df->df_scope->sc_def;
if (df1 != df) { if (df1 != df)
{
/* Definition "df" is not in front of the list /* Definition "df" is not in front of the list
*/ */
while (df1) { while (df1)
{
/* Find definition "df" /* Find definition "df"
*/ */
if (df1->df_nextinscope == df) { if (df1->df_nextinscope == df)
{
/* It already was in the list. Remove it /* It already was in the list. Remove it
*/ */
df1->df_nextinscope = df->df_nextinscope; df1->df_nextinscope = df->df_nextinscope;
break; break;
} }
@ -69,20 +76,17 @@ DefInFront(df)
} }
/* Now put it in front /* Now put it in front
*/ */
df->df_nextinscope = df->df_scope->sc_def; df->df_nextinscope = df->df_scope->sc_def;
df->df_scope->sc_def = df; df->df_scope->sc_def = df;
} }
} }
t_def * t_def *MkDef(register t_idf *id, register t_scope *scope, int kind)
MkDef(id, scope, kind)
register t_idf *id;
register t_scope *scope;
{ {
/* Create a new definition structure in scope "scope", with /* Create a new definition structure in scope "scope", with
id "id" and kind "kind". id "id" and kind "kind".
*/ */
register t_def *df; register t_def *df;
df = new_def(); df = new_def();
@ -91,40 +95,42 @@ MkDef(id, scope, kind)
df->df_kind = kind; df->df_kind = kind;
df->df_next = id->id_def; df->df_next = id->id_def;
id->id_def = df; id->id_def = df;
if (kind == D_ERROR || kind == D_FORWARD) df->df_type = error_type; if (kind == D_ERROR || kind == D_FORWARD)
if (kind & (D_TYPE|D_PROCEDURE|D_CONST)) { df->df_type = error_type;
if (kind & (D_TYPE | D_PROCEDURE | D_CONST))
{
df->df_flags = D_DEFINED; df->df_flags = D_DEFINED;
} }
/* enter the definition in the list of definitions in this scope /* enter the definition in the list of definitions in this scope
*/ */
df->df_nextinscope = scope->sc_def; df->df_nextinscope = scope->sc_def;
scope->sc_def = df; scope->sc_def = df;
return df; return df;
} }
t_def * t_def *define(register t_idf *id, register t_scope *scope, int kind)
define(id, scope, kind)
register t_idf *id;
register t_scope *scope;
int kind;
{ {
/* Declare an identifier in a scope, but first check if it /* Declare an identifier in a scope, but first check if it
already has been defined. already has been defined.
If so, then check for the cases in which this is legal, If so, then check for the cases in which this is legal,
and otherwise give an error message. and otherwise give an error message.
*/ */
register t_def *df; register t_def *df;
DO_DEBUG(options['S'], print("define %s, %x\n", id->id_text, kind)); DO_DEBUG(options['S'], print("define %s, %x\n", id->id_text, kind));
df = lookup(id, scope, D_IMPORT, 0); df = lookup(id, scope, D_IMPORT, 0);
if ( /* Already in this scope */ if ( /* Already in this scope */
df df)
) { {
switch(df->df_kind) { switch (df->df_kind)
{
case D_INUSE: case D_INUSE:
if (kind != D_INUSE && kind != D_ERROR) { if (kind != D_INUSE && kind != D_ERROR)
error("identifier \"%s\" already used; may not be redefined in this scope", df->df_idf->id_text); {
error(
"identifier \"%s\" already used; may not be redefined in this scope",
df->df_idf->id_text);
df->df_kind = D_ERROR; df->df_kind = D_ERROR;
break; break;
} }
@ -132,10 +138,11 @@ define(id, scope, kind)
case D_HIDDEN: case D_HIDDEN:
/* An opaque type. We may now have found the /* An opaque type. We may now have found the
definition of this type. definition of this type.
*/ */
if (kind == D_TYPE && df->df_scope == CurrentScope && if (kind == D_TYPE && df->df_scope == CurrentScope
!DefinitionModule) { && !DefinitionModule)
{
df->df_kind = D_TYPE; df->df_kind = D_TYPE;
return df; return df;
} }
@ -143,14 +150,16 @@ define(id, scope, kind)
case D_FORWMODULE: case D_FORWMODULE:
/* A forward reference to a module. We may have found /* A forward reference to a module. We may have found
another one, or we may have found the definition another one, or we may have found the definition
for this module. for this module.
*/ */
if (kind & (D_FORWMODULE|D_FORWARD)) { if (kind & (D_FORWMODULE | D_FORWARD))
{
return df; return df;
} }
if (kind == D_MODULE) { if (kind == D_MODULE)
{
FreeNode(df->for_node); FreeNode(df->for_node);
df->mod_vis = df->for_vis; df->mod_vis = df->for_vis;
df->df_kind = kind; df->df_kind = kind;
@ -160,33 +169,38 @@ define(id, scope, kind)
break; break;
case D_TYPE: case D_TYPE:
if (kind == D_FORWTYPE) return df; if (kind == D_FORWTYPE)
return df;
break; break;
case D_FORWTYPE: case D_FORWTYPE:
if (kind & (D_FORWTYPE|D_TYPE)) return df; if (kind & (D_FORWTYPE | D_TYPE))
return df;
error("identifier \"%s\" must be a type", id->id_text); error("identifier \"%s\" must be a type", id->id_text);
df->df_kind = D_ERROR; df->df_kind = D_ERROR;
break; break;
case D_FORWARD: case D_FORWARD:
/* A forward reference, for which we may now have /* A forward reference, for which we may now have
found a definition. found a definition.
*/ */
if (! (kind & (D_FORWARD | D_FORWMODULE))) { if (!(kind & (D_FORWARD | D_FORWMODULE)))
{
FreeNode(df->for_node); FreeNode(df->for_node);
} }
df->df_kind = D_ERROR; /* avoiding error message */ df->df_kind = D_ERROR; /* avoiding error message */
break; break;
} }
if (kind != D_ERROR && df->df_kind != D_ERROR) { if (kind != D_ERROR && df->df_kind != D_ERROR)
{
/* Avoid spurious error messages /* Avoid spurious error messages
*/ */
error("identifier \"%s\" already declared", error("identifier \"%s\" already declared", id->id_text);
id->id_text);
} }
if (df->df_scope == scope || df->df_kind == D_ERROR) { if (df->df_scope == scope || df->df_kind == D_ERROR)
{
df->df_kind = kind; df->df_kind = kind;
if (kind & (D_TYPE|D_PROCEDURE|D_CONST)) { if (kind & (D_TYPE | D_PROCEDURE | D_CONST))
{
df->df_flags = D_DEFINED; df->df_flags = D_DEFINED;
} }
@ -197,43 +211,49 @@ define(id, scope, kind)
return MkDef(id, scope, kind); return MkDef(id, scope, kind);
} }
end_definition_list(pdf) void end_definition_list(register t_def **pdf)
register t_def **pdf;
{ {
/* Remove all imports from a definition module. This is /* Remove all imports from a definition module. This is
neccesary because the implementation module might import neccesary because the implementation module might import
them again. them again.
Also, mark all other definitions "QUALIFIED EXPORT". Also, mark all other definitions "QUALIFIED EXPORT".
*/ */
register t_def *df; register t_def *df;
while (df = *pdf) { while ( (df = *pdf) )
if (df->df_kind & D_IMPORTED) { {
if (! (df->df_flags & D_USED)) { if (df->df_kind & D_IMPORTED)
warning(W_ORDINARY, "identifier \"%s\" imported but not used", df->df_idf->id_text); {
if (!(df->df_flags & D_USED))
{
warning(W_ORDINARY, "identifier \"%s\" imported but not used",
df->df_idf->id_text);
} }
RemoveFromIdList(df); RemoveFromIdList(df);
*pdf = df->df_nextinscope; *pdf = df->df_nextinscope;
free_def(df); free_def(df);
} }
else { else
{
df->df_flags |= D_QEXPORTED; df->df_flags |= D_QEXPORTED;
pdf = &(df->df_nextinscope); pdf = &(df->df_nextinscope);
} }
} }
} }
RemoveFromIdList(df) void RemoveFromIdList(register t_def *df)
register t_def *df;
{ {
/* Remove definition "df" from the definition list /* Remove definition "df" from the definition list
*/ */
register t_idf *id = df->df_idf; register t_idf *id = df->df_idf;
register t_def *df1; register t_def *df1;
if ((df1 = id->id_def) == df) id->id_def = df->df_next; if ((df1 = id->id_def) == df)
else { id->id_def = df->df_next;
while (df1->df_next != df) { else
{
while (df1->df_next != df)
{
assert(df1->df_next != 0); assert(df1->df_next != 0);
df1 = df1->df_next; df1 = df1->df_next;
} }
@ -241,14 +261,12 @@ RemoveFromIdList(df)
} }
} }
t_def * t_def * DeclProc(int type, register t_idf *id)
DeclProc(type, id)
register t_idf *id;
{ {
/* A procedure is declared, either in a definition or a program /* A procedure is declared, either in a definition or a program
module. Create a def structure for it (if neccessary). module. Create a def structure for it (if neccessary).
Also create a name for it. Also create a name for it.
*/ */
register t_def *df; register t_def *df;
register t_scope *scope; register t_scope *scope;
static int nmcount; static int nmcount;
@ -256,38 +274,45 @@ DeclProc(type, id)
assert(type & (D_PROCEDURE | D_PROCHEAD)); assert(type & (D_PROCEDURE | D_PROCHEAD));
if (type == D_PROCHEAD) { if (type == D_PROCHEAD)
{
/* In a definition module /* In a definition module
*/ */
df = define(id, CurrentScope, type); df = define(id, CurrentScope, type);
df->for_node = dot2leaf(Name); df->for_node = dot2leaf(Name);
df->df_flags |= D_USED | D_DEFINED; df->df_flags |= D_USED | D_DEFINED;
if (CurrentScope->sc_definedby->df_flags & D_FOREIGN) { if (CurrentScope->sc_definedby->df_flags & D_FOREIGN)
{
df->prc_name = id->id_text; df->prc_name = id->id_text;
} }
else { else
sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text); {
df->prc_name = Salloc(buf, (unsigned) (strlen(buf)+1)); sprint(buf, "%s_%s", CurrentScope->sc_name, id->id_text);
df->prc_name = Salloc(buf, (unsigned) (strlen(buf) + 1));
} }
if (CurrVis == Defined->mod_vis) { if (CurrVis == Defined->mod_vis)
{
/* The current module will define this routine. /* The current module will define this routine.
make sure the name is exported. make sure the name is exported.
*/ */
C_exp(df->prc_name); C_exp(df->prc_name);
} }
} }
else { else
{
df = lookup(id, CurrentScope, D_IMPORTED, 0); df = lookup(id, CurrentScope, D_IMPORTED, 0);
if (df && df->df_kind == D_PROCHEAD) { if (df && df->df_kind == D_PROCHEAD)
{
/* C_exp already generated when we saw the definition /* C_exp already generated when we saw the definition
in the definition module in the definition module
*/ */
DefInFront(df); DefInFront(df);
} }
else { else
{
df = define(id, CurrentScope, type); df = define(id, CurrentScope, type);
sprint(buf,"_%d_%s",++nmcount,id->id_text); sprint(buf, "_%d_%s", ++nmcount, id->id_text);
df->prc_name = Salloc(buf, (unsigned)(strlen(buf)+1)); df->prc_name = Salloc(buf, (unsigned) (strlen(buf) + 1));
internal(buf); internal(buf);
df->df_flags |= D_DEFINED; df->df_flags |= D_DEFINED;
} }
@ -301,32 +326,29 @@ DeclProc(type, id)
return df; return df;
} }
EndProc(df, id) void EndProc(register t_def *df, t_idf *id)
register t_def *df;
t_idf *id;
{ {
/* The end of a procedure declaration. /* The end of a procedure declaration.
Check that the closing identifier matches the name of the Check that the closing identifier matches the name of the
procedure, close the scope, and check that a function procedure, close the scope, and check that a function
procedure has at least one RETURN statement. procedure has at least one RETURN statement.
*/ */
extern int return_occurred; extern int return_occurred;
match_id(id, df->df_idf); match_id(id, df->df_idf);
close_scope(SC_CHKFORW|SC_REVERSE); close_scope(SC_CHKFORW | SC_REVERSE);
if (! return_occurred && ResultType(df->df_type)) { if (!return_occurred && ResultType(df->df_type))
{
error("function procedure %s does not return a value", error("function procedure %s does not return a value",
df->df_idf->id_text); df->df_idf->id_text);
} }
} }
t_def * t_def * DefineLocalModule(t_idf *id)
DefineLocalModule(id)
t_idf *id;
{ {
/* Create a definition for a local module. Also give it /* Create a definition for a local module. Also give it
a name to be used for code generation. a name to be used for code generation.
*/ */
register t_def *df = define(id, CurrentScope, D_MODULE); register t_def *df = define(id, CurrentScope, D_MODULE);
register t_scope *sc; register t_scope *sc;
static int modulecount = 0; static int modulecount = 0;
@ -335,12 +357,13 @@ DefineLocalModule(id)
sprint(buf, "_%d%s_", ++modulecount, id->id_text); sprint(buf, "_%d%s_", ++modulecount, id->id_text);
if (!df->mod_vis) { if (!df->mod_vis)
{
/* We never saw the name of this module before. Create a /* We never saw the name of this module before. Create a
scope for it. scope for it.
*/ */
open_scope(CLOSEDSCOPE); open_scope(CLOSEDSCOPE);
df->mod_vis = CurrVis; df->mod_vis = CurrVis;
} }
CurrVis = df->mod_vis; CurrVis = df->mod_vis;
@ -351,35 +374,33 @@ DefineLocalModule(id)
sc->sc_name = Salloc(buf, (unsigned) (strlen(buf) + 1)); sc->sc_name = Salloc(buf, (unsigned) (strlen(buf) + 1));
/* Create a type for it /* Create a type for it
*/ */
df->df_type = standard_type(T_RECORD, 1, (arith) 0); df->df_type = standard_type(T_RECORD, 1, (arith) 0);
df->df_type->rec_scope = sc; df->df_type->rec_scope = sc;
/* Generate code that indicates that the initialization procedure /* Generate code that indicates that the initialization procedure
for this module is local. for this module is local.
*/ */
internal(buf); internal(buf);
return df; return df;
} }
CheckWithDef(df, tp) void CheckWithDef(register t_def *df, t_type *tp)
register t_def *df;
t_type *tp;
{ {
/* Check the header of a procedure declaration against a /* Check the header of a procedure declaration against a
possible earlier definition in the definition module. possible earlier definition in the definition module.
*/ */
if (df->df_kind == D_PROCHEAD && if (df->df_kind == D_PROCHEAD && df->df_type && df->df_type != error_type)
df->df_type && {
df->df_type != error_type) {
/* We already saw a definition of this type /* We already saw a definition of this type
in the definition module. in the definition module.
*/ */
if (!TstProcEquiv(tp, df->df_type)) { if (!TstProcEquiv(tp, df->df_type))
{
error("inconsistent procedure declaration for \"%s\"", error("inconsistent procedure declaration for \"%s\"",
df->df_idf->id_text); df->df_idf->id_text);
} }
FreeType(df->df_type); FreeType(df->df_type);
df->df_kind = D_PROCEDURE; df->df_kind = D_PROCEDURE;
@ -388,8 +409,7 @@ CheckWithDef(df, tp)
} }
#ifdef DEBUG #ifdef DEBUG
PrDef(df) void PrDef(register t_def *df)
register t_def *df;
{ {
print("n: %s, k: %d\n", df->df_idf->id_text, df->df_kind); print("n: %s, k: %d\n", df->df_idf->id_text, df->df_kind);
} }

24
lang/m2/comp/def.xh
View file

@ -4,6 +4,8 @@
* *
* Author: Ceriel J.H. Jacobs * Author: Ceriel J.H. Jacobs
*/ */
#ifndef DEF_H_
#define DEF_H_
/* I D E N T I F I E R D E S C R I P T O R S T R U C T U R E */ /* I D E N T I F I E R D E S C R I P T O R S T R U C T U R E */
@ -132,12 +134,20 @@ struct def { /* list of definitions for a name */
typedef struct def t_def; typedef struct def t_def;
/* ALLOCDEF "def" 50 */ /* ALLOCDEF "def" 50 */
extern t_def
*define(),
*DefineLocalModule(),
*MkDef(),
*DeclProc(),
*lookup(),
*lookfor();
#define NULLDEF ((t_def *) 0) #define NULLDEF ((t_def *) 0)
typedef struct scope t_scope;
typedef struct idf t_idf;
typedef struct type t_type;
t_def *MkDef(register t_idf *id, register t_scope *scope, int kind);
t_def *define(register t_idf *id, register t_scope *scope, int kind);
void RemoveFromIdList(register t_def *df);
t_def * DeclProc(int type, register t_idf *id);
void EndProc(register t_def *df, t_idf *id);
t_def * DefineLocalModule(t_idf *id);
void CheckWithDef(register t_def *df, t_type *tp);
void end_definition_list(register t_def **pdf);
#endif /* DEF_H_ */

15
lang/m2/comp/defmodule.c
View file

@ -26,9 +26,12 @@
#include "f_info.h" #include "f_info.h"
#include "idf.h" #include "idf.h"
#include "input.h" #include "input.h"
#include "error.h"
#include "main.h" #include "main.h"
#include "misc.h" #include "misc.h"
#include "node.h" #include "node.h"
#include "lookup.h"
#include "main.h"
#include "scope.h" #include "scope.h"
#include "type.h" #include "type.h"
@ -36,13 +39,13 @@
size_t sys_filesize(); size_t sys_filesize();
#endif #endif
extern void DefModule(void); /* Lpars */
t_idf* DefId; t_idf* DefId;
char* char* getwdir(register char *fn)
getwdir(fn) register char* fn;
{ {
register char* p; register char* p;
char* strrchr();
while ((p = strrchr(fn, '/')) && *(p + 1) == '\0') while ((p = strrchr(fn, '/')) && *(p + 1) == '\0')
{ {
@ -60,8 +63,7 @@ char*
return ""; return "";
} }
STATIC int static int GetFile(char *name)
GetFile(name) char* name;
{ {
/* Try to find a file with basename "name" and extension ".def", /* Try to find a file with basename "name" and extension ".def",
in the directories mentioned in "DEFPATH". in the directories mentioned in "DEFPATH".
@ -88,8 +90,7 @@ GetFile(name) char* name;
return 1; return 1;
} }
t_def* t_def* GetDefinitionModule(register t_idf* id, int incr)
GetDefinitionModule(id, incr) register t_idf* id;
{ {
/* Return a pointer to the "def" structure of the definition /* Return a pointer to the "def" structure of the definition
module indicated by "id". module indicated by "id".

75
lang/m2/comp/desig.c
View file

@ -16,14 +16,14 @@
or perform a store. or perform a store.
*/ */
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <em_arith.h>
#include <em_label.h>
#include <em_code.h>
#include <assert.h> #include <assert.h>
#include <alloc.h> #include "em_arith.h"
#include "em_label.h"
#include "em_code.h"
#include "alloc.h"
#include "type.h" #include "type.h"
#include "LLlex.h" #include "LLlex.h"
@ -32,16 +32,15 @@
#include "desig.h" #include "desig.h"
#include "node.h" #include "node.h"
#include "warning.h" #include "warning.h"
#include "error.h"
#include "code.h"
#include "tmpvar.h"
#include "walk.h" #include "walk.h"
extern int proclevel; extern int proclevel;
extern arith NewPtr();
extern char options[]; extern char options[];
int static int WordOrDouble(t_desig *ds, arith size)
WordOrDouble(ds, size)
t_desig *ds;
arith size;
{ {
/* Check if designator is suitable for word or double-word /* Check if designator is suitable for word or double-word
operation operation
@ -53,8 +52,7 @@ WordOrDouble(ds, size)
return 0; return 0;
} }
LOL(offset, size) void LOL(arith offset, arith size)
arith offset, size;
{ {
if (size == word_size) { if (size == word_size) {
C_lol(offset); C_lol(offset);
@ -68,8 +66,7 @@ LOL(offset, size)
} }
} }
STL(offset, size) void STL(arith offset, arith size)
arith offset, size;
{ {
if (size == word_size) { if (size == word_size) {
C_stl(offset); C_stl(offset);
@ -83,10 +80,7 @@ STL(offset, size)
} }
} }
int int DoLoad(register t_desig *ds, arith size)
DoLoad(ds, size)
register t_desig *ds;
arith size;
{ {
/* Try to load designator with word or double-word operation. /* Try to load designator with word or double-word operation.
Return 0 if not done Return 0 if not done
@ -110,10 +104,7 @@ DoLoad(ds, size)
return 1; return 1;
} }
int int DoStore(register t_desig *ds, arith size)
DoStore(ds, size)
register t_desig *ds;
arith size;
{ {
/* Try to store designator with word or double-word operation. /* Try to store designator with word or double-word operation.
Return 0 if not done Return 0 if not done
@ -161,9 +152,7 @@ DoStore(ds, size)
multiple of word_size only multiple of word_size only
*/ */
STATIC int static int suitable_move(register t_type *tp)
suitable_move(tp)
register t_type *tp;
{ {
/* Find out how to load or store the value indicated by "ds". /* Find out how to load or store the value indicated by "ds".
There are four ways: There are four ways:
@ -181,9 +170,7 @@ suitable_move(tp)
return USE_BLM; return USE_BLM;
} }
CodeValue(ds, tp) void CodeValue(register t_desig *ds, register t_type *tp)
register t_desig *ds;
register t_type *tp;
{ {
/* Generate code to load the value of the designator described /* Generate code to load the value of the designator described
in "ds". in "ds".
@ -246,8 +233,7 @@ CodeValue(ds, tp)
ds->dsg_kind = DSG_LOADED; ds->dsg_kind = DSG_LOADED;
} }
ChkForFOR(nd) void ChkForFOR(register t_node *nd)
register t_node *nd;
{ {
/* Check for an assignment to a FOR-loop control variable /* Check for an assignment to a FOR-loop control variable
*/ */
@ -264,9 +250,7 @@ ChkForFOR(nd)
} }
} }
CodeStore(ds, tp) void CodeStore(register t_desig *ds, register t_type *tp)
register t_desig *ds;
register t_type *tp;
{ {
/* Generate code to store the value on the stack in the designator /* Generate code to store the value on the stack in the designator
described in "ds" described in "ds"
@ -311,9 +295,7 @@ CodeStore(ds, tp)
ds->dsg_kind = DSG_INIT; ds->dsg_kind = DSG_INIT;
} }
CodeCopy(lhs, rhs, sz, psize) void CodeCopy(register t_desig *lhs, register t_desig *rhs, arith sz, arith *psize)
register t_desig *lhs, *rhs;
arith sz, *psize;
{ {
/* Do part of a copy, which is assumed to be "reasonable", /* Do part of a copy, which is assumed to be "reasonable",
so that it can be done with LOI/STI or BLM. so that it can be done with LOI/STI or BLM.
@ -338,10 +320,7 @@ CodeCopy(lhs, rhs, sz, psize)
t_desig null_desig; t_desig null_desig;
CodeMove(rhs, left, rtp) void CodeMove(register t_desig *rhs, register t_node *left, t_type *rtp)
register t_desig *rhs;
register t_node *left;
t_type *rtp;
{ {
/* Generate code for an assignment. Testing of type /* Generate code for an assignment. Testing of type
compatibility and the like is already done. compatibility and the like is already done.
@ -440,8 +419,7 @@ CodeMove(rhs, left, rtp)
} }
} }
CodeAddress(ds) void CodeAddress(register t_desig *ds)
register t_desig *ds;
{ {
/* Generate code to load the address of the designator described /* Generate code to load the address of the designator described
in "ds" in "ds"
@ -481,9 +459,7 @@ CodeAddress(ds)
ds->dsg_kind = DSG_PLOADED; ds->dsg_kind = DSG_PLOADED;
} }
CodeFieldDesig(df, ds) void CodeFieldDesig(register t_def *df, register t_desig *ds)
register t_def *df;
register t_desig *ds;
{ {
/* Generate code for a field designator. Only the code common for /* Generate code for a field designator. Only the code common for
address as well as value computation is generated, and the address as well as value computation is generated, and the
@ -533,10 +509,7 @@ CodeFieldDesig(df, ds)
} }
} }
void void CodeVarDesig(register t_def *df, register t_desig *ds)
CodeVarDesig(df, ds)
register t_def *df;
register t_desig *ds;
{ {
/* Generate code for a variable represented by a "def" structure. /* Generate code for a variable represented by a "def" structure.
Of course, there are numerous cases: the variable is local, Of course, there are numerous cases: the variable is local,
@ -612,9 +585,7 @@ CodeVarDesig(df, ds)
ds->dsg_def = df; ds->dsg_def = df;
} }
CodeDesig(nd, ds) void CodeDesig(register t_node *nd, register t_desig *ds)
register t_node *nd;
register t_desig *ds;
{ {
/* Generate code for a designator. Use divide and conquer /* Generate code for a designator. Use divide and conquer
principle principle

22
lang/m2/comp/desig.h
View file

@ -4,11 +4,15 @@
* *
* Author: Ceriel J.H. Jacobs * Author: Ceriel J.H. Jacobs
*/ */
#ifndef DESIG_H_
#define DESIG_H_
/* D E S I G N A T O R D E S C R I P T I O N S */ /* D E S I G N A T O R D E S C R I P T I O N S */
/* $Id$ */ /* $Id$ */
#include <em_arith.h>
/* Generating code for designators is not particularly easy, especially if /* Generating code for designators is not particularly easy, especially if
you don't know wether you want the address or the value. you don't know wether you want the address or the value.
The next structure is used to generate code for designators. The next structure is used to generate code for designators.
@ -65,3 +69,21 @@ struct withdesig {
extern struct withdesig *WithDesigs; extern struct withdesig *WithDesigs;
#define NO_LABEL ((label) 0) #define NO_LABEL ((label) 0)
typedef struct type t_type;
typedef struct node t_node;
void LOL(arith offset, arith size);
void STL(arith offset, arith size);
void CodeValue(register t_desig *ds, register t_type *tp);
void ChkForFOR(register t_node *nd);
void CodeStore(register t_desig *ds, register t_type *tp);
void CodeCopy(register t_desig *lhs, register t_desig *rhs, arith sz, arith *psize);
void CodeMove(register t_desig *rhs, register t_node *left, t_type *rtp);
void CodeAddress(register t_desig *ds);
void CodeFieldDesig(register t_def *df, register t_desig *ds);
void CodeVarDesig(register t_def *df, register t_desig *ds);
void CodeDesig(register t_node *nd, register t_desig *ds);
#endif /* DESIG_H_ */

94
lang/m2/comp/enter.c
View file

@ -22,20 +22,24 @@
#include "em_code.h" #include "em_code.h"
#include "assert.h" #include "assert.h"
#include "enter.h"
#include "idf.h" #include "idf.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "error.h"
#include "scope.h" #include "scope.h"
#include "node.h" #include "node.h"
#include "stab.h"
#include "main.h" #include "main.h"
#include "lookup.h"
#include "misc.h" #include "misc.h"
#include "f_info.h" #include "f_info.h"
t_def *
Enter(name, kind, type, pnam) static t_def *DoImport(register t_def *, t_scope *, int);
char *name;
t_type *type; t_def *Enter(char *name, int kind, t_type *type, int pnam)
{ {
/* Enter a definition for "name" with kind "kind" and type /* Enter a definition for "name" with kind "kind" and type
"type" in the Current Scope. If it is a standard name, also "type" in the Current Scope. If it is a standard name, also
@ -52,10 +56,7 @@ Enter(name, kind, type, pnam)
return df; return df;
} }
t_def * t_def *EnterType(char *name, t_type *type)
EnterType(name, type)
char *name;
t_type *type;
{ {
/* Enter a type definition for "name" and type /* Enter a type definition for "name" and type
"type" in the Current Scope. "type" in the Current Scope.
@ -64,9 +65,7 @@ EnterType(name, type)
return Enter(name, D_TYPE, type, 0); return Enter(name, D_TYPE, type, 0);
} }
EnterEnumList(Idlist, type) void EnterEnumList(t_node *Idlist, register t_type *type)
t_node *Idlist;
register t_type *type;
{ {
/* Put a list of enumeration literals in the symbol table. /* Put a list of enumeration literals in the symbol table.
They all have type "type". They all have type "type".
@ -92,11 +91,8 @@ EnterEnumList(Idlist, type)
FreeNode(Idlist); FreeNode(Idlist);
} }
EnterFieldList(Idlist, type, scope, addr) void EnterFieldList(t_node *Idlist, register t_type *type, t_scope *scope,
t_node *Idlist; arith *addr)
register t_type *type;
t_scope *scope;
arith *addr;
{ {
/* Put a list of fields in the symbol table. /* Put a list of fields in the symbol table.
They all have type "type", and are put in scope "scope". They all have type "type", and are put in scope "scope".
@ -116,15 +112,8 @@ EnterFieldList(Idlist, type, scope, addr)
FreeNode(Idlist); FreeNode(Idlist);
} }
EnterVarList(Idlist, type, local) void EnterVarList(t_node *Idlist, t_type *type, int local)
t_node *Idlist;
t_type *type;
{ {
/* Enter a list of identifiers representing variables into the
name list. "type" represents the type of the variables.
"local" is set if the variables are declared local to a
procedure.
*/
register t_def *df; register t_def *df;
register t_node *idlist = Idlist; register t_node *idlist = Idlist;
register t_scopelist *sc = CurrVis; register t_scopelist *sc = CurrVis;
@ -191,17 +180,12 @@ EnterVarList(Idlist, type, local)
FreeNode(Idlist); FreeNode(Idlist);
} }
EnterParamList(ppr, Idlist, type, VARp, off) void EnterParamList(t_param **ppr,
t_param **ppr; t_node *Idlist,
t_node *Idlist; t_type *type,
t_type *type; int VARp,
int VARp; arith *off)
arith *off;
{ {
/* Create (part of) a parameterlist of a procedure.
"ids" indicates the list of identifiers, "tp" their type, and
"VARp" indicates D_VARPAR or D_VALPAR.
*/
register t_param *pr; register t_param *pr;
register t_def *df; register t_def *df;
register t_node *idlist = Idlist; register t_node *idlist = Idlist;
@ -245,12 +229,8 @@ EnterParamList(ppr, Idlist, type, VARp, off)
FreeNode(Idlist); FreeNode(Idlist);
} }
STATIC t_def *DoImport();
void static void ImportEffects(register t_def *idef, t_scope *scope, int flag)
ImportEffects(idef, scope, flag)
register t_def *idef;
t_scope *scope;
{ {
/* Handle side effects of an import: /* Handle side effects of an import:
- a module could have unqualified exports ??? - a module could have unqualified exports ???
@ -316,10 +296,7 @@ ImportEffects(idef, scope, flag)
} }
} }
STATIC t_def * static t_def *DoImport(register t_def *df, t_scope *scope, int flag)
DoImport(df, scope, flag)
register t_def *df;
t_scope *scope;
{ {
/* Definition "df" is imported to scope "scope". /* Definition "df" is imported to scope "scope".
*/ */
@ -332,10 +309,7 @@ DoImport(df, scope, flag)
} }
STATIC static void ForwModule(register t_def *df, t_node *nd)
ForwModule(df, nd)
register t_def *df;
t_node *nd;
{ {
/* An import is done from a not yet defined module "df". /* An import is done from a not yet defined module "df".
We could also end up here for not found DEFINITION MODULES. We could also end up here for not found DEFINITION MODULES.
@ -360,10 +334,7 @@ ForwModule(df, nd)
df->for_node = nd; df->for_node = nd;
} }
STATIC t_def * static t_def *ForwDef(register t_node *ids, t_scope *scope)
ForwDef(ids, scope)
register t_node *ids;
t_scope *scope;
{ {
/* Enter a forward definition of "ids" in scope "scope", /* Enter a forward definition of "ids" in scope "scope",
if it is not already defined. if it is not already defined.
@ -379,14 +350,8 @@ ForwDef(ids, scope)
return df; return df;
} }
EnterExportList(Idlist, qualified) void EnterExportList(t_node *Idlist, int qualified)
t_node *Idlist;
{ {
/* From the current scope, the list of identifiers "ids" is
exported. Note this fact. If the export is not qualified, make
all the "ids" visible in the enclosing scope by defining them
in this scope as "imported".
*/
register t_node *idlist = Idlist; register t_node *idlist = Idlist;
register t_def *df, *df1; register t_def *df, *df1;
@ -461,8 +426,7 @@ EnterExportList(Idlist, qualified)
FreeNode(Idlist); FreeNode(Idlist);
} }
CheckForImports(df) void CheckForImports(t_def *df)
t_def *df;
{ {
/* We have a definition for "df"; check all imports of /* We have a definition for "df"; check all imports of
it for side-effects it for side-effects
@ -482,11 +446,7 @@ CheckForImports(df)
} }
} }
void void EnterFromImportList(t_node *idlist, t_def *FromDef, t_node *FromId)
EnterFromImportList(idlist, FromDef, FromId)
register t_node *idlist;
register t_def *FromDef;
t_node *FromId;
{ {
/* Import the list Idlist from the module indicated by Fromdef. /* Import the list Idlist from the module indicated by Fromdef.
*/ */
@ -544,9 +504,7 @@ node_error(FromId,"identifier \"%s\" does not represent a module",module_name);
FreeNode(FromId); FreeNode(FromId);
} }
EnterImportList(idlist, local, sc) void EnterImportList(t_node *idlist, int local, t_scope *sc)
register t_node *idlist;
t_scope *sc;
{ {
/* Import "idlist" from scope "sc". /* Import "idlist" from scope "sc".
If the import is not local, definition modules must be read If the import is not local, definition modules must be read

46
lang/m2/comp/enter.h Normal file
View file

@ -0,0 +1,46 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
* Created on: 2019-02-27
*
*/
#ifndef ENTER_H_
#define ENTER_H_
/* Forward declarations. */
typedef struct type t_type;
typedef struct def t_def;
typedef struct node t_node;
typedef struct scope t_scope;
typedef struct paramlist t_param;
t_def *Enter(char *name, int kind, t_type *type, int pnam);
t_def *EnterType(char *name, t_type *type);
void EnterEnumList(t_node *Idlist, register t_type *type);
void EnterFieldList(t_node *Idlist, register t_type *type, t_scope *scope,
arith *addr);
/* Enter a list of identifiers representing variables into the
name list. "type" represents the type of the variables.
"local" is set if the variables are declared local to a
procedure.
*/
void EnterVarList(t_node *Idlist, t_type *type, int local);
/* Create (part of) a parameterlist of a procedure.
"ids" indicates the list of identifiers, "tp" their type, and
"VARp" indicates D_VARPAR or D_VALPAR.
*/
void EnterParamList(t_param **ppr, t_node *Idlist, t_type *type,
int VARp, arith *off);
/* From the current scope, the list of identifiers "ids" is
exported. Note this fact. If the export is not qualified, make
all the "ids" visible in the enclosing scope by defining them
in this scope as "imported".
*/
void EnterExportList(t_node *Idlist, int qualified);
void CheckForImports(t_def *df);
void EnterFromImportList(t_node *idlist, t_def *FromDef, t_node *FromId);
void EnterImportList(t_node *idlist, int local, t_scope *sc);
#endif /* ENTER_H_ */

49
lang/m2/comp/error.c
View file

@ -30,10 +30,12 @@
#include "input.h" #include "input.h"
#include "f_info.h" #include "f_info.h"
#include "print.h"
#include "LLlex.h" #include "LLlex.h"
#include "main.h" #include "main.h"
#include "node.h" #include "node.h"
#include "warning.h" #include "warning.h"
#include "error.h"
/* error classes */ /* error classes */
#define ERROR 1 #define ERROR 1
@ -60,13 +62,12 @@ extern char *symbol2str();
FileName, node errors get their information from the FileName, node errors get their information from the
node, whereas other errors use the information in the token. node, whereas other errors use the information in the token.
*/ */
static void _error(int, t_node *, char *, register va_list, int);
void _error();
#if __STDC__ #if __STDC__
#ifdef DEBUG #ifdef DEBUG
/*VARARGS*/ /*VARARGS*/
debug(char *fmt, ...) void debug(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -79,7 +80,7 @@ debug(char *fmt, ...)
#endif /* DEBUG */ #endif /* DEBUG */
/*VARARGS*/ /*VARARGS*/
error(char *fmt, ...) void error(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -91,7 +92,7 @@ error(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
node_error(t_node *node, char *fmt, ...) void node_error(t_node *node, char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -103,7 +104,7 @@ node_error(t_node *node, char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
warning(int class, char *fmt, ...) void warning(int class, char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -115,7 +116,7 @@ warning(int class, char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
node_warning(t_node *node, int class, char *fmt, ...) void node_warning(t_node *node, int class, char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -127,7 +128,7 @@ node_warning(t_node *node, int class, char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
lexerror(char *fmt, ...) void lexerror(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -139,7 +140,7 @@ lexerror(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
lexwarning(int class, char *fmt, ...) void lexwarning(int class, char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -151,7 +152,7 @@ lexwarning(int class, char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
fatal(char *fmt, ...) void fatal(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -164,7 +165,7 @@ fatal(char *fmt, ...)
} }
/*VARARGS*/ /*VARARGS*/
crash(char *fmt, ...) void crash(char *fmt, ...)
{ {
va_list ap; va_list ap;
@ -182,7 +183,7 @@ crash(char *fmt, ...)
#else #else
#ifdef DEBUG #ifdef DEBUG
/*VARARGS*/ /*VARARGS*/
debug(va_alist) void debug(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -197,7 +198,7 @@ debug(va_alist)
#endif /* DEBUG */ #endif /* DEBUG */
/*VARARGS*/ /*VARARGS*/
error(va_alist) void error(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -211,7 +212,7 @@ error(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
node_error(va_alist) void node_error(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -226,7 +227,7 @@ node_error(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
warning(va_alist) void warning(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -241,7 +242,7 @@ warning(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
node_warning(va_alist) void node_warning(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -257,7 +258,7 @@ node_warning(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
lexerror(va_alist) void lexerror(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -271,7 +272,7 @@ lexerror(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
lexwarning(va_alist) void lexwarning(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -286,7 +287,7 @@ lexwarning(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
fatal(va_alist) void fatal(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -301,7 +302,7 @@ fatal(va_alist)
} }
/*VARARGS*/ /*VARARGS*/
crash(va_alist) void crash(va_alist)
va_dcl va_dcl
{ {
va_list ap; va_list ap;
@ -320,13 +321,7 @@ crash(va_alist)
} }
#endif #endif
void static void _error(int class, t_node *node, char *fmt, register va_list ap, int warn_class)
_error(class, node, fmt, ap, warn_class)
int class;
t_node *node;
char *fmt;
register va_list ap;
int warn_class;
{ {
/* _error attempts to limit the number of error messages /* _error attempts to limit the number of error messages
for a given line to MAXERR_LINE. for a given line to MAXERR_LINE.

60
lang/m2/comp/error.h Normal file
View file

@ -0,0 +1,60 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
* Created on: 2019-02-26
*
*/
#ifndef ERROR_H_
#define ERROR_H_
typedef struct node t_node;
#if __STDC__
#ifdef DEBUG
/*VARARGS*/
void debug(char *fmt, ...);
#endif /* DEBUG */
/*VARARGS*/
void error(char *fmt, ...);
/*VARARGS*/
void node_error(t_node *node, char *fmt, ...);
/*VARARGS*/
void warning(int class, char *fmt, ...);
/*VARARGS*/
void node_warning(t_node *node, int class, char *fmt, ...);
/*VARARGS*/
void lexerror(char *fmt, ...);
/*VARARGS*/
void lexwarning(int class, char *fmt, ...);
/*VARARGS*/
void fatal(char *fmt, ...);
/*VARARGS*/
void crash(char *fmt, ...);
#else
#ifdef DEBUG
/*VARARGS*/
void debug(va_alist);
#endif /* DEBUG */
/*VARARGS*/
void error(va_alist);
/*VARARGS*/
void node_error(va_alist);
/*VARARGS*/
void warning(va_alist);
/*VARARGS*/
void node_warning(va_alist);
/*VARARGS*/
void lexerror(va_alist);
/*VARARGS*/
void lexwarning(va_alist);
/*VARARGS*/
void fatal(va_alist);
/*VARARGS*/
void crash(va_alist);
#endif
#endif /* ERROR_H_ */

9
lang/m2/comp/expression.g
View file

@ -10,12 +10,12 @@
/* $Id$ */ /* $Id$ */
{ {
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <alloc.h> #include "alloc.h"
#include <em_arith.h> #include "em_arith.h"
#include <em_label.h> #include "em_label.h"
#include <assert.h> #include <assert.h>
#include "LLlex.h" #include "LLlex.h"
@ -23,6 +23,7 @@
#include "def.h" #include "def.h"
#include "node.h" #include "node.h"
#include "type.h" #include "type.h"
#include "error.h"
#include "chk_expr.h" #include "chk_expr.h"
#include "warning.h" #include "warning.h"

2
lang/m2/comp/idf.c
View file

@ -9,6 +9,6 @@
/* $Id$ */ /* $Id$ */
#include "parameters.h" #include "parameters.h"
#include "idf.h" #include "idf.h"
#include <idf_pkg.body> #include <idf_pkg.body>

6
lang/m2/comp/input.c
View file

@ -13,10 +13,10 @@
#include <stdio.h> #include <stdio.h>
#include <string.h> #include <string.h>
#include "parameters.h" #include "parameters.h"
#include "f_info.h" #include "f_info.h"
struct f_info file_info; struct f_info file_info;
#include "input.h" #include "input.h"
#include <inp_pkg.body> #include <inp_pkg.body>
int AtEoIF(void) int AtEoIF(void)

13
lang/m2/comp/lookup.c
View file

@ -9,13 +9,14 @@
/* $Id$ */ /* $Id$ */
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include <assert.h> #include <assert.h>
#include "lookup.h"
#include "LLlex.h" #include "LLlex.h"
#include "def.h" #include "def.h"
#include "idf.h" #include "idf.h"
@ -29,10 +30,7 @@ extern int pass_1;
extern char options[]; extern char options[];
#endif #endif
t_def * t_def *lookup(register t_idf *id, t_scope *scope, int import, int flags)
lookup(id, scope, import, flags)
register t_idf *id;
t_scope *scope;
{ {
/* Look up a definition of an identifier in scope "scope". /* Look up a definition of an identifier in scope "scope".
Make the "def" list self-organizing. Make the "def" list self-organizing.
@ -74,10 +72,7 @@ lookup(id, scope, import, flags)
return df; return df;
} }
t_def * t_def *lookfor(register t_node *id, register t_scopelist *vis, int message, int flags)
lookfor(id, vis, message, flags)
register t_node *id;
register t_scopelist *vis;
{ {
/* Look for an identifier in the visibility range started by "vis". /* Look for an identifier in the visibility range started by "vis".
If it is not defined create a dummy definition and, If it is not defined create a dummy definition and,

21
lang/m2/comp/lookup.h Normal file
View file

@ -0,0 +1,21 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
* Created on: 2019-02-27
*
*/
#ifndef LOOKUP_H_
#define LOOKUP_H_
/* Forward declarations. */
typedef struct idf t_idf;
typedef struct scope t_scope;
typedef struct node t_node;
typedef struct def t_def;
typedef struct scopelist t_scopelist;
t_def *lookup(register t_idf *id, t_scope *scope, int import, int flags);
t_def *lookfor(register t_node *id, register t_scopelist *vis, int message, int flags);
#endif /* LOOKUP_H_ */

64
lang/m2/comp/main.c
View file

@ -9,15 +9,17 @@
/* $Id$ */ /* $Id$ */
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <system.h>
#include <em_arith.h>
#include <em_label.h>
#include <em_code.h>
#include <alloc.h>
#include <assert.h> #include <assert.h>
#include "system.h"
#include "em_arith.h"
#include "em_label.h"
#include "em_code.h"
#include "print.h"
#include "alloc.h"
#include <stb.h> #include <stb.h>
#include "input.h" #include "input.h"
@ -31,24 +33,39 @@
#include "standards.h" #include "standards.h"
#include "tokenname.h" #include "tokenname.h"
#include "node.h" #include "node.h"
#include "walk.h"
#include "cstoper.h"
#include "error.h"
#include "options.h"
#include "warning.h" #include "warning.h"
#include "SYSTEM.h" #include "SYSTEMM2.h"
int state; /* either IMPLEMENTATION or PROGRAM */ int state; /* either IMPLEMENTATION or PROGRAM */
char options[128]; char options[128];
int DefinitionModule; int DefinitionModule;
char *ProgName; char *ProgName;
char **DEFPATH; char **DEFPATH;
int nDEF = 2, mDEF = 10; int nDEF = 2, mDEF = 10;
int pass_1 = 1; int pass_1 = 1;
t_def *Defined; t_def *Defined;
extern int err_occurred; extern int err_occurred;
extern int fp_used; /* set if floating point used */ extern int fp_used; /* set if floating point used */
static t_node _emptystat = { Stat, 0, NULLTYPE, { ';' }}; static t_node _emptystat = { Stat, 0, NULLTYPE, { ';' }};
t_node *EmptyStatement = &_emptystat; t_node *EmptyStatement = &_emptystat;
main(argc, argv)
register char **argv; /* Forward declarations. */
struct stdproc;
int Compile(char *, char *);
static void AddProcs(register struct stdproc *);
static void AddStandards(void);
/* External function declarations */
extern void CompUnit(void);
extern void DefModule(void); /* Lpars */
extern void reserve(register struct tokenname *); /* tokenname */
char* getwdir(register char *); /* defmodule */
int main(int argc, char **argv)
{ {
register int Nargc = 1; register int Nargc = 1;
register char **Nargv = &argv[0]; register char **Nargv = &argv[0];
@ -72,11 +89,9 @@ main(argc, argv)
/*NOTREACHED*/ /*NOTREACHED*/
} }
Compile(src, dst) int Compile(char *src, char *dst)
char *src, *dst;
{ {
extern struct tokenname tkidf[]; extern struct tokenname tkidf[];
extern char *getwdir();
if (! InsertFile(src, (char **) 0, &src)) { if (! InsertFile(src, (char **) 0, &src)) {
fprint(STDERR,"%s: cannot open %s\n", ProgName, src); fprint(STDERR,"%s: cannot open %s\n", ProgName, src);
@ -126,7 +141,7 @@ Compile(src, dst)
} }
#ifdef DEBUG #ifdef DEBUG
LexScan() void LexScan(void)
{ {
register t_token *tkp = &dot; register t_token *tkp = &dot;
extern char *symbol2str(); extern char *symbol2str();
@ -198,8 +213,7 @@ static struct stdproc sysprocs[] = {
extern t_def *Enter(), *EnterType(); extern t_def *Enter(), *EnterType();
AddProcs(p) static void AddProcs(register struct stdproc *p)
register struct stdproc *p;
{ {
for (; p->st_nam != 0; p++) { for (; p->st_nam != 0; p++) {
if (! Enter(p->st_nam, D_PROCEDURE, std_type, p->st_con)) { if (! Enter(p->st_nam, D_PROCEDURE, std_type, p->st_con)) {
@ -208,7 +222,7 @@ AddProcs(p)
} }
} }
AddStandards() static void AddStandards(void)
{ {
register t_def *df; register t_def *df;
static t_token nilconst = { INTEGER, 0}; static t_token nilconst = { INTEGER, 0};
@ -238,7 +252,7 @@ AddStandards()
EnterType("BOOLEAN", bool_type); EnterType("BOOLEAN", bool_type);
} }
do_SYSTEM() void do_SYSTEM(void)
{ {
/* Simulate the reading of the SYSTEM definition module /* Simulate the reading of the SYSTEM definition module
*/ */
@ -258,7 +272,7 @@ do_SYSTEM()
int cntlines; int cntlines;
Info() void Info(void)
{ {
extern int cnt_def, cnt_node, cnt_paramlist, cnt_type, extern int cnt_def, cnt_node, cnt_paramlist, cnt_type,
cnt_switch_hdr, cnt_case_entry, cnt_switch_hdr, cnt_case_entry,
@ -274,14 +288,12 @@ print("\nNumber of lines read: %d\n", cntlines);
} }
#endif #endif
void void No_Mem(void)
No_Mem()
{ {
fatal("out of memory"); fatal("out of memory");
} }
void void C_failed(void)
C_failed()
{ {
fatal("write failed"); fatal("write failed");
} }

8
lang/m2/comp/main.h
View file

@ -6,8 +6,8 @@
*/ */
/* S O M E G L O B A L V A R I A B L E S */ /* S O M E G L O B A L V A R I A B L E S */
#ifndef MAIN_H_
/* $Id$ */ #define MAIN_H_
extern char options[]; /* indicating which options were given */ extern char options[]; /* indicating which options were given */
@ -23,3 +23,7 @@ extern struct def *Defined;
extern char **DEFPATH; /* search path for DEFINITION MODULE's */ extern char **DEFPATH; /* search path for DEFINITION MODULE's */
extern int mDEF, nDEF; extern int mDEF, nDEF;
extern int state; /* either IMPLEMENTATION or PROGRAM */ extern int state; /* either IMPLEMENTATION or PROGRAM */
void do_SYSTEM(void);
#endif /* MAIN_H_ */

13
lang/m2/comp/misc.c
View file

@ -17,15 +17,15 @@
#include "em_arith.h" #include "em_arith.h"
#include "em_label.h" #include "em_label.h"
#include "parameters.h" #include "parameters.h"
#include "f_info.h" #include "f_info.h"
#include "misc.h" #include "misc.h"
#include "LLlex.h" #include "LLlex.h"
#include "idf.h" #include "idf.h"
#include "node.h" #include "node.h"
#include "error.h"
match_id(id1, id2) void match_id(register t_idf *id1, t_idf *id2)
register t_idf *id1, *id2;
{ {
/* Check that identifiers id1 and id2 are equal. If they /* Check that identifiers id1 and id2 are equal. If they
are not, check that we did'nt generate them in the are not, check that we did'nt generate them in the
@ -39,8 +39,7 @@ match_id(id1, id2)
} }
} }
t_idf * t_idf *gen_anon_idf(void)
gen_anon_idf()
{ {
/* A new idf is created out of nowhere, to serve as an /* A new idf is created out of nowhere, to serve as an
anonymous name. anonymous name.
@ -55,9 +54,7 @@ gen_anon_idf()
return str2idf(s, 0); return str2idf(s, 0);
} }
not_declared(what, id, where) void not_declared(char *what, t_node *id, char *where)
char *what, *where;
register t_node *id;
{ {
/* The identifier "id" is not declared. If it is not generated, /* The identifier "id" is not declared. If it is not generated,
give an error message give an error message

9
lang/m2/comp/misc.h
View file

@ -12,5 +12,10 @@
#define is_anon_idf(x) ((x)->id_text[0] == '#') #define is_anon_idf(x) ((x)->id_text[0] == '#')
#define id_not_declared(x) (not_declared("identifier", (x), "")) #define id_not_declared(x) (not_declared("identifier", (x), ""))
extern struct idf /* Forward declarations. */
*gen_anon_idf(); typedef struct idf t_idf;
typedef struct node t_node;
void match_id(register t_idf *id1, t_idf *id2);
t_idf *gen_anon_idf(void);
void not_declared(char *what, t_node *id, char *where);

1
lang/m2/comp/next.in Normal file
View file

@ -0,0 +1 @@
#include "parameters.h"

31
lang/m2/comp/node.c
View file

@ -22,6 +22,7 @@
#include "type.h" #include "type.h"
#include "node.h" #include "node.h"
#include "main.h" #include "main.h"
#include "error.h"
static int nsubnodes[] = { static int nsubnodes[] = {
0, 0,
@ -39,8 +40,7 @@ static int nsubnodes[] = {
2 2
}; };
t_node * t_node *getnode(int class)
getnode(class)
{ {
register t_node *nd = new_node(); register t_node *nd = new_node();
@ -50,9 +50,7 @@ getnode(class)
return nd; return nd;
} }
t_node * t_node *dot2node(int class, t_node *left, t_node *right)
dot2node(class, left, right)
t_node *left, *right;
{ {
register t_node *nd = getnode(class); register t_node *nd = getnode(class);
@ -63,8 +61,7 @@ dot2node(class, left, right)
return nd; return nd;
} }
t_node * t_node *dot2leaf(int class)
dot2leaf(class)
{ {
register t_node *nd = getnode(class); register t_node *nd = getnode(class);
@ -81,15 +78,13 @@ dot2leaf(class)
return nd; return nd;
} }
void void FreeNode(register t_node *nd)
FreeNode(nd)
register t_node *nd;
{ {
/* Put nodes that are no longer needed back onto the free /* Put nodes that are no longer needed back onto the free
list list
*/ */
if (!nd) return; if (!nd) return;
switch(nsubnodes[nd->nd_class]) { switch(nsubnodes[(unsigned int)nd->nd_class]) {
case 2: case 2:
FreeNode(nd->nd_LEFT); FreeNode(nd->nd_LEFT);
FreeNode(nd->nd_RIGHT); FreeNode(nd->nd_RIGHT);
@ -102,15 +97,13 @@ FreeNode(nd)
} }
/*ARGSUSED*/ /*ARGSUSED*/
NodeCrash(expp) int NodeCrash(register t_node* expp, label exit_label, int end_reached)
t_node *expp;
{ {
crash("(NodeCrash) Illegal node"); crash("(NodeCrash) Illegal node");
} }
/*ARGSUSED*/ /*ARGSUSED*/
PNodeCrash(expp) int PNodeCrash(t_node **expp, int flags)
t_node **expp;
{ {
crash("(PNodeCrash) Illegal node"); crash("(PNodeCrash) Illegal node");
} }
@ -119,15 +112,14 @@ PNodeCrash(expp)
extern char *symbol2str(); extern char *symbol2str();
indnt(lvl) void indnt(int lvl)
{ {
while (lvl--) { while (lvl--) {
print(" "); print(" ");
} }
} }
printnode(nd, lvl) void printnode(register t_node *nd, int lvl)
register t_node *nd;
{ {
indnt(lvl); indnt(lvl);
print("Class: %d; Symbol: %s; Flags: %d\n", nd->nd_class, symbol2str(nd->nd_symb), nd->nd_flags); print("Class: %d; Symbol: %s; Flags: %d\n", nd->nd_class, symbol2str(nd->nd_symb), nd->nd_flags);
@ -139,8 +131,7 @@ printnode(nd, lvl)
} }
} }
PrNode(nd, lvl) void PrNode(register t_node *nd, int lvl)
register t_node *nd;
{ {
if (! nd) { if (! nd) {
indnt(lvl); print("<nilnode>\n"); indnt(lvl); print("<nilnode>\n");

10
lang/m2/comp/node.xh
View file

@ -61,3 +61,13 @@ extern t_node *dot2node(), *dot2leaf(), *getnode();
#define IsCast(lnd) ((lnd)->nd_class == Def && is_type((lnd)->nd_def)) #define IsCast(lnd) ((lnd)->nd_class == Def && is_type((lnd)->nd_def))
#define IsProc(lnd) ((lnd)->nd_type->tp_fund == T_PROCEDURE) #define IsProc(lnd) ((lnd)->nd_type->tp_fund == T_PROCEDURE)
t_node *getnode(int class);
t_node *dot2node(int class, t_node *left, t_node *right);
t_node *dot2leaf(int class);
void FreeNode(register t_node *nd);
int NodeCrash(register t_node* expp, label exit_label, int end_reached);
int PNodeCrash(t_node **expp, int flags);

46
lang/m2/comp/options.c
View file

@ -19,6 +19,7 @@
#include "main.h" #include "main.h"
#include "warning.h" #include "warning.h"
#include "class.h" #include "class.h"
#include "error.h"
#define MINIDFSIZE 14 #define MINIDFSIZE 14
@ -32,13 +33,30 @@ static int ndirs = 1;
int warning_classes = W_INITIAL; int warning_classes = W_INITIAL;
int gdb_flag; int gdb_flag;
DoOption(text) #if (!SQUEEZE) | (!NOCROSS)
register char *text; static int txt2int(register char **tp)
{
/* the integer pointed to by *tp is read, while increasing
*tp; the resulting value is yielded.
*/
register int val = 0;
register int ch;
while (ch = **tp, ch >= '0' && ch <= '9') {
val = val * 10 + ch - '0';
(*tp)++;
}
return val;
}
#endif
void DoOption(register char *text)
{ {
switch(*text++) { switch(*text++) {
case '-': case '-':
options[*text]++; /* debug options etc. */ options[(unsigned int)*text]++; /* debug options etc. */
break; break;
case 'U': /* allow underscores in identifiers */ case 'U': /* allow underscores in identifiers */
@ -54,7 +72,7 @@ DoOption(text)
case 's': /* symmetric: MIN(INTEGER) = -MAX(INTEGER) */ case 's': /* symmetric: MIN(INTEGER) = -MAX(INTEGER) */
case '3': /* strict 3rd edition Modula-2 */ case '3': /* strict 3rd edition Modula-2 */
case 'l': /* local additions enabled */ case 'l': /* local additions enabled */
options[text[-1]]++; options[(unsigned int)text[-1]]++;
break; break;
#ifdef DBSYMTAB #ifdef DBSYMTAB
@ -162,7 +180,7 @@ DoOption(text)
char c; char c;
char *t; char *t;
while (c = *text++) { while ( (c = *text++) != 0) {
char *strchr(); char *strchr();
t = text; t = text;
@ -235,21 +253,3 @@ DoOption(text)
} }
} }
#if (!SQUEEZE) | (!NOCROSS)
int
txt2int(tp)
register char **tp;
{
/* the integer pointed to by *tp is read, while increasing
*tp; the resulting value is yielded.
*/
register int val = 0;
register int ch;
while (ch = **tp, ch >= '0' && ch <= '9') {
val = val * 10 + ch - '0';
(*tp)++;
}
return val;
}
#endif

13
lang/m2/comp/options.h Normal file
View file

@ -0,0 +1,13 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
* Created on: 2019-02-27
*
*/
#ifndef OPTIONS_H_
#define OPTIONS_H_
void DoOption(register char *text);
#endif /* OPTIONS_H_ */

16
lang/m2/comp/program.g
View file

@ -12,14 +12,14 @@
{ {
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <alloc.h> #include "alloc.h"
#include <em_arith.h> #include "em_arith.h"
#include <em_label.h> #include "em_label.h"
#include <em_code.h> #include "em_code.h"
#include <stb.h> #include "stb.h"
#include "main.h" #include "main.h"
#include "idf.h" #include "idf.h"
@ -27,6 +27,10 @@
#include "scope.h" #include "scope.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "lookup.h"
#include "error.h"
#include "stab.h"
#include "enter.h"
#include "node.h" #include "node.h"
#include "f_info.h" #include "f_info.h"
#include "warning.h" #include "warning.h"

19
lang/m2/comp/scope.h
View file

@ -6,8 +6,10 @@
*/ */
/* S C O P E M E C H A N I S M */ /* S C O P E M E C H A N I S M */
#ifndef SCOPE_H_
#define SCOPE_H_
/* $Id$ */
#define OPENSCOPE 0 /* Indicating an open scope */ #define OPENSCOPE 0 /* Indicating an open scope */
#define CLOSEDSCOPE 1 /* Indicating a closed scope (module) */ #define CLOSEDSCOPE 1 /* Indicating a closed scope (module) */
@ -58,4 +60,17 @@ extern t_scopelist
#define scopeclosed(x) ((x)->sc_scopeclosed) #define scopeclosed(x) ((x)->sc_scopeclosed)
#define nextvisible(x) ((x)->sc_next) /* use with scopelists */ #define nextvisible(x) ((x)->sc_next) /* use with scopelists */
t_scope *open_and_close_scope();
typedef struct def t_def;
void Reverse(t_def **pdf);
void open_scope(int scopetype);
t_scope * open_and_close_scope(int scopetype);
void InitScope(void);
void close_scope(int flag);
#ifdef DEBUG
void DumpScope(register t_def *df);
#endif
#endif /* SCOPE_H_ */

36
lang/m2/comp/scope.xc
View file

@ -9,13 +9,13 @@
/* $Id$ */ /* $Id$ */
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <assert.h> #include <assert.h>
#include <alloc.h> #include "alloc.h"
#include <em_arith.h> #include "em_arith.h"
#include <em_label.h> #include "em_label.h"
#include "LLlex.h" #include "LLlex.h"
#include "idf.h" #include "idf.h"
@ -23,6 +23,8 @@
#include "type.h" #include "type.h"
#include "def.h" #include "def.h"
#include "node.h" #include "node.h"
#include "lookup.h"
#include "error.h"
t_scope *PervasiveScope; t_scope *PervasiveScope;
t_scopelist *CurrVis, *GlobalVis; t_scopelist *CurrVis, *GlobalVis;
@ -35,7 +37,7 @@ extern char options[];
static int sc_count; static int sc_count;
open_scope(scopetype) void open_scope(int scopetype)
{ {
/* Open a scope that is either open (automatic imports) or closed. /* Open a scope that is either open (automatic imports) or closed.
*/ */
@ -55,8 +57,7 @@ open_scope(scopetype)
CurrVis = ls; CurrVis = ls;
} }
t_scope * t_scope * open_and_close_scope(int scopetype)
open_and_close_scope(scopetype)
{ {
t_scope *sc; t_scope *sc;
@ -66,7 +67,7 @@ open_and_close_scope(scopetype)
return sc; return sc;
} }
InitScope() void InitScope(void)
{ {
register t_scope *sc = new_scope(); register t_scope *sc = new_scope();
register t_scopelist *ls = new_scopelist(); register t_scopelist *ls = new_scopelist();
@ -77,9 +78,7 @@ InitScope()
CurrVis = ls; CurrVis = ls;
} }
STATIC static void chk_proc(register t_def *df)
chk_proc(df)
register t_def *df;
{ {
/* Called at scope closing. Check all definitions, and if one /* Called at scope closing. Check all definitions, and if one
is a D_PROCHEAD, the procedure was not defined. is a D_PROCHEAD, the procedure was not defined.
@ -101,9 +100,7 @@ chk_proc(df)
} }
} }
STATIC static void chk_forw(t_def **pdf)
chk_forw(pdf)
t_def **pdf;
{ {
/* Called at scope close. Look for all forward definitions and /* Called at scope close. Look for all forward definitions and
if the scope was a closed scope, give an error message for if the scope was a closed scope, give an error message for
@ -111,7 +108,7 @@ chk_forw(pdf)
*/ */
register t_def *df; register t_def *df;
while (df = *pdf) { while ( (df = *pdf) ) {
if (df->df_kind == D_FORWTYPE) { if (df->df_kind == D_FORWTYPE) {
pdf = &df->df_nextinscope; pdf = &df->df_nextinscope;
ForceForwardTypeDef(df); /* removes df */ ForceForwardTypeDef(df); /* removes df */
@ -157,8 +154,7 @@ df->df_idf->id_text);
} }
} }
Reverse(pdf) void Reverse(t_def **pdf)
t_def **pdf;
{ {
/* Reverse the order in the list of definitions in a scope. /* Reverse the order in the list of definitions in a scope.
This is neccesary because this list is built in reverse. This is neccesary because this list is built in reverse.
@ -184,8 +180,7 @@ Reverse(pdf)
*pdf = df; *pdf = df;
} }
close_scope(flag) void close_scope(int flag)
register int flag;
{ {
/* Close a scope. If "flag" is set, check for forward declarations, /* Close a scope. If "flag" is set, check for forward declarations,
either POINTER declarations, or EXPORTs, or forward references either POINTER declarations, or EXPORTs, or forward references
@ -208,8 +203,7 @@ close_scope(flag)
} }
#ifdef DEBUG #ifdef DEBUG
DumpScope(df) void DumpScope(register t_def *df)
register t_def *df;
{ {
while (df) { while (df) {
PrDef(df); PrDef(df);

24
lang/m2/comp/stab.c
View file

@ -25,6 +25,8 @@
#include "type.h" #include "type.h"
#include "idf.h" #include "idf.h"
#include "scope.h" #include "scope.h"
#include "error.h"
#include "stab.h"
#include "main.h" #include "main.h"
extern int gdb_flag; extern int gdb_flag;
@ -40,8 +42,7 @@ static struct db_str {
char *currpos; char *currpos;
} db_str; } db_str;
static static void create_db_str(void)
create_db_str()
{ {
if (! db_str.base) { if (! db_str.base) {
db_str.base = Malloc(INCR_SIZE); db_str.base = Malloc(INCR_SIZE);
@ -50,9 +51,7 @@ create_db_str()
db_str.currpos = db_str.base; db_str.currpos = db_str.base;
} }
static static void addc_db_str(int c)
addc_db_str(c)
int c;
{ {
int df = db_str.currpos - db_str.base; int df = db_str.currpos - db_str.base;
if (df >= db_str.sz-1) { if (df >= db_str.sz-1) {
@ -64,16 +63,12 @@ addc_db_str(c)
*db_str.currpos = '\0'; *db_str.currpos = '\0';
} }
static static void adds_db_str(char *s)
adds_db_str(s)
char *s;
{ {
while (*s) addc_db_str(*s++); while (*s) addc_db_str(*s++);
} }
static void static void stb_type(register t_type *tp, int assign_num)
stb_type(tp, assign_num)
register t_type *tp;
{ {
char buf[128]; char buf[128];
static int stb_count; static int stb_count;
@ -254,9 +249,7 @@ stb_type(tp, assign_num)
} }
} }
stb_addtp(s, tp) void stb_addtp(char *s, t_type *tp)
char *s;
t_type *tp;
{ {
create_db_str(); create_db_str();
adds_db_str(s); adds_db_str(s);
@ -272,8 +265,7 @@ stb_addtp(s, tp)
(arith) 0); (arith) 0);
} }
stb_string(df, kind) void stb_string(register t_def *df, int kind)
register t_def *df;
{ {
register t_type *tp = df->df_type; register t_type *tp = df->df_type;
char buf[64]; char buf[64];

19
lang/m2/comp/stab.h Normal file
View file

@ -0,0 +1,19 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
* Created on: 2019-02-27
*
*/
#ifndef STAB_H_
#define STAB_H_
/* D E B U G G E R S Y M B O L T A B L E */
typedef struct type t_type;
typedef struct def t_def;
void stb_addtp(char *s, t_type *tp);
void stb_string(register t_def *df, int kind);
#endif /* STAB_H_ */

7
lang/m2/comp/statement.g
View file

@ -11,15 +11,16 @@
{ {
#include <assert.h> #include <assert.h>
#include <em_arith.h> #include "em_arith.h"
#include <em_label.h> #include "em_label.h"
#include "parameters.h" #include "parameters.h"
#include "idf.h" #include "idf.h"
#include "LLlex.h" #include "LLlex.h"
#include "scope.h" #include "scope.h"
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "error.h"
#include "node.h" #include "node.h"
static int loopcount = 0; /* Count nested loops */ static int loopcount = 0; /* Count nested loops */

26
lang/m2/comp/tmpvar.h Normal file
View file

@ -0,0 +1,26 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
* Created on: 2019-02-27
*
*/
/* T E M P O R A R Y V A R I A B L E S */
#ifndef TMPVAR_H_
#define TMPVAR_H_
#include "em_arith.h"
typedef struct scope t_scope;
void TmpOpen(t_scope *sc);
arith TmpSpace(arith sz, int al);
arith NewInt(void);
arith NewPtr(void);
void FreeInt(arith off);
void FreePtr(arith off);
void TmpClose(void);
#endif /* TMPVAR_H_ */

34
lang/m2/comp/tmpvar.xc
View file

@ -16,7 +16,7 @@
have local variabes. have local variabes.
*/ */
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <em_arith.h> #include <em_arith.h>
@ -30,6 +30,7 @@
#include "def.h" #include "def.h"
#include "type.h" #include "type.h"
#include "scope.h" #include "scope.h"
#include "tmpvar.h"
#include "main.h" #include "main.h"
struct tmpvar { struct tmpvar {
@ -45,16 +46,14 @@ static t_scope *ProcScope; /* scope of procedure in which the
temporaries are allocated temporaries are allocated
*/ */
TmpOpen(sc) t_scope *sc; void TmpOpen(t_scope *sc)
{ {
/* Initialize for temporaries in scope "sc". /* Initialize for temporaries in scope "sc".
*/ */
ProcScope = sc; ProcScope = sc;
} }
arith arith TmpSpace(arith sz, int al)
TmpSpace(sz, al)
arith sz;
{ {
register t_scope *sc = ProcScope; register t_scope *sc = ProcScope;
@ -62,10 +61,7 @@ TmpSpace(sz, al)
return sc->sc_off; return sc->sc_off;
} }
STATIC arith static arith NewTmp(struct tmpvar **plist, arith sz, int al, int regtype)
NewTmp(plist, sz, al, regtype)
register struct tmpvar **plist;
arith sz;
{ {
register arith offset; register arith offset;
register struct tmpvar *tmp; register struct tmpvar *tmp;
@ -83,22 +79,18 @@ NewTmp(plist, sz, al, regtype)
return offset; return offset;
} }
arith arith NewInt(void)
NewInt()
{ {
return NewTmp(&TmpInts, int_size, int_align, reg_any); return NewTmp(&TmpInts, int_size, int_align, reg_any);
} }
arith arith NewPtr(void)
NewPtr()
{ {
return NewTmp(&TmpPtrs, pointer_size, pointer_align, reg_pointer); return NewTmp(&TmpPtrs, pointer_size, pointer_align, reg_pointer);
} }
STATIC
FreeTmp(plist, off) static void FreeTmp(struct tmpvar **plist, arith off)
struct tmpvar **plist;
arith off;
{ {
register struct tmpvar *tmp = new_tmpvar(); register struct tmpvar *tmp = new_tmpvar();
@ -107,19 +99,17 @@ FreeTmp(plist, off)
*plist = tmp; *plist = tmp;
} }
FreeInt(off) void FreeInt(arith off)
arith off;
{ {
FreeTmp(&TmpInts, off); FreeTmp(&TmpInts, off);
} }
FreePtr(off) void FreePtr(arith off)
arith off;
{ {
FreeTmp(&TmpPtrs, off); FreeTmp(&TmpPtrs, off);
} }
TmpClose() void TmpClose(void)
{ {
register struct tmpvar *tmp, *tmp1; register struct tmpvar *tmp, *tmp1;

6
lang/m2/comp/tokenname.c
View file

@ -9,10 +9,11 @@
/* $Id$ */ /* $Id$ */
#include "parameters.h" #include "parameters.h"
#include "tokenname.h" #include "tokenname.h"
#include "Lpars.h" #include "Lpars.h"
#include "idf.h" #include "idf.h"
#include "error.h"
/* To centralize the declaration of %tokens, their presence in this /* To centralize the declaration of %tokens, their presence in this
file is taken as their declaration. The Makefile will produce file is taken as their declaration. The Makefile will produce
@ -98,8 +99,7 @@ struct tokenname tkstandard[] = { /* standard identifiers */
/* Some routines to handle tokennames */ /* Some routines to handle tokennames */
reserve(resv) void reserve(register struct tokenname *resv)
register struct tokenname *resv;
{ {
/* The names of the tokens described in resv are entered /* The names of the tokens described in resv are entered
as reserved words. as reserved words.

142
lang/m2/comp/type.c
View file

@ -9,7 +9,7 @@
/* $Id$ */ /* $Id$ */
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <assert.h> #include <assert.h>
@ -25,7 +25,12 @@
#include "idf.h" #include "idf.h"
#include "node.h" #include "node.h"
#include "scope.h" #include "scope.h"
#include "error.h"
#include "walk.h" #include "walk.h"
#include "lookup.h"
#include "stab.h"
#include "enter.h"
#include "typequiv.h"
#include "main.h" #include "main.h"
#include "chk_expr.h" #include "chk_expr.h"
#include "warning.h" #include "warning.h"
@ -73,12 +78,8 @@ t_type
*std_type, *std_type,
*error_type; *error_type;
void ArraySizes();
t_type * t_type *construct_type(int fund, register t_type *tp)
construct_type(fund, tp)
int fund;
register t_type *tp;
{ {
/* fund must be a type constructor. /* fund must be a type constructor.
The pointer to the constructed type is returned. The pointer to the constructed type is returned.
@ -117,10 +118,10 @@ construct_type(fund, tp)
return dtp; return dtp;
} }
arith /* Aligns "pos" to the specified alignment "al"
align(pos, al) * and returns the aligned "pos".
arith pos; */
int al; arith align(arith pos, int al)
{ {
int i = pos % al; int i = pos % al;
@ -128,11 +129,7 @@ align(pos, al)
return pos; return pos;
} }
t_type * t_type *standard_type(int fund, int algn, arith size)
standard_type(fund, algn, size)
int fund;
int algn;
arith size;
{ {
register t_type *tp = new_type(); register t_type *tp = new_type();
@ -146,10 +143,8 @@ standard_type(fund, algn, size)
return tp; return tp;
} }
InitTypes() void InitTypes(void)
{ {
/* Initialize the predefined types
*/
register t_type *tp; register t_type *tp;
/* first, do some checking /* first, do some checking
@ -221,17 +216,12 @@ InitTypes()
void_type = error_type; void_type = error_type;
} }
int int fit(arith sz, int nbytes)
fit(sz, nbytes)
arith sz;
{ {
return ((sz) + ((arith)0x80<<(((nbytes)-1)*8)) & ~full_mask[(nbytes)]) == 0; return ((sz) + ((arith)0x80<<(((nbytes)-1)*8)) & ~full_mask[(nbytes)]) == 0;
} }
STATIC static void u_small(register t_type *tp, arith n)
u_small(tp, n)
register t_type *tp;
arith n;
{ {
if (ufit(n, 1)) { if (ufit(n, 1)) {
tp->tp_size = 1; tp->tp_size = 1;
@ -243,9 +233,7 @@ u_small(tp, n)
} }
} }
t_type * t_type *enum_type(t_node *EnumList)
enum_type(EnumList)
t_node *EnumList;
{ {
register t_type *tp = register t_type *tp =
standard_type(T_ENUMERATION, int_align, int_size); standard_type(T_ENUMERATION, int_align, int_size);
@ -258,9 +246,7 @@ enum_type(EnumList)
return tp; return tp;
} }
t_type * t_type *qualified_type(t_node **pnd)
qualified_type(pnd)
t_node **pnd;
{ {
register t_def *df; register t_def *df;
@ -296,26 +282,18 @@ node_error(nd, "identifier \"%s\" is not a type", df->df_idf->id_text);
} }
int int chk_bounds(arith l1, arith l2, int fund)
chk_bounds(l1, l2, fund)
arith l1, l2;
{ {
/* compare to arith's, but be careful. They might be unsigned
*/
if (fund == T_INTEGER) { if (fund == T_INTEGER) {
return l2 >= l1; return l2 >= l1;
} }
return (unsigned arith) l2 >= (unsigned arith) l1; return (unsigned arith) l2 >= (unsigned arith) l1;
} }
int int in_range(arith i, register t_type *tp)
in_range(i, tp)
arith i;
register t_type *tp;
{ {
/* Check that the value i fits in the subrange or enumeration
type tp. Return 1 if so, 0 otherwise
*/
switch(tp->tp_fund) { switch(tp->tp_fund) {
case T_ENUMERATION: case T_ENUMERATION:
@ -330,16 +308,8 @@ in_range(i, tp)
/*NOTREACHED*/ /*NOTREACHED*/
} }
t_type * t_type *subr_type(t_node *lb, t_node *ub, t_type *base)
subr_type(lb, ub, base)
register t_node *lb;
t_node *ub;
t_type *base;
{ {
/* Construct a subrange type from the constant expressions
indicated by "lb" and "ub", but first perform some
checks. "base" is either a user-specified base-type, or NULL.
*/
register t_type *tp = BaseType(lb->nd_type); register t_type *tp = BaseType(lb->nd_type);
register t_type *res; register t_type *res;
@ -428,11 +398,7 @@ subr_type(lb, ub, base)
return res; return res;
} }
t_type * t_type *proc_type(t_type *result_type, t_param *parameters, arith n_bytes_params)
proc_type(result_type, parameters, n_bytes_params)
t_type *result_type;
t_param *parameters;
arith n_bytes_params;
{ {
register t_type *tp = construct_type(T_PROCEDURE, result_type); register t_type *tp = construct_type(T_PROCEDURE, result_type);
@ -447,8 +413,7 @@ proc_type(result_type, parameters, n_bytes_params)
return tp; return tp;
} }
genrck(tp) void genrck(register t_type *tp)
register t_type *tp;
{ {
/* generate a range check descriptor for type "tp" when /* generate a range check descriptor for type "tp" when
neccessary. Return its label. neccessary. Return its label.
@ -483,13 +448,8 @@ genrck(tp)
} }
} }
getbounds(tp, plo, phi) void getbounds(register t_type *tp, arith *plo, arith *phi)
register t_type *tp;
arith *plo, *phi;
{ {
/* Get the bounds of a bounded type
*/
assert(bounded(tp)); assert(bounded(tp));
if (tp->tp_fund == T_SUBRANGE) { if (tp->tp_fund == T_SUBRANGE) {
@ -502,13 +462,9 @@ getbounds(tp, plo, phi)
} }
} }
t_type * t_type *set_type(register t_type *tp)
set_type(tp)
register t_type *tp;
{ {
/* Construct a set type with base type "tp", but first
perform some checks
*/
arith lb, ub, diff, alloc_size; arith lb, ub, diff, alloc_size;
if (! bounded(tp) || tp->tp_size > word_size) { if (! bounded(tp) || tp->tp_size > word_size) {
@ -542,8 +498,7 @@ set_type(tp)
return tp; return tp;
} }
ArrayElSize(tp) void ArrayElSize(register t_type *tp)
register t_type *tp;
{ {
/* Align element size to alignment requirement of element type. /* Align element size to alignment requirement of element type.
Also make sure that its size is either a dividor of the word_size, Also make sure that its size is either a dividor of the word_size,
@ -569,9 +524,7 @@ ArrayElSize(tp)
} }
} }
void void ArraySizes(register t_type *tp)
ArraySizes(tp)
register t_type *tp;
{ {
/* Assign sizes to an array type, and check index type /* Assign sizes to an array type, and check index type
*/ */
@ -610,8 +563,7 @@ ArraySizes(tp)
C_rom_cst(tp->arr_elsize); C_rom_cst(tp->arr_elsize);
} }
FreeType(tp) void FreeType(register t_type *tp)
register t_type *tp;
{ {
/* Release type structures indicated by "tp". /* Release type structures indicated by "tp".
This procedure is only called for types, constructed with This procedure is only called for types, constructed with
@ -632,10 +584,7 @@ FreeType(tp)
free_type(tp); free_type(tp);
} }
DeclareType(nd, df, tp) void DeclareType(t_node *nd, register t_def *df, register t_type *tp)
register t_def *df;
register t_type *tp;
t_node *nd;
{ {
/* A type with type-description "tp" is declared and must /* A type with type-description "tp" is declared and must
be bound to definition "df". be bound to definition "df".
@ -677,8 +626,7 @@ DeclareType(nd, df, tp)
SolveForwardTypeRefs(df); SolveForwardTypeRefs(df);
} }
SolveForwardTypeRefs(df) void SolveForwardTypeRefs(register t_def *df)
register t_def *df;
{ {
register t_node *nd; register t_node *nd;
@ -700,8 +648,7 @@ SolveForwardTypeRefs(df)
} }
ForceForwardTypeDef(df) void ForceForwardTypeDef(register t_def *df)
register t_def *df;
{ {
register t_def *df1 = df, *df2; register t_def *df1 = df, *df2;
register t_node *nd = df->df_forw_node; register t_node *nd = df->df_forw_node;
@ -735,18 +682,14 @@ ForceForwardTypeDef(df)
} }
} }
t_type * t_type *RemoveEqual(register t_type *tpx)
RemoveEqual(tpx)
register t_type *tpx;
{ {
if (tpx) while (tpx->tp_fund == T_EQUAL) tpx = tpx->tp_next; if (tpx) while (tpx->tp_fund == T_EQUAL) tpx = tpx->tp_next;
return tpx; return tpx;
} }
int int type_or_forward(t_type *tp)
type_or_forward(tp)
t_type *tp;
{ {
/* POINTER TO IDENTIFIER construction. The IDENTIFIER resides /* POINTER TO IDENTIFIER construction. The IDENTIFIER resides
in "dot". This routine handles the different cases. in "dot". This routine handles the different cases.
@ -809,9 +752,7 @@ type_or_forward(tp)
return 0; return 0;
} }
int int gcd(int m, int n)
gcd(m, n)
register int m, n;
{ {
/* Greatest Common Divisor /* Greatest Common Divisor
*/ */
@ -825,18 +766,14 @@ gcd(m, n)
return m; return m;
} }
int int lcm(int m, int n)
lcm(m, n)
int m, n;
{ {
/* Least Common Multiple /* Least Common Multiple
*/ */
return m * (n / gcd(m, n)); return m * (n / gcd(m, n));
} }
t_type * t_type *intorcard(register t_type *left, register t_type *right)
intorcard(left, right)
register t_type *left, *right;
{ {
if (left->tp_fund == T_INTORCARD) { if (left->tp_fund == T_INTORCARD) {
t_type *tmp = left; t_type *tmp = left;
@ -852,8 +789,7 @@ intorcard(left, right)
} }
#ifdef DEBUG #ifdef DEBUG
DumpType(tp) void DumpType(register t_type *tp)
register t_type *tp;
{ {
if (!tp) return; if (!tp) return;

77
lang/m2/comp/type.xh
View file

@ -4,10 +4,17 @@
* *
* Author: Ceriel J.H. Jacobs * Author: Ceriel J.H. Jacobs
*/ */
#ifndef TYPE_H_
#define TYPE_H_
/* T Y P E D E S C R I P T O R S T R U C T U R E */ /* T Y P E D E S C R I P T O R S T R U C T U R E */
/* $Id$ */ #include "em_arith.h"
typedef struct def t_def;
typedef struct node t_node;
struct paramlist { /* structure for parameterlist of a PROCEDURE */ struct paramlist { /* structure for parameterlist of a PROCEDURE */
struct paramlist *par_next; struct paramlist *par_next;
@ -189,19 +196,7 @@ extern unsigned int
extern arith extern arith
ret_area_size; ret_area_size;
extern arith
align(); /* type.c */
extern t_type
*construct_type(),
*standard_type(),
*set_type(),
*subr_type(),
*proc_type(),
*enum_type(),
*qualified_type(),
*intorcard(),
*RemoveEqual(); /* All from type.c */
#define NULLTYPE ((t_type *) 0) #define NULLTYPE ((t_type *) 0)
@ -240,3 +235,59 @@ extern arith max_int[];
extern arith min_int[]; extern arith min_int[];
#define ufit(n, i) (((n) & ~full_mask[(i)]) == 0) #define ufit(n, i) (((n) & ~full_mask[(i)]) == 0)
/* Forward declarations. */
/* Initialize predefined types. */
void InitTypes(void);
/* Compare arith's, and return 1 if "l2" is
* greater or equal than "l1", otherwise returns 0.
* Takes into account that arith might be unsigned. */
int chk_bounds(arith l1, arith l2, int fund);
/* Aligns "pos" to the specified alignment "al" and returns the
aligned "pos".
*/
arith align(arith pos, int al);
/* Create a new standard type "fund" with specified
alignment "algn" and "size" bytes. */
t_type *standard_type(int fund, int algn, arith size);
t_type *enum_type(t_node *EnumList);
t_type *construct_type(int fund, register t_type *tp);
t_type *qualified_type(t_node **pnd);
/* Check that the value "i" fits in the subrange or enumeration
type "tp". Return 1 if so, 0 otherwise
*/
int in_range(arith i, register t_type *tp);
/* Construct a subrange type from the constant expressions
indicated by "lb" and "ub", but first perform some
checks. "base" is either a user-specified base-type, or NULL.
*/
t_type *subr_type(t_node *lb, t_node *ub, t_type *base);
t_type *proc_type(t_type *result_type, t_param *parameters, arith n_bytes_params);
void genrck(register t_type *tp);
/* Get the bounds of a bounded type. */
void getbounds(register t_type *tp, arith *plo, arith *phi);
/* Construct a set type with base type "tp", but first
* perform some checks */
t_type *set_type(register t_type *tp);
void ArrayElSize(register t_type *tp);
void ArraySizes(register t_type *tp);
void FreeType(register t_type *tp);
void DeclareType(t_node *nd, register t_def *df, register t_type *tp);
void SolveForwardTypeRefs(register t_def *df);
void ForceForwardTypeDef(register t_def *df);
t_type *RemoveEqual(register t_type *tpx);
int type_or_forward(t_type *tp);
t_type *intorcard(register t_type *left, register t_type *right);
#ifdef DEBUG
void DumpType(register t_type *tp);
#endif
int fit(arith sz, int nbytes);
/* Greatest common divisotr. */
int gcd(int m, int n);
/* Least common multiple. */
int lcm(int m, int n);
#endif /* TYPE_H_ */

63
lang/m2/comp/typequiv.c
View file

@ -12,41 +12,40 @@
/* Routines for testing type equivalence, type compatibility, and /* Routines for testing type equivalence, type compatibility, and
assignment compatibility assignment compatibility
*/ */
#include "parameters.h" #include "parameters.h"
#include "debug.h" #include "debug.h"
#include <em_arith.h> #include <em_arith.h>
#include <em_label.h> #include <em_label.h>
#include <assert.h> #include <assert.h>
#include "type.h" #include "type.h"
#include "LLlex.h" #include "LLlex.h"
#include "idf.h" #include "idf.h"
#include "def.h" #include "def.h"
#include "node.h" #include "node.h"
#include "error.h"
#include "typequiv.h"
#include "warning.h" #include "warning.h"
#include "main.h" #include "main.h"
#include "stab.h"
#include "Lpars.h" #include "Lpars.h"
#include "print.h"
#include "chk_expr.h"
extern char *sprint();
int static int TstTypeEquiv(t_type *tp1, t_type *tp2)
TstTypeEquiv(tp1, tp2)
t_type *tp1, *tp2;
{ {
/* test if two types are equivalent. /* test if two types are equivalent.
*/ */
return tp1 == tp2 return (tp1 == tp2) ||
|| (tp1 == error_type) ||
tp1 == error_type (tp2 == error_type);
||
tp2 == error_type;
} }
int static int TstParEquiv(register t_type *tp1, register t_type *tp2)
TstParEquiv(tp1, tp2)
register t_type *tp1, *tp2;
{ {
/* test if two parameter types are equivalent. This routine /* test if two parameter types are equivalent. This routine
is used to check if two different procedure declarations is used to check if two different procedure declarations
@ -67,9 +66,7 @@ TstParEquiv(tp1, tp2)
); );
} }
int int TstProcEquiv(t_type *tp1, t_type *tp2)
TstProcEquiv(tp1, tp2)
t_type *tp1, *tp2;
{ {
/* Test if two procedure types are equivalent. This routine /* Test if two procedure types are equivalent. This routine
may also be used for the testing of assignment compatibility may also be used for the testing of assignment compatibility
@ -99,9 +96,7 @@ TstProcEquiv(tp1, tp2)
return p1 == p2; return p1 == p2;
} }
int int TstCompat(register t_type *tp1, register t_type *tp2)
TstCompat(tp1, tp2)
register t_type *tp1, *tp2;
{ {
/* test if two types are compatible. See section 6.3 of the /* test if two types are compatible. See section 6.3 of the
Modula-2 Report for a definition of "compatible". Modula-2 Report for a definition of "compatible".
@ -138,9 +133,7 @@ TstCompat(tp1, tp2)
; ;
} }
int int TstAssCompat(register t_type *tp1, register t_type *tp2)
TstAssCompat(tp1, tp2)
register t_type *tp1, *tp2;
{ {
/* Test if two types are assignment compatible. /* Test if two types are assignment compatible.
See Def 9.1. See Def 9.1.
@ -177,9 +170,7 @@ TstAssCompat(tp1, tp2)
return 0; return 0;
} }
char * char *incompat(register t_type *tp1, register t_type *tp2)
incompat(tp1, tp2)
register t_type *tp1, *tp2;
{ {
if (tp1->tp_fund == T_HIDDEN || tp2->tp_fund == T_HIDDEN) { if (tp1->tp_fund == T_HIDDEN || tp2->tp_fund == T_HIDDEN) {
@ -188,11 +179,7 @@ incompat(tp1, tp2)
return "type incompatibility"; return "type incompatibility";
} }
int int TstParCompat(int parno, register t_type *formaltype, int VARflag, t_node **nd, t_def *edf)
TstParCompat(parno, formaltype, VARflag, nd, edf)
register t_type *formaltype;
t_node **nd;
t_def *edf;
{ {
/* Check type compatibility for a parameter in a procedure call. /* Check type compatibility for a parameter in a procedure call.
Assignment compatibility may do if the parameter is Assignment compatibility may do if the parameter is
@ -268,11 +255,7 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
return 0; return 0;
} }
CompatCheck(nd, tp, message, fc) int CompatCheck(register t_node **nd, t_type *tp, char *message, int (*fc)())
register t_node **nd;
t_type *tp;
char *message;
int (*fc)();
{ {
if (! (*fc)(tp, (*nd)->nd_type)) { if (! (*fc)(tp, (*nd)->nd_type)) {
if (message) { if (message) {
@ -286,10 +269,7 @@ CompatCheck(nd, tp, message, fc)
return 1; return 1;
} }
ChkAssCompat(nd, tp, message) int ChkAssCompat(t_node **nd, t_type *tp, char *message)
t_node **nd;
t_type *tp;
char *message;
{ {
/* Check assignment compatibility of node "nd" with type "tp". /* Check assignment compatibility of node "nd" with type "tp".
Give an error message when it fails Give an error message when it fails
@ -301,10 +281,7 @@ ChkAssCompat(nd, tp, message)
return CompatCheck(nd, tp, message, TstAssCompat); return CompatCheck(nd, tp, message, TstAssCompat);
} }
ChkCompat(nd, tp, message) int ChkCompat(t_node **nd, t_type *tp, char *message)
t_node **nd;
t_type *tp;
char *message;
{ {
/* Check compatibility of node "nd" with type "tp". /* Check compatibility of node "nd" with type "tp".
Give an error message when it fails Give an error message when it fails

25
lang/m2/comp/typequiv.h Normal file
View file

@ -0,0 +1,25 @@
/* Copyright (c) 2019 ACK Project.
* See the copyright notice in the ACK home directory,
* in the file "Copyright".
*
* Created on: 2019-02-25
*
*/
#ifndef TYPEQUIV_H_
#define TYPEQUIV_H_
typedef struct type t_type;
typedef struct node t_node;
typedef struct def t_def;
int TstProcEquiv(t_type *tp1, t_type *tp2);
int TstCompat(register t_type *tp1, register t_type *tp2);
int TstAssCompat(register t_type *tp1, register t_type *tp2);
int TstParCompat(int parno, register t_type *formaltype, int VARflag, t_node **nd, t_def *edf);
int ChkCompat(t_node **nd, t_type *tp, char *message);
int ChkAssCompat(t_node **nd, t_type *tp, char *message);
char *incompat(register t_type *tp1, register t_type *tp2);
#endif /* TYPEQUIV_H_ */

139
lang/m2/comp/walk.c
View file

@ -35,16 +35,19 @@
#include "node.h" #include "node.h"
#include "Lpars.h" #include "Lpars.h"
#include "desig.h" #include "desig.h"
#include "typequiv.h"
#include "f_info.h" #include "f_info.h"
#include "idf.h" #include "idf.h"
#include "chk_expr.h" #include "chk_expr.h"
#include "walk.h" #include "walk.h"
#include "misc.h" #include "misc.h"
#include "error.h"
#include "tmpvar.h"
#include "stab.h"
#include "code.h"
#include "warning.h" #include "warning.h"
extern arith NewPtr(); int CaseCode(t_node *, label, int);
extern arith NewInt();
extern arith TmpSpace();
extern int proclevel; extern int proclevel;
extern int gdb_flag; extern int gdb_flag;
@ -58,13 +61,8 @@ static t_type* func_type;
static t_node* priority; static t_node* priority;
static int oldlineno; static int oldlineno;
static int RegisterMessage();
static int WalkDef();
#ifdef DBSYMTAB
static int stabdef();
#endif
static int MkCalls();
static void UseWarnings();
#define NO_EXIT_LABEL ((label)0) #define NO_EXIT_LABEL ((label)0)
#define RETURN_LABEL ((label)1) #define RETURN_LABEL ((label)1)
@ -72,13 +70,18 @@ static void UseWarnings();
#define REACH_FLAG 1 #define REACH_FLAG 1
#define EXIT_FLAG 2 #define EXIT_FLAG 2
void DoAssign(); /* Forward declarations. */
static void WalkDef(register t_def*);
static void MkCalls(register t_def*);
static void UseWarnings(register t_def*);
static void RegisterMessage(register t_def*);
static void WalkDefList(register t_def*, void (*proc)(t_def*));
#ifdef DBSYMTAB
static void stabdef(t_def*);
#endif
int
LblWalkNode(lbl, nd, exit, reach) int LblWalkNode(label lbl, t_node *nd, int exit, int reach)
label lbl,
exit;
t_node* nd;
{ {
/* Generate code for node "nd", after generating instruction /* Generate code for node "nd", after generating instruction
label "lbl". "exit" is the exit label for the closest label "lbl". "exit" is the exit label for the closest
@ -91,8 +94,7 @@ t_node* nd;
static arith tmpprio; static arith tmpprio;
STATIC static void DoPriority(void)
DoPriority()
{ {
/* For the time being (???), handle priorities by calls to /* For the time being (???), handle priorities by calls to
the runtime system the runtime system
@ -107,8 +109,7 @@ DoPriority()
} }
} }
STATIC static void EndPriority(void)
EndPriority()
{ {
if (priority) if (priority)
{ {
@ -118,8 +119,7 @@ EndPriority()
} }
} }
def_ilb(l) void def_ilb(label l)
label l;
{ {
/* Instruction label definition. Forget about line number. /* Instruction label definition. Forget about line number.
*/ */
@ -127,10 +127,8 @@ def_ilb(l)
oldlineno = 0; oldlineno = 0;
} }
DoLineno(nd) register t_node* nd; void DoLineno(register t_node* nd)
{ {
/* Generate line number information, if necessary.
*/
if ((!options['L'] if ((!options['L']
#ifdef DBSYMTAB #ifdef DBSYMTAB
|| options['g'] || options['g']
@ -156,13 +154,8 @@ DoLineno(nd) register t_node* nd;
} }
} }
DoFilename(needed) void DoFilename(int needed)
{ {
/* Generate filename information, when needed.
This routine is called at the generation of a
procedure entry, and after generating a call to
another procedure.
*/
static label filename_label = 0; static label filename_label = 0;
oldlineno = 0; /* always invalidate remembered line number */ oldlineno = 0; /* always invalidate remembered line number */
@ -180,12 +173,8 @@ DoFilename(needed)
} }
} }
WalkModule(module) register t_def* module; void WalkModule(register t_def* module)
{ {
/* Walk through a module, and all its local definitions.
Also generate code for its body.
This code is collected in an initialization routine.
*/
register t_scope* sc; register t_scope* sc;
t_scopelist* savevis = CurrVis; t_scopelist* savevis = CurrVis;
@ -284,11 +273,9 @@ WalkModule(module) register t_def* module;
WalkDefList(sc->sc_def, UseWarnings); WalkDefList(sc->sc_def, UseWarnings);
} }
WalkProcedure(procedure) register t_def* procedure; void WalkProcedure(register t_def* procedure)
{ {
/* Walk through the definition of a procedure and all its
local definitions, checking and generating code.
*/
t_scopelist* savevis = CurrVis; t_scopelist* savevis = CurrVis;
register t_type* tp; register t_type* tp;
register t_param* param; register t_param* param;
@ -574,10 +561,10 @@ WalkProcedure(procedure) register t_def* procedure;
WalkDefList(procscope->sc_def, UseWarnings); WalkDefList(procscope->sc_def, UseWarnings);
} }
static WalkDef(df) register t_def* df; /* Walk through a list of definitions */
static void WalkDef(register t_def* df)
{ {
/* Walk through a list of definitions
*/
switch (df->df_kind) switch (df->df_kind)
{ {
@ -602,10 +589,10 @@ static WalkDef(df) register t_def* df;
} }
} }
static MkCalls(df) register t_def* df; /* Generate calls to initialization routines of modules */
static void MkCalls(register t_def* df)
{ {
/* Generate calls to initialization routines of modules
*/
if (df->df_kind == D_MODULE) if (df->df_kind == D_MODULE)
{ {
@ -614,14 +601,8 @@ static MkCalls(df) register t_def* df;
} }
} }
WalkLink(nd, exit_label, end_reached) register t_node* nd; int WalkLink(register t_node* nd, label exit_label, int end_reached)
label exit_label;
{ {
/* Walk node "nd", which is a link.
"exit_label" is set to a label number when inside a LOOP.
"end_reached" maintains info about reachability (REACH_FLAG),
and whether an EXIT statement was seen (EXIT_FLAG).
*/
while (nd && nd->nd_class == Link) while (nd && nd->nd_class == Link)
{ /* statement list */ { /* statement list */
@ -632,8 +613,7 @@ label exit_label;
return WalkNode(nd, exit_label, end_reached); return WalkNode(nd, exit_label, end_reached);
} }
STATIC static void ForLoopVarExpr(register t_node* nd)
ForLoopVarExpr(nd) register t_node* nd;
{ {
register t_type* tp = nd->nd_type; register t_type* tp = nd->nd_type;
@ -641,12 +621,9 @@ ForLoopVarExpr(nd) register t_node* nd;
CodeCoercion(tp, BaseType(tp)); CodeCoercion(tp, BaseType(tp));
} }
int int WalkStat(register t_node* nd, label exit_label, int end_reached)
WalkStat(nd, exit_label, end_reached) register t_node* nd;
label exit_label;
{ {
/* Walk through a statement, generating code for it.
*/
register t_node* left = nd->nd_LEFT; register t_node* left = nd->nd_LEFT;
register t_node* right = nd->nd_RIGHT; register t_node* right = nd->nd_RIGHT;
@ -940,9 +917,8 @@ label exit_label;
return end_reached; return end_reached;
} }
extern int NodeCrash();
int (*WalkTable[])() = { int (*WalkTable[])(t_node*, label, int) = {
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
NodeCrash, NodeCrash,
@ -960,12 +936,9 @@ int (*WalkTable[])() = {
extern t_desig null_desig; extern t_desig null_desig;
ExpectBool(pnd, true_label, false_label) register t_node** pnd; void ExpectBool(register t_node** pnd, label true_label, label false_label)
label true_label, false_label;
{ {
/* "pnd" must indicate a boolean expression. Check this and
generate code to evaluate the expression.
*/
t_desig ds; t_desig ds;
ds = null_desig; ds = null_desig;
@ -980,13 +953,8 @@ label true_label, false_label;
} }
} }
int int WalkDesignator(t_node** pnd, t_desig* ds, int flags)
WalkDesignator(pnd, ds, flags)
t_node** pnd;
t_desig* ds;
{ {
/* Check designator and generate code for it
*/
if (!ChkVariable(pnd, flags)) if (!ChkVariable(pnd, flags))
return 0; return 0;
@ -996,8 +964,7 @@ t_desig* ds;
return 1; return 1;
} }
DoForInit(nd) int DoForInit(t_node* nd)
t_node* nd;
{ {
register t_node* right = nd->nd_RIGHT; register t_node* right = nd->nd_RIGHT;
register t_def* df; register t_def* df;
@ -1074,8 +1041,8 @@ DoForInit(nd)
return 1; return 1;
} }
void
DoAssign(nd) register t_node* nd; void DoAssign(register t_node* nd)
{ {
/* May we do it in this order (expression first) ??? /* May we do it in this order (expression first) ???
The reference manual sais nothing about it, but the book does: The reference manual sais nothing about it, but the book does:
@ -1111,7 +1078,7 @@ void
CodeMove(&dsr, nd->nd_LEFT, tp); CodeMove(&dsr, nd->nd_LEFT, tp);
} }
static RegisterMessage(df) register t_def* df; static void RegisterMessage(register t_def* df)
{ {
register t_type* tp; register t_type* tp;
@ -1140,11 +1107,7 @@ static RegisterMessage(df) register t_def* df;
} }
} }
static void static void df_warning(t_node* nd, t_def* df, char* warning)
df_warning(nd, df, warning)
t_node* nd;
t_def* df;
char* warning;
{ {
if (!(df->df_kind & (D_VARIABLE | D_PROCEDURE | D_TYPE | D_CONST | D_PROCHEAD))) if (!(df->df_kind & (D_VARIABLE | D_PROCEDURE | D_TYPE | D_CONST | D_PROCHEAD)))
{ {
@ -1160,8 +1123,7 @@ char* warning;
} }
} }
static void static void UseWarnings(register t_def* df)
UseWarnings(df) register t_def* df;
{ {
t_node* nd = df->df_scope->sc_end; t_node* nd = df->df_scope->sc_end;
@ -1208,8 +1170,7 @@ static void
} }
} }
WalkDefList(df, proc) register t_def* df; static void WalkDefList(register t_def* df, void (*proc)(t_def*))
int (*proc)();
{ {
for (; df; df = df->df_nextinscope) for (; df; df = df->df_nextinscope)
{ {
@ -1218,9 +1179,7 @@ int (*proc)();
} }
#ifdef DBSYMTAB #ifdef DBSYMTAB
static int static void stabdef(t_def* df)
stabdef(df)
t_def* df;
{ {
switch (df->df_kind) switch (df->df_kind)
{ {

58
lang/m2/comp/walk.h
View file

@ -4,17 +4,22 @@
* *
* Author: Ceriel J.H. Jacobs * Author: Ceriel J.H. Jacobs
*/ */
/* P A R S E T R E E W A L K E R */ /* P A R S E T R E E W A L K E R */
#ifndef WALK_H_
#define WALK_H_
/* $Id$ */ #include "em_label.h"
/* Forward type declarations. */
typedef struct node t_node;
typedef struct def t_def;
typedef struct desig t_desig;
/* Definition of WalkNode macro /* Definition of WalkNode macro
*/ */
extern int (*WalkTable[])(t_node*, label, int);
extern int (*WalkTable[])(); #define WalkNode(xnd, xlab, rch) (*WalkTable[(unsigned int)((xnd)->nd_class)])((xnd), (xlab),(rch))
#define WalkNode(xnd, xlab, rch) (*WalkTable[(xnd)->nd_class])((xnd), (xlab),(rch))
extern label text_label; extern label text_label;
extern label data_label; extern label data_label;
@ -25,3 +30,46 @@ extern label data_label;
#define CAL(nm, sz) (C_cal(nm), C_asp((arith)(sz))) #define CAL(nm, sz) (C_cal(nm), C_asp((arith)(sz)))
#define c_bra(x) C_bra((label) (x)) #define c_bra(x) C_bra((label) (x))
#endif #endif
int LblWalkNode(label lbl, t_node *nd, int exit, int reach);
void def_ilb(label l);
/* Generate line information as necessary for "nd". */
void DoLineno(register t_node* nd);
/* Generate filename information, when needed.
This routine is called at the generation of a
procedure entry, and after generating a call to
another procedure. The current active filename
is used.
*/
void DoFilename(int needed);
/* Walk through a module, and all its local definitions.
Also generate code for its body.
This code is collected in an initialization routine.
*/
void WalkModule(register t_def* module);
/* Walk through the definition of a procedure and all its
local definitions, checking and generating code.
*/
void WalkProcedure(register t_def* procedure);
/* Walk node "nd", which is a link.
"exit_label" is set to a label number when inside a LOOP.
"end_reached" maintains info about reachability (REACH_FLAG),
and whether an EXIT statement was seen (EXIT_FLAG).
*/
int WalkLink(register t_node* nd, label exit_label, int end_reached);
/* Walk through a statement node "nd", generating code for it. */
int WalkStat(register t_node* nd, label exit_label, int end_reached);
/* Generate code to evaluate a boolean expression "pnd" */
void ExpectBool(register t_node** pnd, label true_label, label false_label);
/* Check designator and generate code for it */
int WalkDesignator(t_node** pnd, t_desig* ds, int flags);
void DoAssign(register t_node* nd);
int DoForInit(t_node* nd);
#endif /* WALK_H_ */

2
lang/pc/comp/chk_expr.c
View file

@ -1383,7 +1383,7 @@ int (*ExprChkTable[])(struct node*) =
NodeCrash NodeCrash
}; };
int (*VarAccChkTable[])() = int (*VarAccChkTable[])(struct node*) =
{ {
no_var_access, no_var_access,
ChkLinkOrName, ChkLinkOrName,

4
lang/pc/comp/chk_expr.h
View file

@ -2,11 +2,11 @@
struct node; struct node;
extern int (*ExprChkTable[])(); /* table of expression checking extern int (*ExprChkTable[])(struct node*); /* table of expression checking
functions, indexed by node class functions, indexed by node class
*/ */
extern int (*VarAccChkTable[])(); /* table of variable-access checking extern int (*VarAccChkTable[])(struct node*); /* table of variable-access checking
functions, indexed by node class functions, indexed by node class
*/ */